Ejemplo n.º 1
0
ValuePtr
evalIf(EnvPtr env, ValuePtr statement)
{
  int length = sLength(statement);
  if(length == 3) {
    if(sEqP(eval(env, statement->cdr()->car()), rsFalse()) == false) {
      return eval(env, statement->cdr()->cdr()->car());
    }
    else {
      return rsUndefined();
    }    
  }
  else if(length == 4) {
    if(sEqP(eval(env, statement->cdr()->car()), rsFalse()) == false) {
      return eval(env, statement->cdr()->cdr()->car());
    }
    else {
      return eval(env, statement->cdr()->cdr()->cdr()->car());
    }    
  }
  else {
    CHECK_FAIL("Wrong number of arguments to if");
    return rsUndefined();
  }
}
Ejemplo n.º 2
0
ValuePtr
evalOr(EnvPtr env, ValuePtr statement) 
{
  ValuePtr args = statement->cdr();
  while(args->isNull() == false) {
    ValuePtr test = eval(env, args->car());
    if(!sEqP(test, rsFalse()))
      return rsTrue();
    args = args->cdr();
  }
  return rsFalse();
}
Ejemplo n.º 3
0
ValuePtr
sList(EnvPtr env, ValuePtr args)
{
  ValuePtr result = new PairValue();
  ValuePtr current = result;
  while(args->isNull() == false) {
    current->car() = args->car();
    ValuePtr next = new PairValue();
    current->cdr() = next;
    current = next;
    args = args->cdr();
  }
  return result;
}
Ejemplo n.º 4
0
bool
sListP(ValuePtr data)
{
  while(data->isPair() && !data->isNull())
    data = data->cdr();
  return data->isNull();
}
Ejemplo n.º 5
0
ValuePtr
apply(EnvPtr env, ValuePtr procedure, ValuePtr args)
{
  if(procedure->type() == Value::NATIVE_PROCEDURE) {
    NativeProcedureValue* proc = static_cast<NativeProcedureValue*>(procedure.mValue);
    return (*proc->mProc)(env, args);
  }
  else if(procedure->type() == Value::PROCEDURE) {
    EnvPtr callEnvironment = new Environment;
    ProcedureValue* proc = static_cast<ProcedureValue*>(procedure.mValue);
    callEnvironment->parent = proc->environment;
    int iParam = 0;
    while(args->isNull() == false) {
      if(iParam == static_cast<int>(proc->paramList.size())) {
        CHECK_FAIL("Too many arguments to procedure");
      }
      callEnvironment->values[proc->paramList[iParam]] = args->car();
      iParam++;
      args = args->cdr();
    }
    if(iParam != static_cast<int>(proc->paramList.size())) {
      CHECK_FAIL("Too few arguments to procedure");
    }
    return evalSequence(callEnvironment, proc->body);
  }
  else {
    sWrite(env, new PairValue(procedure, new PairValue()));
    CHECK_FAIL("Wrong type of argument to apply: not procedure");
    return NULL;
  }  
  
}
Ejemplo n.º 6
0
ValuePtr
sAssq(EnvPtr, ValuePtr args)
{
  if(sLength(args) != 2)
    CHECK_FAIL("Wrong number of arguments to assq");
  ValuePtr obj = args->car();
  ValuePtr alist = args->cdr()->car();
  while(alist->isNull() == false) {
    if(alist->isPair() == false && alist->car()->isPair() == false)
      CHECK_FAIL("Malformed alist");
    if(sEqP(obj, alist->car()->car())) {
      return alist->car();
    }
    alist = alist->cdr();
 }
  return rsFalse();
}
Ejemplo n.º 7
0
bool
sPureInteger(ValuePtr args)
{
  while(args->isNull() == false) {
    if(!(args->car()->isNumber() && args->car()->isExact())) return false;
    args = args->cdr();
  }
  return true;
}
Ejemplo n.º 8
0
ValuePtr
evalStatement(EnvPtr env, ValuePtr data)
{
  ValuePtr current = data;
  ValuePtr call = new PairValue();
  ValuePtr callCurrent = call;
  while(current->isPair() && !current->isNull()) {
    callCurrent->car() = eval(env, current->car());
    ValuePtr newParam = new PairValue();
    callCurrent->cdr() = newParam;
    callCurrent = newParam;
    current = current->cdr();
  }
  if(current->isNull() == false) {
    CHECK_FAIL("Malformed statement");
    return NULL;
  }
  return apply(env, call);
}
Ejemplo n.º 9
0
ValuePtr
evalLet(EnvPtr env, ValuePtr statement)
{
  EnvPtr letEnv = new Environment();
  letEnv->parent = env;
  ValuePtr bindings = statement->cdr()->car();
  CHECK("One or more expressions", sLength(statement) >= 3);
  CHECK("Let bindings are a list", sListP(bindings));
  while(bindings->isNull() == false) {
    CHECK("Let assignment is a list", sListP(bindings->car()));
    CHECK("Let assignment is a 2 item list", sLength(bindings->car()) == 2);
    ValuePtr variable = bindings->car()->car();
    CHECK("Assigning to a symbol", variable->isSymbol());
    ValuePtr value = eval(env, bindings->car()->cdr()->car());
    letEnv->values[variable->vString()] = value;
    bindings = bindings->cdr();
  }
  return evalSequence(letEnv, statement->cdr()->cdr());
}
Ejemplo n.º 10
0
ValuePtr
apply(EnvPtr env, ValuePtr statement)
{
  if(!sListP(statement)) {
    CHECK_FAIL("Error in apply: not list");
  }
  ValuePtr procedure = statement->car();
  ValuePtr args = statement->cdr();
  return apply(env, procedure, args);
}
Ejemplo n.º 11
0
ValuePtr
sStringAppend(EnvPtr env, ValuePtr args)
{
  ostringstream ossStream;
  while(args->isNull() == false) {
    if(args->car()->isString())
      ossStream << args->car()->vString();
    args = args->cdr();
  }
  return new StringValue(ossStream.str());
}
Ejemplo n.º 12
0
ValuePtr
sAdd(EnvPtr env, ValuePtr args)
{
  ValuePtr result = new NumberValue(0);
  while(args->isNull() == false) {
    if(args->car()->isNumber() && args->car()->isExact())
      result->vInt() += args->car()->vInt();
    args = args->cdr();
  }
  return result;
}
Ejemplo n.º 13
0
// --------------------------------------------------------------------------------
ValuePtr
evalSet(EnvPtr env, ValuePtr statement)
{
  if(statement->cdr()->car()->isSymbol()) {
    string name = statement->cdr()->car()->vString();
    EnvPtr scope = env;
    while(!(scope == NULL)) {
      if(scope->values.find(name) != scope->values.end()) {
        scope->values[name] = eval(env, statement->cdr()->cdr()->car());
        return scope->values[name];
      }
      scope = scope->parent;
    }
    CHECK_FAIL("Variable not set in any environment");
    return rsUndefined();
  }
  else {
    CHECK_FAIL("set! not used correctly");
    return NULL;
  }
}
Ejemplo n.º 14
0
int
sLength(ValuePtr data)
{
  int length = 0;
  ValuePtr ptr = data;
  while(ptr->isNull() == false) {
    if(ptr->isPair() == false) CHECK_FAIL("Malformed list to length");
    length++;
    ptr = ptr->cdr();
  }
  return length;
}
Ejemplo n.º 15
0
ValuePtr
sReverse(EnvPtr, ValuePtr args)
{
  CHECK("Single argument to reverse", sLength(args) == 1 && sListP(args->car()));
  ValuePtr current = new PairValue();
  ValuePtr rList = args->car();
  while(rList->isNull() == false) {
    ValuePtr next = new PairValue(rList->car(), current);
    current = next;
    rList = rList->cdr();
  }
  return current;
}
Ejemplo n.º 16
0
ValuePtr
sMap(EnvPtr env, ValuePtr args) 
{
  CHECK("Only single parameter map supported", sLength(args) == 2);
  ValuePtr proc = args->car();
  ValuePtr list1 = args->cdr()->car();
  CHECK("Valid arguments to map", (proc->isProcedure()) && sListP(list1));

  ValuePtr result = new PairValue();
  ValuePtr current = result;
  
  ValuePtr argList = new PairValue(NULL, new PairValue());
  
  while(list1->isNull() == false) {    
    argList->car() = list1->car();
    current->car() = apply(env, proc, argList);
    ValuePtr next = new PairValue();
    current->cdr() = next;
    current = next;

    list1 = list1->cdr();
  }  
  return result;
}
Ejemplo n.º 17
0
ValuePtr
evalLambda(EnvPtr env, ValuePtr paramList, ValuePtr body)
{
  ProcedureValue* proc = new ProcedureValue();
  proc->environment = env;
  proc->body = body;
  while(paramList->isNull() == false) {
    if(!paramList->car()->isSymbol())
      CHECK_FAIL("Non symbol in parameter list");
    proc->paramList.push_back(paramList->car()->vString());
    paramList = paramList->cdr();
  }

  return proc;
}
Ejemplo n.º 18
0
ValuePtr
evalSequence(EnvPtr env, ValuePtr sequence)
{
  if(!sListP(sequence)) {
    CHECK_FAIL("evalSequence argument not list");
  }
  ValuePtr result = NULL;
  while(sequence->isNull() == false) {
    result = eval(env, sequence->car());
    sequence = sequence->cdr();
  }
  if(result == NULL) {
    CHECK_FAIL("Trying to evaluate undefined sequence");
  }
  return result;
}
Ejemplo n.º 19
0
ValuePtr
sForEach(EnvPtr env, ValuePtr args) 
{
  CHECK("Only single parameter for-each supported", sLength(args) == 2);
  ValuePtr proc = args->car();
  ValuePtr list1 = args->cdr()->car();
  CHECK("Valid arguments to foreach", (proc->isProcedure()) && sListP(list1));

  ValuePtr argList = new PairValue(NULL, new PairValue());
  
  while(list1->isNull() == false) {
    argList->car() = list1->car();
    apply(env, proc, argList);
    list1 = list1->cdr();
  }  
  
  return rsUndefined();
}
Ejemplo n.º 20
0
void
TestEval::eval_simple()
{
  EnvPtr env = new Environment();
  env->parent = NULL;
  ValuePtr value;

  // bool false
  value = eval(env, "#f");
  CHECK("Boolean false", value->isBool() && !value->vBool());

  // integer
  value = eval(env, "#t");
  CHECK("Boolean true", value->isBool() && value->vBool());

  // integer
  value = eval(env, "123");
  CHECK("Integer type", value->isNumber() && value->isExact());
  CHECK_EQUAL("Integer content", int, 123, value->vInt());

  // double
  value = eval(env, "123.456");
  CHECK("Float type", value->isNumber() && !value->isExact());
  CHECK_EQUAL("Float content", float, 123.456, value->vFloat());

  // string
  value = eval(env, "\"foobar\"");
  CHECK("String type", value->isString());
  CHECK_EQUAL("string content", string, "foobar", value->vString());

  // Symbol
  ValuePtr intValue = new NumberValue(10);
  env->values["foo_symbol!"] = intValue;
  value = eval(env, "foo_symbol!");
  CHECK("Symbol lookup", intValue == value);

  // Quote
  value = eval(env, "'(foo)");
  CHECK("Pair type", value->isPair());
  CHECK("Empty list type", value->cdr()->isNull());
  CHECK("Symbol type", value->car()->isSymbol());
  CHECK_EQUAL("Symbol value", string, "foo", value->car()->vString());  
}
Ejemplo n.º 21
0
ValuePtr
evalDefine(EnvPtr env, ValuePtr statement)
{
  if(!(env->parent == NULL)) {
    CHECK_FAIL("You can only use defines at the top level");
  }
  if(statement->cdr()->car()->isSymbol()) {
    string name = statement->cdr()->car()->vString();
    env->values[name] = eval(env, statement->cdr()->cdr()->car());
    // FIXME: Should return undefined instead ..
    return env->values[name];
  }
  else if(statement->cdr()->car()->isPair()) {
    if(!statement->cdr()->car()->car()->isSymbol())
      CHECK_FAIL("First token should be symbol for function define");
    string name = statement->cdr()->car()->car()->vString();
    env->values[name] = evalLambda(env, statement->cdr()->car()->cdr(), statement->cdr()->cdr());
    return env->values[name];
  }
  else {
    CHECK_FAIL("unknown first parameter to define");
    return rsUndefined();
  }
}
Ejemplo n.º 22
0
ValuePtr eEqP(EnvPtr, ValuePtr param) {return new BoolValue(sEqP(param->car(), param->cdr()->car()));}
Ejemplo n.º 23
0
ValuePtr
sApply(EnvPtr env, ValuePtr args)
{
  CHECK("Two parameters required", sLength(args) == 2);
  return apply(env, args->car(), args->cdr()->car());
}
Ejemplo n.º 24
0
ValuePtr
sSetCdr(EnvPtr env, ValuePtr args)
{
  args->car()->cdr() = args->cdr()->car();
  return rsUndefined();
}
Ejemplo n.º 25
0
ValuePtr
eval(EnvPtr env, ValuePtr data)
{
  // Self evaluating
  if(data->isBool() ||
     data->isNumber() ||
     data->isString()) {
    return data;
  }
  // Symbols
  else if(data->isSymbol()) {
    EnvPtr current = env;
    while(!(NULL == current)) {
      if(current->values.find(data->vString()) != current->values.end()) {
        return current->values[data->vString()];
      }
      current = current->parent;
    }
	CHECK_FAIL(string("Trying to access unknown symbol: ") + data->vString());
  }
  // Lists
  else if(data->isPair()) {
    if(!sListP(data)) {
      CHECK_FAIL("Unable to evaluate non-lists");
      return rsUndefined();
    }
    
    // ----------------------------------------
    // Check for special forms
    if(data->car()->isSymbol()) {

      // ----------------------------------------
      // Quote
      if(data->car()->vString() == string("quote")) {
        if(data->cdr()->isPair() &&
           data->cdr()->cdr()->isNull())
          return data->cdr()->car();
        else
          CHECK_FAIL("Quote error");
      }
      // ----------------------------------------
      // Lambda
      else if(data->car()->vString() == string("lambda")) {
        if(sListP(data->cdr()->car())) {
          return evalLambda(env, data->cdr()->car(), data->cdr()->cdr());
        }        
        else {
          CHECK_FAIL("Malformed lambda parameter sequence");
          return rsUndefined();
        }
      }
      // ----------------------------------------
      // Definitions: define, set!
      else if(data->car()->vString() == string("define")) {
        return evalDefine(env, data);
      }   
      else if(data->car()->vString() == string("set!")) {
        return evalSet(env, data);
      }      
      // ----------------------------------------
      // Conditionals and boolean: if, cond
      else if(data->car()->vString() == string("if")) {
        return evalIf(env, data);
      }
      else if(data->car()->vString() == string("cond")) {
        return evalCond(env, data);
      }
      else if(data->car()->vString() == string("and")) {
        return evalAnd(env, data);
      }
      else if(data->car()->vString() == string("or")) {
        return evalOr(env, data);
      }
      // ----------------------------------------
      // Binding constructs
      else if(data->car()->vString() == string("let")) {
        return evalLet(env, data);
      }      
      // ----------------------------------------
      // Sequencing
      else if(data->car()->vString() == string("begin")) {
        return evalSequence(env, data->cdr());
      }      
    }

    // Ok, standard statement
    return evalStatement(env, data);
  }  
  else {
    CHECK_FAIL("Trying to evaluate unknown type");
  }
  CHECK_FAIL("Eval error, this should never be reachable");
  return rsUndefined();
}
Ejemplo n.º 26
0
ValuePtr
sCons(EnvPtr env, ValuePtr args)
{
  CHECK("Number of arguments is 2", sLength(args) == 2);
  return new PairValue(args->car(), args->cdr()->car());
}