static int parseCond(ej_t *ep, int state, int flags)
{
char_t *lhs, *rhs;
int tid, operator;
a_assert(ep);
setString(B_L, &ep->result, T(""));
rhs = lhs = NULL;
operator = 0;
do {
/*
* Recurse to handle one side of a conditional. Accumulate the
* left hand side and the final result in ep->result.
*/
state = parse(ep, STATE_RELEXP, flags);
if (state != STATE_RELEXP_DONE) {
state = STATE_ERR;
break;
}
if (operator > 0) {
setString(B_L, &rhs, ep->result);
if (evalCond(ep, lhs, operator, rhs) < 0) {
state = STATE_ERR;
break;
}
}
setString(B_L, &lhs, ep->result);
tid = ejLexGetToken(ep, state);
if (tid == TOK_LOGICAL) {
operator = (int) *ep->token;
} else if (tid == TOK_RPAREN || tid == TOK_SEMI) {
ejLexPutbackToken(ep, tid, ep->token);
state = STATE_COND_DONE;
break;
} else {
ejLexPutbackToken(ep, tid, ep->token);
}
} while (state == STATE_RELEXP_DONE);
if (lhs) {
bfree(B_L, lhs);
}
if (rhs) {
bfree(B_L, rhs);
}
return state;
}
static int parseExpr(ej_t *ep, int state, int flags)
{
char_t *lhs, *rhs;
int rel, tid;
a_assert(ep);
setString(B_L, &ep->result, T(""));
rhs = lhs = NULL;
rel = 0;
tid = 0;
do {
/*
* This loop will handle an entire expression list. We call parse
* to evalutate each term which returns the result in ep->result.
*/
if (tid == TOK_LOGICAL) {
if ((state = parse(ep, STATE_RELEXP, flags)) != STATE_RELEXP_DONE) {
state = STATE_ERR;
break;
}
} else {
if ((state = parse(ep, STATE_EXPR, flags)) != STATE_EXPR_DONE) {
state = STATE_ERR;
break;
}
}
if (rel > 0) {
setString(B_L, &rhs, ep->result);
if (tid == TOK_LOGICAL) {
if (evalCond(ep, lhs, rel, rhs) < 0) {
state = STATE_ERR;
break;
}
} else {
if (evalExpr(ep, lhs, rel, rhs) < 0) {
state = STATE_ERR;
break;
}
}
}
setString(B_L, &lhs, ep->result);
if ((tid = ejLexGetToken(ep, state)) == TOK_EXPR ||
tid == TOK_INC_DEC || tid == TOK_LOGICAL) {
rel = (int) *ep->token;
} else {
ejLexPutbackToken(ep, tid, ep->token);
state = STATE_RELEXP_DONE;
}
} while (state == STATE_EXPR_DONE);
if (rhs) {
bfree(B_L, rhs);
}
if (lhs) {
bfree(B_L, lhs);
}
return state;
}
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();
}
// Evaluates the expression. In the frame that it is given
Value eval(Value expr, Frame *env) {
Value toRet;
switch (expr.type){
case (booleanType):
case (integerType):
case (realType):
case (stringType):
case (quotedConsType):
case (quotedSymbolType):
case (closureType):
case (primitiveType):
toRet = expr;
break;
case (symbolType):
toRet = resolveVar(expr, env);
break;
case (consType):
if( !expr.consValue ){
return evaluationError("empty expression");
}else if(expr.consValue->car.type == consType){
toRet = evalApply(expr, env);
if(toRet.type == openType){
return evaluationError("first argument in an expression did not evaluate to a proceedure");
}
break;
}else if(expr.consValue->car.type == symbolType){
char *keyword = expr.consValue->car.symbolValue;
if (strcmp(keyword, "if") == 0) {
toRet = evalIf(expr.consValue->cdr, env);
} else if (strcmp(keyword, "quote") == 0){
toRet = evalQuote(expr.consValue->cdr, env);
} else if (strcmp(keyword, "let") == 0){
toRet = evalLet(expr.consValue->cdr, env);
} else if (strcmp(keyword, "define") == 0){
toRet = evalDefine(expr.consValue->cdr, env);
} else if (strcmp(keyword, "lambda") == 0){
toRet = evalLambda(expr.consValue->cdr, env);
} else if (strcmp(keyword, "let*") == 0){
toRet = evalLetStar(expr.consValue->cdr, env);
} else if (strcmp(keyword, "letrec") == 0){
toRet = evalLetRec(expr.consValue->cdr, env);
} else if (strcmp(keyword, "begin") == 0){
toRet = evalBegin(expr.consValue->cdr, env);
} else if (strcmp(keyword, "cond") == 0){
toRet = evalCond(expr.consValue->cdr, env);
}
else {
/* not a recognized special form - must be user defined function */
toRet = evalApply(expr, env);
}
break;
}else{
return evaluationError("first argument in an expression was neither a symbol or expression");
}
case (voidType):
toRet = evaluationError("cannot evaluate void type");
default:
toRet = evaluationError(NULL);
}
return toRet;
}
obj eval(obj exp){
ev: assert(!! exp);
obj rr,lt, rt;
switch (exp->type) {
case tInd:
return doInd(eval(ult(exp)), ul(eval(urt(exp))));
case LIST:
return List2v(evalList(ul(exp)));
case tArray:
return map_obj(eval, exp);
case tAnd:
return prod_eval(ul(exp), mult);
case MULT:
return prod_eval(ul(exp), mult);
case ARITH:
return prod_eval(ul(exp), add);
case POW:
return prod_eval(ul(exp), power);
case DIVIDE:
return prod_eval(ul(exp), divide);
case tRef:
return retain(uref(exp));
case tSymbol:
if( macromode) {
if(obj rr = search_assoc(car(macro_env), exp)){
macromode = false;
// macro lexical scope should be pushed to the stack here
rr = exec(rr);
macromode = true;
return rr;
}
}
return eval_symbol(exp);
case tMinus:
lt = eval(uref(exp));
rr = uMinus(lt); // releasing
if(rr) {release(lt); return rr;}
static obj symumn = Symbol("-");
rr = udef_op0(symumn, lt);
if(rr) {release(lt); return rr;}
error("uMinus: not defined to that type");
case tReturn:
if(! uref(exp)) return encap(tSigRet, nil);
return encap(tSigRet, eval(uref(exp)));
case tBreak:
return retain(exp);
case CONDITION:
return evalCond(exp);
case tOp:
if(type(ult(exp)) ==tSymbol) {
lt = search_assoc(curr_interp->types, ult(exp));
if(lt) return encap((ValueType)vrInt(lt), eval(urt(exp)));}
lt = eval(ult(exp));
push(lt);
switch(lt->type){
case tCont:
assert(0);
case tSpecial:
rr = ufn(lt)(urt(exp));
break;
case tSyntaxLam:
rr = macro_exec(lt, urt(exp));
break;
case tInternalFn:
case tClosure:
rt = eval(urt(exp));
rr = eval_function(lt, rt);
break;
default:
rt = eval(urt(exp));
rr = call_fn(mult, lt, rt);
release(rt);
}
release(pop(&is));
return rr;
case tClosure:
assert(0);
case tCurry:
return eval_curry(exp, em0(exp));
/* obj vars = Assoc();
bind_vars(&vars, em0(exp), em2(exp));
rr = eval_curry(exp, vars);
release(vars);
return rr;
*/ case tArrow:
// return enclose(exp);
/* if(macromode){
if(obj rr = search_assoc(car(macro_env), exp)){
}
}
*/ return render(tClosure, list3(retain(em0(exp)), retain(em1(exp)), retain(env)));
case tDefine:
return func_def(em0(exp), em1(exp), em2(exp));
case tSyntaxDef:
let(lfind_var(em0(exp)), render(tSyntaxLam, list3(retain(em1(exp)), retain(em2(exp)), nil)));
return nil;
case tExec:
return exec(exp);
case tAssign:
lt = car(exp);
if(type(lt)==tOp){
return func_def(ult(lt), urt(lt), cdr(exp));
} else if(type(lt)==tMinus){
static obj symumn = Symbol("-");
return func_def(symumn, uref(lt), cdr(exp));
} else return do_assign(lt, eval(cdr(exp)));
case tIf:
rr = eval(em0(exp));
if (type(rr) != INT) error("if: Boolean Expected");
if (vrInt(rr)) {
rr = em1(exp);
} else {
rr = em2(exp);
}
return eval(rr);
case tWhile:
for(;;) {
rr = eval(car(exp));
if (type(rr) != INT) error("while: Boolean expected");
if(!vrInt(rr)) break;
rr = exec(cdr(exp));
if(rr && type(rr)==tSigRet) return rr;
if(rr && type(rr)==tBreak) {release(rr); break;}
if(rr) release(rr);
}
return nil;
default:
return retain(exp);
}
}
void ARMCore::thumbCond(uint4 opcode, int8 offset) {
if(opcode == 14) { return undefined(); }
if(opcode == 15) { return swi(); }
if(evalCond(opcode)) return branch(1, r[15] + 2*offset);
r[15] += 2;
}
