private static SubstituteContext buildContext(Context context, Environment rho, SEXP argument) {
    if (argument == Symbol.MISSING_ARG) {
      return buildContext(context, rho);
    }

    SEXP env = context.evaluate(argument, rho);

    return buildContext(context, env);
  }
Exemple #2
0
  /**
   * Executes the default the standard R initialization sequence:
   *
   * <ol>
   *   <li>Load the base package (/org/renjin/library/base/R/base)
   *   <li>Execute the system profile (/org/renjin/library/base/R/Rprofile)
   *   <li>Evaluate .OptRequireMethods()
   *   <li>Evaluate .First.Sys()
   * </ol>
   */
  public void init() throws IOException {
    BaseFrame baseFrame = (BaseFrame) session.getBaseEnvironment().getFrame();
    baseFrame.load(this);

    evaluate(FunctionCall.newCall(Symbol.get(".onLoad")), session.getBaseNamespaceEnv());

    //    evalBaseResource("/org/renjin/library/base/R/Rprofile");
    //
    //    // FunctionCall.newCall(new Symbol(".OptRequireMethods")).evaluate(this, environment);
    //    evaluate( FunctionCall.newCall(Symbol.get(".First.sys")), environment);
  }
  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;
    }
  }
Exemple #4
0
 protected void evalBaseResource(String resourceName) throws IOException {
   Context evalContext = this.beginEvalContext(session.getBaseNamespaceEnv());
   InputStream in = getClass().getResourceAsStream(resourceName);
   if (in == null) {
     throw new IOException("Could not load resource '" + resourceName + "'");
   }
   Reader reader = new InputStreamReader(in);
   try {
     evalContext.evaluate(RParser.parseSource(reader));
   } finally {
     reader.close();
   }
 }
  private SEXP R_S_MethodsListSelect(Context context, SEXP fname, SEXP ev, SEXP mlist, SEXP f_env) {
    PairList.Builder args = new PairList.Builder();
    args.add(fname);
    args.add(ev);
    args.add(mlist);
    if (f_env != Null.INSTANCE) {
      args.add(f_env);
    }

    try {
      return context.evaluate(
          new FunctionCall(s_MethodsListSelect, args.build()), methodsNamespace);
    } catch (EvalException e) {
      throw new EvalException(
          String.format(
              "S language method selection got an error when called from"
                  + " internal dispatch for function '%s'",
              fname),
          e);
    }
  }
Exemple #6
0
 /** Invokes any on.exit expressions that have been set. */
 public void exit() {
   for (SEXP exp : onExit) {
     evaluate(exp, environment);
   }
 }
  private SEXP do_inherited_table(
      Context context, SEXP class_objs, SEXP fdef, SEXP mtable, Environment ev) {
    SEXP fun = methodsNamespace.findFunction(context, Symbol.get(".InheritForDispatch"));

    return context.evaluate(FunctionCall.newCall(fun, class_objs, fdef, mtable), ev);
  }
  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;
  }
  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;
  }