Esempio n. 1
0
 virtual Value* eval(Environment& env) {
     Value* ret = NULL;
     if (exprs.size() == 0) { return NULL; }
     Value *first = exprs[0]->eval(env);
     ClosureValue *func = dynamic_cast<ClosureValue*>(first);
     if (func) {
         Environment boundEnv = func->getEnv();
         vector<string> paramSyms = func->getParams();
         SchemeExpression* boundBody = func->getBody();
         if (paramSyms.size() == exprs.size() - 1) {
             for (unsigned int i = 1; i < exprs.size(); i++) {
                 boundEnv.bind(paramSyms[i - 1], exprs[i]->eval(env));
             }
             ret = boundBody->eval(boundEnv);
             for (unsigned int i = 0; i < paramSyms.size(); i++) {
                 boundEnv.unbind();
             }
         }
     }
     delete first;
     return ret;
 }
Esempio n. 2
0
Value CL_symbol_macrolet(Value args, Environment * env, Thread * thread)
{
  Value varlist = check_list(car(args));
  Value result = NIL;
  void * last_special_binding = thread->last_special_binding();
  Environment * ext = new Environment(env);

  if (varlist != NIL)
    {
      for (unsigned long i = length(varlist); i-- > 0;)
        {
          Value obj = car(varlist);
          varlist = xcdr(varlist);
          if (consp(obj) && length(obj) == 2)
            {
              Value name = xcar(obj);
              Symbol * sym = check_symbol(name);
              if (sym->is_special_variable() || env->is_declared_special(name))
                {
                  String * s = new String("Attempt to bind the special variable ");
                  s->append(::prin1_to_string(name));
                  s->append(" with SYMBOL-MACROLET.");
                  return signal_lisp_error(new ProgramError(s));
                }
              ext->bind(name, make_value(new SymbolMacro(xcar(xcdr(obj)))));
            }
          else
            {
              String * s = new String("Malformed symbol-expansion pair in SYMBOL-MACROLET: ");
              s->append(::prin1_to_string(obj));
              return signal_lisp_error(new ProgramError(s));
            }
        }
    }

  Value body = xcdr(args);

  // Process declarations.
  Value specials = NIL;
  while (body != NIL)
    {
      Value obj = car(body);
      if (consp(obj) && xcar(obj) == S_declare)
        {
          Value decls = xcdr(obj);
          while (decls != NIL)
            {
              Value decl = car(decls);
              if (consp(decl) && xcar(decl) == S_special)
                {
                  Value vars = xcdr(decl);
                  while (vars != NIL)
                    {
                      Value name = car(vars);

                      // "If declaration contains a special declaration that
                      // names one of the symbols being bound by SYMBOL-MACROLET,
                      // an error of type PROGRAM-ERROR is signaled."
                      Value list = xcar(args);
                      while (list != NIL)
                        {
                          if (xcar(xcar(list)) == name)
                            {
                              String * s = new String(::prin1_to_string(name));
                              s->append(" is a symbol-macro and thus can't be declared special.");
                              return signal_lisp_error(new ProgramError(s));
                            }
                          list = xcdr(list);
                        }

                      specials = make_cons(name, specials);
                      vars = xcdr(vars);
                    }
                }
              decls = xcdr(decls);
            }
          body = xcdr(body);
        }
      else
        break;
    }
  while (specials != NIL)
    {
      ext->declare_special(xcar(specials));
      specials = xcdr(specials);
    }

  while (body != NIL)
    {
      result = eval(car(body), ext, thread);
      body = xcdr(body);
    }
  thread->set_last_special_binding(last_special_binding);
  return result;
}