Interpreter create_interpreter(void){
// myPrintf("%d %d %d", sizeof(value0), sizeof(value), sizeof(node));
Interpreter in = new Interpreter_();
in->gl_vars = Assoc();
in->types = Assoc();
return in;
}
obj macro_exec1(obj lt, obj rt) { // not yet
assert(type(lt)==tSyntaxLam);
list ll = ul(lt);
obj vars = Assoc();
int suc = bind_vars(&vars, first(ll), rt);
if(! suc) {release(vars); error("no appropriate macro.");}
macro_env = op(vars, macro_env);
macromode = true;
env = op(Assoc(), env);
obj rr = exec(second(ll));
release(pop(&env));
macromode = false;
release(pop(¯o_env));
return rr;
}
obj eval_function(ref lt, rel rt) {//lt ÇÉXÉ^ÉbÉNêœÇ›Ç…
if(type(lt)== tInternalFn) goto ci;
if(type(lt)!=tClosure) {print((obj)lt); assert(0);}
{
list ll = seek_lamb(ul(lt), rt);
if(ll && type(first(ll))==tInternalFn) {
lt = first(ll);
goto ci;
}
if(! ll) error("no appropriate function.");
push(env);
obj vars = Assoc();
env = op(vars, retain(third(ll)));
bind_vars(&vars, first(ll), rt);
release(rt);
obj rr = exec(second(ll));
release(env);
env = pop(&is);
return strip_return(rr);
}
ci: try {
obj rr=(ufn(lt))(rt);
release(rt);
return rr;
} catch(eval_error){
error("not defined for that value.");
return nil;
}
}
static
obj enclose(obj v){
vto_close = Assoc();
assert(v->type == tArrow);
obj vs = Assoc();
pbind_vars(&vs, em0(v));
penv = op(vs, nil);
enclose0(em1(v));
release(penv);
assert(vto_close->type == tAssoc);
if(! ul(vto_close)) return render(tClosure, list3(retain(em0(v)), retain(em1(v)), nil));
list varlist = nil, vallist = nil;
for(list l = ul(vto_close); l; l=rest(l)){
varlist = cons(retain(car(first(l))), varlist);
vallist = cons(find_var(car(first(l))), vallist);
}
release(vto_close);
obj rr = curry(List2v(varlist), List2v(vallist), retain(em1(v)));
rr = render(tClosure, list3(retain(em0(v)), rr, nil));
return rr;
}
obj macro_exec(obj lt, obj rt) {
assert(type(lt)==tSyntaxLam);
list ll = ul(lt);
obj vars = Assoc();
int suc = bind_vars(&vars, first(ll), rt);
if(! suc) {release(vars); error("no appropriate macro.");}
push(env);
env = nil;
obj el = subs(second(ll), &vars);
//print(el); scroll();
env = pop(&is);
release(vars); // ÇøÇÂÇ¡Ç∆ïsà¿
obj rr = exec(el);
release(el);
return rr;
}
//
// CAssocManager::GetAssocObject
// Returns an object *with a new reference*. NULL is not an error return - it just means "no object"
ui_assoc_object *CAssocManager::GetAssocObject(void * handle)
{
if (handle==NULL) return NULL; // no possible association for NULL!
ASSERT_GIL_HELD; // we rely on the GIL to serialize access to our map...
PyObject *weakref;
#ifdef _DEBUG
cacheLookups++;
#endif
// implement a basic 1 item cache.
if (lastLookup==handle) {
weakref = lastObjectWeakRef;
#ifdef _DEBUG
++cacheHits;
#endif
}
else {
if (!map.Lookup((void *)handle, (void *&)weakref))
weakref = NULL;
lastLookup = handle;
lastObjectWeakRef = weakref;
}
if (weakref==NULL)
return NULL;
// convert the weakref object into a real object.
PyObject *ob = PyWeakref_GetObject(weakref);
if (ob == NULL) {
// an error - but a NULL return from us just means "no assoc"
// so print the error and ignore it, treating it as if the
// weak-ref target has died.
gui_print_error();
ob = Py_None;
}
ui_assoc_object *ret;
if (ob == Py_None) {
// weak-ref target has died. Remove it from the map.
Assoc(handle, NULL);
ret = NULL;
} else {
ret = (ui_assoc_object *)ob;
Py_INCREF(ret);
}
return ret;
}
obj udef_op0(obj ope, obj v){
assert(type(ope)==tSymbol);
obj lamb = find_var(ope);
if(!lamb) return nil;
assert(type(lamb)==tClosure);
list ll = seek_lamb(ul(lamb), v);
if(! ll) {
return nil;
}
if(type(first(ll))==tInternalFn) error("user-defined operator not defined for the type.");
obj vars = Assoc();
bind_vars(&vars, first(ll), v);
push(env);
env = op(vars, retain(third(ll)));
release(lamb); //execÇÃǻǩÇ≈lambÇ™çÌèúÇ≥ÇÍÇÈâ¬î\ê´Ç†ÇË
obj rr = exec(second(ll));
release(env);
env = pop(&is);
return strip_return(rr);
}
inline obj curry(obj var, obj val, obj code){
obj vars = Assoc();
bind_vars(&vars, var, val); // retainÇÕìKêÿÅH
return render(tCurry, list3(vars, code, nil));
return render(tCurry, list3(var, code, val));
}
static
void enclose0(obj v){
assert(!! v);
switch(v->type){
case tSymbol:
/* if( macromode) {
for(obj e = macro_env; e; e = cdr(e)){
obj rr = search_assoc(car(e), v);
if (v) { rr = v; break;}
}
//if(obj rr = search_assoc(car(macro_env), v)){ v=rr;}
}
//*/ if(is_in(penv, v)) return;
if(search_pair(vto_close, car(v))) return;
add_assoc(&vto_close, v, nil);
return;
case tAssign:
enclose0(cdr(v));
if(is_in(penv, car(v))) return;
if(search_pair(vto_close, car(v))) return;
if(is_in(env, car(v))) {
add_assoc(&vto_close, car(v), nil);
return;
}
add_assoc(&car(penv), car(v), nil); // new assignment
return;
case tClosure:
assert(0);
case tArrow:{
obj vs = Assoc();
pbind_vars(&vs, em0(v));
penv = op(vs, penv);
enclose0(em1(v));
release(pop(&penv));
return;
}
case tDefine:
case tSyntaxDef:
assert(0);
case tArray:
for(int i=0; i < uar(v).size; i++) enclose0(uar(v).v[i]);
return;
case LIST: //list
case POW:
case MULT:
case DIVIDE:
case ARITH:
case CONDITION:
case tIf:
case tExec:
case tAnd:
for(list s=ul(v); s; s=rest(s)) enclose0(first(s));
return;
case tReturn:
if(!uref(v)) return;
case tMinus:
enclose0(uref(v));
return;
case tInd:
case tWhile:
case tOp:
enclose0(car(v));
enclose0(cdr(v));
return;
case INT:
case tDouble:
case TOKEN:
case tNull:
case tLAVec:
case tDblArray:
case tIntArr:
case tDblAr2:
case IMAGE:
case STRING:
case tBreak:
return;
default:
break;
}
print(v);
assert(0);
return;
}
obj subs(obj v, obj * vars){
new_assign = Assoc();
obj rr = subs0(v, vars);
release(new_assign);
return rr;
}
/* EvalExpr - Eval and evaluate an expression using the shunting yard algorithm */
int EvalExpr(EvalState *c, const char *str, VALUE *pValue)
{
int unaryPossible = TRUE;
int tkn, count, prec, op;
PVAL pval;
/* setup an error target */
if (setjmp(c->errorTarget))
return FALSE;
/* initialize the parser */
c->linePtr = (char *)str;
c->savedToken = TKN_NONE;
/* initialize the operator and operand stacks */
c->oStackPtr = c->oStack - 1;
c->rStackPtr = c->rStack - 1;
/* handle each input token */
while ((tkn = GetToken(c, &pval)) != TKN_EOF) {
switch (tkn) {
case TKN_IDENTIFIER:
case TKN_NUMBER:
if (!unaryPossible)
Error(c, "syntax error");
rStackPush(c, pval);
unaryPossible = FALSE;
break;
case TKN_FCALL:
oStackPush(c, c->argc);
oStackPushData(c, c->fcn);
oStackPush(c, tkn);
c->fcn = pval.v.fcn;
c->argc = 0;
unaryPossible = FALSE;
break;
case '(':
if (oStackTop(c) == TKN_FCALL)
c->oStackPtr->op = TKN_FCALL_ARGS;
else
oStackPush(c, tkn);
unaryPossible = TRUE;
break;
case ',':
if (PopAndEvaluate(c) != TKN_FCALL_ARGS)
Error(c, "argument list outside of a function call");
unaryPossible = FALSE;
break;
case ')':
tkn = PopAndEvaluate(c);
oStackDrop(c);
if (tkn == TKN_FCALL || tkn == TKN_FCALL_ARGS)
CallFunction(c);
unaryPossible = FALSE;
break;
default:
if (unaryPossible && tkn == '-')
tkn = TKN_UNARY_MINUS;
if (unaryPossible && !Unary(tkn))
Error(c, "syntax error");
prec = Prec(c, tkn);
while (!oStackIsEmpty(c)) {
int stackPrec = Prec(c, oStackTop(c));
if ((Assoc(tkn) == ASSOC_LEFT && prec > stackPrec) || prec >= stackPrec)
break;
op = oStackTop(c);
oStackDrop(c);
if (op == TKN_FCALL)
CallFunction(c);
else
Apply(c, op);
}
oStackPush(c, tkn);
unaryPossible = TRUE;
break;
}
}
/* apply all of the remaining operands on the operator stack */
while (!oStackIsEmpty(c)) {
int op = oStackTop(c);
oStackDrop(c);
if (op == '(')
Error(c, "mismatched parens");
if (op == TKN_FCALL)
CallFunction(c);
else
Apply(c, op);
}
/* if the operand stack is empty then there was no expression to parse */
if ((count = rStackCount(c)) == 0)
return FALSE;
/* otherwise, make sure there is only one entry left on the operand stack */
else if (count != 1)
Error(c, "syntax error");
/* return the expression value */
RValue(c, &c->rStackPtr[0]);
*pValue = c->rStackPtr[0].v.value;
/* return successfully */
return TRUE;
}
