Ejemplo n.º 1
0
  /* C version of the standardGeneric R function. */
  public SEXP R_standardGeneric(Context context, Symbol fsym, Environment ev, SEXP fdef) {
    String fname = fsym.getPrintName();
    Environment f_env = context.getGlobalEnvironment().getBaseEnvironment();
    SEXP mlist = Null.INSTANCE;
    SEXP f;
    SEXP val = Null.INSTANCE;
    int nprotect = 0;

    //    if(!initialized)
    //      R_initMethodDispatch(NULL);

    if (fdef instanceof Closure) {
      f_env = ((Closure) fdef).getEnclosingEnvironment();
      mlist = f_env.getVariable(".Methods");
      if (mlist == Symbol.UNBOUND_VALUE) {
        mlist = Null.INSTANCE;
      }
    } else if (fdef instanceof PrimitiveFunction) {
      f_env = context.getBaseEnvironment();
      // mlist = R_primitive_methods((PrimitiveFunction)fdef);
      throw new UnsupportedOperationException();
    } else {
      throw new EvalException(
          "invalid generic function object for method selection for function '%s': expected a function or a primitive, got an object of class \"%s\"",
          fsym.getPrintName(), fdef.getAttributes().getClassVector());
    }
    if (mlist instanceof Null || mlist instanceof Closure || mlist instanceof PrimitiveFunction) {
      f = mlist;
    } else {
      // f = do_dispatch(fname, ev, mlist, TRUE, TRUE);
      throw new UnsupportedOperationException();
    }
    if (f == Null.INSTANCE) {
      SEXP value =
          R_S_MethodsListSelect(context, StringArrayVector.valueOf(fname), ev, mlist, f_env);
      if (value == Null.INSTANCE) {
        throw new EvalException(
            "no direct or inherited method for function '%s' for this call", fname);
      }
      mlist = value;
      /* now look again.  This time the necessary method should
      have been inserted in the MethodsList object */
      f = do_dispatch(context, fname, (Environment) ev, mlist, false, true);
    }
    //    /* loadMethod methods */
    if (f.isObject()) {
      f = R_loadMethod(context, f, fsym.getPrintName(), ev);
    }
    if (f instanceof Closure) {
      return R_execMethod(context, (Closure) f, ev);
    } else if (f instanceof PrimitiveFunction) {
      /* primitives  can't be methods; they arise only as the
      default method when a primitive is made generic.  In this
      case, return a special marker telling the C code to go on
      with the internal computations. */
      // val = R_deferred_default_method();
      throw new UnsupportedOperationException();
    } else {
      throw new EvalException("invalid object (non-function) used as method");
    }
    //    return val;
  }
Ejemplo n.º 2
0
  public SEXP R_dispatchGeneric(Context context, Symbol fname, Environment ev, SEXP fdef) {
    SEXP method;
    SEXP f;
    SEXP val = Null.INSTANCE;
    // char *buf, *bufptr;
    int lwidth = 0;
    boolean prim_case = false;

    Environment f_env;
    if (fdef instanceof Closure) {
      f_env = ((Closure) fdef).getEnclosingEnvironment();
    } else if (fdef instanceof PrimitiveFunction) {
      fdef = R_primitive_generic(fdef);
      if (!(fdef instanceof Closure)) {
        throw new EvalException(
            "Failed to get the generic for the primitive \"%s\"", fname.asString());
      }
      f_env = ((Closure) fdef).getEnclosingEnvironment();
      prim_case = true;
    } else {
      throw new EvalException(
          "Expected a generic function or a primitive for dispatch, "
              + "got an object of class \"%s\"",
          fdef.getImplicitClass());
    }
    SEXP mtable = f_env.getVariable(R_allmtable);
    if (mtable == Symbol.UNBOUND_VALUE) {
      do_mtable(fdef, ev); /* Should initialize the generic */
      mtable = f_env.getVariable(R_allmtable);
    }
    SEXP sigargs = f_env.getVariable(R_sigargs);
    SEXP siglength = f_env.getVariable(R_siglength);

    if (sigargs == Symbol.UNBOUND_VALUE
        || siglength == Symbol.UNBOUND_VALUE
        || mtable == Symbol.UNBOUND_VALUE) {
      throw new EvalException(
          "Generic \"%s\" seems not to have been initialized for table dispatch---need to have .SigArgs and .AllMtable assigned in its environment",
          fname.asString());
    }
    int nargs = (int) siglength.asReal();
    ListVector.Builder classListBuilder = ListVector.newBuilder();
    StringVector thisClass;
    StringBuilder buf = new StringBuilder();

    for (int i = 0; i < nargs; i++) {
      Symbol arg_sym = sigargs.getElementAsSEXP(i);
      if (is_missing_arg(context, arg_sym, ev)) {
        thisClass = s_missing;
      } else {
        /*  get its class */
        SEXP arg;
        try {
          arg = context.evaluate(arg_sym, ev);
        } catch (EvalException e) {
          throw new EvalException(
              String.format(
                  "error in evaluating the argument '%s' in selecting a "
                      + "method for function '%s'",
                  arg_sym.getPrintName(), fname.asString()),
              e);
        }
        thisClass = Methods.R_data_class(arg, true);
      }
      classListBuilder.set(i, thisClass);
      if (i > 0) {
        buf.append("#");
      }
      buf.append(thisClass.asString());
    }
    ListVector classes = classListBuilder.build();
    method = ((Environment) mtable).getVariable(buf.toString());
    if (method == Symbol.UNBOUND_VALUE) {
      method = do_inherited_table(context, classes, fdef, mtable, (Environment) ev);
    }
    /* the rest of this is identical to R_standardGeneric;
    hence the f=method to remind us  */
    f = method;
    if (f.isObject()) f = R_loadMethod(context, f, fname.getPrintName(), ev);

    if (f instanceof Closure) {
      val = R_execMethod(context, (Closure) f, ev);
    } else if (f instanceof PrimitiveFunction) {
      /* primitives  can't be methods; they arise only as the
      default method when a primitive is made generic.  In this
      case, return a special marker telling the C code to go on
      with the internal computations. */
      // val = R_deferred_default_method();
      throw new UnsupportedOperationException();
    } else {
      throw new EvalException("invalid object (non-function) used as method");
    }
    return val;
  }