예제 #1
0
 @Override
 public void visit(FunctionCall call) {
   if (includeFunctionNames) {
     call.getFunction().accept(this);
   }
   for (SEXP expr : call.getArguments().values()) {
     expr.accept(this);
   }
 }
예제 #2
0
 static String toString(Iterable<SEXP> args) {
   StringBuilder list = new StringBuilder();
   for (SEXP arg : args) {
     if (arg == null) {
       break;
     }
     if (list.length() > 0) {
       list.append(", ");
     }
     list.append(arg.getTypeName());
   }
   return list.toString();
 }
예제 #3
0
 private Function evaluateFunction(SEXP functionExp, Environment rho) {
   if (functionExp instanceof Symbol) {
     Symbol symbol = (Symbol) functionExp;
     Function fn = rho.findFunction(this, symbol);
     if (fn == null) {
       throw new EvalException("could not find function '%s'", symbol.getPrintName());
     }
     return fn;
   } else {
     SEXP evaluated = evaluate(functionExp, rho).force(this);
     if (!(evaluated instanceof Function)) {
       throw new EvalException(
           "'function' of lang expression is of unsupported type '%s'", evaluated.getTypeName());
     }
     return (Function) evaluated;
   }
 }
예제 #4
0
 @Internal("all.names")
 public static StringVector allNames(SEXP expr, boolean function, int maxNames, boolean unique) {
   AllNamesVisitor visitor = new AllNamesVisitor();
   visitor.includeFunctionNames = function;
   visitor.maxNames = maxNames;
   visitor.unique = unique;
   expr.accept(visitor);
   return visitor.names.build();
 }
예제 #5
0
  private static SEXP R_loadMethod(Context context, SEXP def, String fname, Environment ev) {

    /* since this is called every time a method is dispatched with a
    definition that has a class, it should be as efficient as
    possible => we build in knowledge of the standard
    MethodDefinition and MethodWithNext slots.  If these (+ the
    class slot) don't account for all the attributes, regular
    dispatch is done. */
    int found = 1; /* we "know" the class attribute is there */

    found++; // we also have our fake __S4_BIt for renjin

    PairList attrib = def.getAttributes().asPairList();
    for (PairList.Node s : attrib.nodes()) {
      SEXP t = s.getTag();
      if (t == R_target) {
        ev.setVariable(R_dot_target, s.getValue());
        found++;
      } else if (t == R_defined) {
        ev.setVariable(R_dot_defined, s.getValue());
        found++;
      } else if (t == R_nextMethod) {
        ev.setVariable(R_dot_nextMethod, s.getValue());
        found++;
      } else if (t == Symbols.SOURCE) {
        /* ignore */ found++;
      }
    }
    ev.setVariable(R_dot_Method, def);

    /* this shouldn't be needed but check the generic being
    "loadMethod", which would produce a recursive loop */
    if (fname.equals("loadMethod")) {
      return def;
    }
    if (found < attrib.length()) {
      FunctionCall call =
          FunctionCall.newCall(R_loadMethod_name, def, StringArrayVector.valueOf(fname), ev);
      return context.evaluate(call, ev);

      //      SEXP e, val;
      //      PROTECT(e = allocVector(LANGSXP, 4));
      //      SETCAR(e, R_loadMethod_name); val = CDR(e);
      //      SETCAR(val, def); val = CDR(val);
      //      SETCAR(val, fname); val = CDR(val);
      //      SETCAR(val, ev);
      //      val = eval(e, ev);
      //      return val;
    } else {
      return def;
    }
  }
예제 #6
0
 public SEXP evaluate(SEXP expression, Environment rho) {
   if (expression instanceof Symbol) {
     return evaluateSymbol((Symbol) expression, rho);
   } else if (expression instanceof ExpressionVector) {
     return evaluateExpressionVector((ExpressionVector) expression, rho);
   } else if (expression instanceof FunctionCall) {
     return evaluateCall((FunctionCall) expression, rho);
   } else if (expression instanceof Promise) {
     return expression.force(this);
   } else if (expression != Null.INSTANCE && expression instanceof PromisePairList) {
     throw new EvalException("'...' used in an incorrect context");
   } else {
     clearInvisibleFlag();
     return expression;
   }
 }
예제 #7
0
  private static SubstituteContext buildContext(Context context, SEXP evaluatedEnv) {
    if (evaluatedEnv instanceof Environment) {
      if (context.getGlobalEnvironment() == evaluatedEnv) {
        return new GlobalEnvironmentContext();
      } else {
        return new EnvironmentContext((Environment) evaluatedEnv);
      }
    } else if (evaluatedEnv instanceof ListVector) {
      return new ListContext((ListVector) evaluatedEnv);
    } else if (evaluatedEnv instanceof PairList) {
      return new PairListContext((PairList) evaluatedEnv);

    } else {
      throw new EvalException(
          "Cannot substitute using environment of type %s: expected list, pairlist, or environment",
          evaluatedEnv.getTypeName());
    }
  }
예제 #8
0
 @Override
 public void visit(ExpressionVector vector) {
   for (SEXP expr : vector) {
     expr.accept(this);
   }
 }
예제 #9
0
 private static SEXP substitute(SEXP exp, SubstituteContext context) {
   SubstitutingVisitor visitor = new SubstitutingVisitor(context);
   exp.accept(visitor);
   return visitor.getResult();
 }
예제 #10
0
  private SEXP do_dispatch(
      Context context, String fname, SEXP ev, SEXP mlist, boolean firstTry, boolean evalArgs) {
    String klass;
    SEXP arg_slot;
    Symbol arg_sym;
    SEXP method, value = Null.INSTANCE;
    int nprotect = 0;
    /* check for dispatch turned off inside MethodsListSelect */
    if (mlist instanceof Function) {
      return mlist;
    }
    arg_slot = Methods.R_do_slot(context, mlist, s_argument);
    if (arg_slot == Null.INSTANCE) {
      throw new EvalException(
          "object of class \"%s\" used as methods list for function '%s' "
              + "( no 'argument' slot)",
          mlist.toString(), fname);
    }
    if (arg_slot instanceof Symbol) {
      arg_sym = (Symbol) arg_slot;
    } else {
      /* shouldn't happen, since argument in class MethodsList has class
      "name" */
      arg_sym = Symbol.get(arg_slot.asString());
    }
    //    if(arg_sym == Symbols.ELLIPSES || DDVAL(arg_sym) > 0)
    //  error(_("(in selecting a method for function '%s') '...' and related variables cannot be
    // used for methods dispatch"),
    //        CHAR(asChar(fname)));
    //    if(TYPEOF(ev) != ENVSXP) {
    //  error(_("(in selecting a method for function '%s') the 'environment' argument for dispatch
    // must be an R environment; got an object of class \"%s\""),
    //      CHAR(asChar(fname)), class_string(ev));
    //  return(R_NilValue); /* -Wall */
    //    }
    /* find the symbol in the frame, but don't use eval, yet, because
    missing arguments are ok & don't require defaults */
    if (evalArgs) {
      if (is_missing_arg(context, arg_sym, (Environment) ev)) {
        klass = "missing";
      } else {
        /*  get its class */
        SEXP arg, class_obj;
        try {
          arg = context.evaluate(arg_sym, (Environment) 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),
              e);
        }

        class_obj = Methods.R_data_class(arg, true);
        klass = class_obj.asString();
      }
    } else {
      /* the arg contains the class as a string */
      SEXP arg;
      int check_err;
      try {
        arg = context.evaluate(arg_sym, (Environment) ev);
      } catch (Exception e) {
        throw new EvalException(
            String.format(
                "error in evaluating the argument '%s' in selecting a method for function '%s'",
                arg_sym.getPrintName(), fname));
      }
      klass = arg.asString();
    }
    method = R_find_method(mlist, klass, fname);
    if (method == Null.INSTANCE) {
      if (!firstTry) {
        throw new EvalException(
            "no matching method for function '%s' (argument '%s', with class \"%s\")",
            fname, arg_sym.getPrintName(), klass);
      }
    }
    if (value == Symbol.MISSING_ARG) {
      /* the check put in before calling
      function  MethodListSelect in R */
      throw new EvalException(
          "recursive use of function '%s' in method selection, with no default method", fname);
    }
    if (!(method instanceof Function)) {
      /* assumes method is a methods list itself.  */
      /* call do_dispatch recursively.  Note the NULL for fname; this is
      passed on to the S language search function for inherited
      methods, to indicate a recursive call, not one to be stored in
      the methods metadata */
      method = do_dispatch(context, null, ev, method, firstTry, evalArgs);
    }
    return method;
  }
예제 #11
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;
  }
예제 #12
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;
  }