void
process()
{
sprozitev();
let();
tajmer();
}
static bool pbind_vars(obj* vars, obj lt){
obj utype;
switch(lt->type){
default:
break;
case tSymbol:
if(vars) add_assoc(vars, lt, nil);
return true;
case tRef:
assert(0);
let(&(uref(lt)), nil);
return true;
case INT:
assert(0);
// return equal(lt,rt);
case tOp:
utype = search_assoc(curr_interp->types, ult(lt));
if(utype){
return pbind_vars(vars, urt(lt));
}
pbind_vars(vars, ult(lt));
return pbind_vars(vars, urt(lt));
case LIST:
list x=ul(lt);
for(; (x); x=rest(x)){
pbind_vars(vars, first(x));
}
return true;
}
print(lt);
assert(0);
return nil;
}
static obj func_def(obj name, obj params, obj expr) {
assert(type(name)==tSymbol);
obj* func = lfind_var(name);
if(! *func) {
obj (*fn)(obj) = searchFunc(name, infnbind);
if(fn) let(func, tag(fn));
}
list lam = list3(retain(params), retain(expr), retain(env));
if(*func){
if(type(*func)==tClosure){ // free if complete overload, in the future
lam = merge(lam, retain(ul(*func)));
} else if(type(*func)==tInternalFn){
lam = merge(lam, list3(retain(*func), nil, nil));
}
}
return retain(*let(func, render(tClosure, lam)));
}
vector<string> letterCombinations(string digits) {
// Start typing your C/C++ solution below
// DO NOT write int main() function
char* dig[]={" ","","abc","def","ghi","jkl","mno","pqrs","tuv","wxyz"};
vector<string> let(dig, dig+10);
vector<string> res;
string str;
recLetComb(digits,0,res,str,let);
return res;
}
static obj do_assign(obj lt, obj rt){
switch(type(lt)) {
case tRef:
return retain(*let(&(uref(lt)), rt));
case tSymbol:
return retain(*let(lfind_var(lt),rt));
default:
break;
case tInd:{
obj *var;
var = lfind_var(ult(lt));
if(!*var) error("the vector does not exist.");
if((*var)->refcount > 1){
obj nv = copy(*var);
release(*var);
*var = nv;
myPrintf("performance alert: copy");
}
obj inds = eval(urt(lt));
doLInd(var, ul(inds), rt);
release(inds);
return retain(rt);
}
case LIST:
return applyCC(do_assign, lt, rt);
if(type(rt)!=LIST) error("list<-nonlist");
list s = ul(rt);
for(list l = ul(lt); l; l=rest(l), s=rest(s)){
if(! s) error("number is not enough for rhs.");
do_assign(first(l),first(s));
}
if(s) error("too much for rhs.");
return nil;
}
print(lt);
assert(0);
return nil;
}
static bool bind_vars(obj* vars, obj lt, obj rt){
obj utype;
switch(lt->type){
default:
break;
case tSymbol:
if(macromode){
if(obj rr = search_assoc(car(macro_env), lt)){
//macromode = false;
if(vars) add_assoc(vars, rr, rt);
//macromode = true;
return true;
}
}
if(vars) add_assoc(vars, lt, rt);
return true;
case tRef:
let(&(uref(lt)), rt);
return true;
case INT:
return equal(lt, rt);
case tOp:
utype = search_assoc(curr_interp->types, ult(lt));
if(utype){
if(vrInt(utype) != rt->type) return false;
return bind_vars(vars, urt(lt), uref(rt));
}
if(rt->type!=tOp) return false;
if(! bind_vars(vars, ult(lt), ult(rt))) return false;
return bind_vars(vars, urt(lt), urt(rt));
case LIST:
if(rt->type!=LIST) return false;
list x=ul(lt), a=ul(rt);
for(; (x && a); x=rest(x),a=rest(a)){
if(!bind_vars(vars, first(x), first(a))) return false;
}
if(x||a) return false;
return true;
}
print(lt);
assert(0);
return nil;
}
/*------------------------------------------------------------------
dp_pass0 линейный проход в растре r на множестве ncut
точек cut_list; vers_list - результаты для отдельных
сегментов; LC - cell слева от растра
------------------------------------------------------------------*/
void dp_pass0(cell *CP, raster *rp, struct cut_elm *cutp,
seg_vers **versp, int16_t n)
{
int16_t i,j,x;
int16_t i1,i2;
uchar let;
int16_t cc;
struct cut_elm *cut;
SVERS *vers;
int16_t pass;
// seg_vers *cur_vers;
if ((ncut=n)<2) return;
LC=CP; r=rp; cut_list=cutp; vers_list=versp;
iemax=ncut-1; right_dust=0; fl_b=0; connect_=1;
ie1=iemax; vers=&cut_list[ie1].versm;
ie2=ir=(let(vers) || dust(vers)) ? ie1-1 : ie1;
ib1=ib2=0; vers=&cut_list[1].versm;
if (let(vers)) ib2=1;
else
if (cut_list->gvarm & c_cg_cutdone) ib2=on_path(0,ie2,cut_list);
iec=ib2; ibc=ie2;
w1=sym_width-(sym_width>>2); w2=sym_width+(sym_width>>2); h2=r->h<<1;
cut=cut_list+ie1;
/*
//отщепляем правые dust'ы
if (dust(&cut->versm) && cut->duflm==0)
{
right_dust=1; iemax--; cut--;
// if (dust(&cut->versm) && cut->duflm==0) iemax--;
ir=ie1=ie2=iemax;
}
*/
//крайние хорошие распознаем с сопутствующими dust'ами
if (ie1 != ie2 && cut->duflm)
addij(LC,r,cut_list,vers_list,ncut,ie2,ie1,0);
if (ib1 != ib2)
{
cut=cut_list+ib2;
if (cut->duflm)
addij(LC,r,cut_list,vers_list,ncut,ib1,ib2,0);
if ((let=cut->versm.vers[0].let)==(uchar)'ь' &&
!is_russian_baltic_conflict(let) || // 17.07.2001 E.P.
let==(uchar)'Ь'
)
fl_b=1;
}
if (ib2>=ie2)
{
addij(LC,r,cut_list,vers_list,ncut,ib1,ie1,0);
goto test_right_dust;
}
do
{
if (!fl_b && iec != iemax)
{
#ifndef MY_DEBUG
if (det_trace)
#endif
cg_show_rast(LC,r,"left to right",cut_list); //растр - на экран
cc=l2r(&ib1,&ib2,&il);
if (cc) goto finish;
if (il<iemax && iec>il &&
(cut=cut_list+il)->dh==0 &&
(x=cut->x-cut_list->x) < h2 && x > sym_width>>1 &&
cut->versm.vers[0].prob>=190 &&
!not_connect_sect(0,il,cut_list))
{ //оставим, как есть, и попробуем дальше
i1=i2=il;
cc=l2r(&i1,&i2,&i);
if (cc) //дальше - хорошо, вернемся к подозрительному участку
{
if (debug_on)
#ifndef MY_DEBUG
if (det_trace)
#endif
{
sprintf(snap_text,"right side reached, return %d-%d",0,il);
cg_show_rast(LC,r,snap_text,cut_list); //растр - на экран
}
ib1=i1; ib2=i2; i1=i2=il; il=i;
cc=r2l(&i,&i2,&i1,0);
goto finish;
}
}
}
if (ibc != 0 && abs(cut_list[ie2].x-cut_list[ib2].x)>minw)
{
//слева не вышло, пробуем справа налево
if (debug_on)
#ifndef MY_DEBUG
if (det_trace)
#endif
{
sprintf(snap_text,"left: reliable=%d advance=%d; try right",ib2,il);
cg_show_rast(LC,r,snap_text,cut_list); //растр - на экран
}
cc=r2l(&ir,&ie2,&ie1,2);
if (cc) goto finish;
if (ir>0 && ibc<ir &&
(cut=cut_list+ir)->dh==0 &&
(x=cut_list[iemax].x-cut->x) < h2 && x > sym_width>>1 &&
cut_list[iemax].versm.vers[0].prob>=190 &&
!not_connect_sect(ir,iemax,cut_list))
{ //оставим, как есть, и попробуем дальше
i1=i2=ie2;
cc=r2l(&i,&i2,&i1,2);
if (cc) //дальше - хорошо, вернемся к подозрительному участку
{
if (debug_on)
#ifndef MY_DEBUG
if (det_trace)
#endif
{
sprintf(snap_text,"left side reached, return %d-%d",ir,iemax);
cg_show_rast(LC,r,snap_text,cut_list); //растр - на экран
}
ie1=i1; ie2=i2; i1=i2=ir; ir=i;
cc=l2r(&i1,&i2,&i);
goto finish;
}
}
}
if (abs(cut_list[ie2].x-cut_list[ib2].x)<=minw)
{
j=on_path(ie2,iemax,cut_list);
if (j==0) break;
if (ib2==0) addij(LC,r,cut_list,vers_list,ncut,0,j,0);
else one_cut(cut_list[ib2].px,ib2,ie2,j);
goto test_right_dust;
}
if (il==ie2 && (iec>il || iec==iemax) &&
ir==ib2 && (ibc<ir || ibc==0) &&
cut_list[ie2].versm.vers[0].prob>MINlet)
goto finish;
if (il==ie2 && (iec>il || iec==iemax) || ir==ib2 && (ibc<ir || ibc==0))
if (cut_list[ie2].versm.vers[0].prob>=190) goto finish;
if (il==ir)
{
version *vers0;
char *ilet;
if (connect_ && cut_list[il].dh==0)
{
addij(LC,r,cut_list,vers_list,ncut,ib2,ie2,0);
if (cut_list[ie2].versm.vers[0].prob>trs2) goto finish;
}
if (ir != ie2 && cut_list[ie2].x-cut_list[ir].x > w2)
{
i1=i2=ir;
if ( l2r(&i1,&i2,&i) || i>0 && on_path(i,iemax,cut_list) &&
cut_list[i].versm.vers[0].prob>=190)
{
j=on_path(ir,iemax,cut_list);
vers0=&cut_list[j].versm.vers[0];
if ( (let=vers0->let)==(uchar)'т' &&
!is_russian_baltic_conflict(let) && // 17.07.2001 E.P.
!is_russian_turkish_conflict(let) // 21.05.2002 E.P.
)
ie1=j;
else
if ( (ilet=strchr(letters_right_to_bad,let))!=0 &&
!is_russian_baltic_conflict(let) // 17.07.2001 E.P.
)
if (vers0->prob < prob_right_to_bad[(uchar*)ilet-letters_right_to_bad])
ie1=j; //может быть частью буквы
ie2=ir;
}
}
if (il != ib2 && cut_list[il].x-cut_list[ib2].x > w2)
{
i2=il; i1 = (ie2==il) ? ie1 : i2;
if (r2l(&i,&i2,&i1,0) || on_path(i,ib2,cut_list) &&
cut_list[i2].versm.vers[0].prob>=190)
{
cut=cut_list+il;
vers0=&cut->versm.vers[0];
if ((let=vers0->let)==(uchar)'т' &&
!is_russian_baltic_conflict(let) && // 17.07.2001 E.P.
!is_russian_turkish_conflict(let) // 21.05.2002 E.P.
)
ib1=cut->px;
else
if ( (ilet=strchr(letters_right_to_bad,let)) !=0 &&
!is_russian_baltic_conflict(let) // 17.07.2001 E.P.
)
if (vers0->prob < prob_right_to_bad[(uchar*)ilet-letters_right_to_bad])
ie1=cut->px; //может быть частью буквы
ib2=il;
}
}
if (ib2==ie2) goto finish;
}
// if (il>ir) break;
// if (iec==iemax || ibc==0 || iec<ibc) break;
if (iec==iemax && ibc==0) break;
connect_ = 1-connect_;
}
while (!connect_);
if (right_dust)
if (glue_right_dust())
{
spec_pairs(); return;
}
if (debug_on)
#ifndef MY_DEBUG
if (det_trace)
#endif
{
sprintf(snap_text,"right: reliable=%d advance=%d; ",ie2,ir);
cg_show_rast(LC,r,snap_text,cut_list); //растр - на экран
}
//не сошлись, запускаем ДП между ними
if (ie1-ib1 <= 2)
if (!good_path(cut_list,ncut)) { ib1=ib2=0; ie2=ie1=ncut-1; }
DP:
if (ie1-ib1 <= 2)
{
spec_pairs(); return;
}
il=ib1; ir=ie1;
for (pass=1; pass<=4; pass++)
{
dp_bound(cut_list,vers_list,pass,&il,&ir);
if (ir<=il)
{
if (ib1 != 0 || ie1 != ncut-1) spec_pairs(); //неполное ДП
return;
}
#ifndef MY_DEBUG
if (det_trace)
#endif
{
sprintf(snap_text,"try DP %d-%d pass=%d",il,ir,pass);
cg_show_rast(LC,r,snap_text,cut_list); //растр - на экран
}
for ( i=il+1; i<=ir; i++ )
{
if ( !ben_cut(cut_list+i) ) //разрешен на данном проходе
{
snap_newpoint(i);
for (j=i-1; j>=il; j--)
if ( !ben_cut(cut_list+j) )
if (addij(LC,r,cut_list,vers_list,ncut,j,i,0) & 8) break ;
} //8-широк ий
}
} //pass
if (ib1==0 && ie1==ncut-1) return; //полное ДП - больше нечего делать
if (good_path(cut_list,ncut)) { spec_pairs(); return; }
//ДП по всему участку
il=0; ir=ncut-1;
for (pass=1; pass<=4; pass++)
{
dp_bound(cut_list,vers_list,pass,&il,&ir);
if (ir<=il) return;
if (il>=ib1 && ir<=ie1) return; //на этом интервале уже считали
/*
{
struct cut_elm *cute=cut_list+ir;
for (cut=cut_list+(il+1); cut<cute; cut++)
if ((cut->var & 0x7F)==40) break;
if (cut==cute) return; //новых точек не будет
}
*/
#ifndef MY_DEBUG
if (det_trace)
#endif
{
sprintf(snap_text,"try DP %d-%d pass=%d",il,ir,pass);
cg_show_rast(LC,r,snap_text,cut_list); //растр - на экран
}
for ( i=il+1; i<=ir; i++ )
{
if ( !ben_cut(cut_list+i) ) //разрешен на данном проходе
{
snap_newpoint(i);
for (j=i-1; j>=il; j--)
if ( !ben_cut(cut_list+j) )
if (addij(LC,r,cut_list,vers_list,ncut,j,i,0) & 8) break ;
} //8-широк ий
}
} //pass
return;
test_right_dust:
if (right_dust) glue_right_dust();
if (!good_path(cut_list,ncut)) { ib1=ib2=0; ie2=ie1=ncut-1; goto DP; }
spec_pairs();
return;
finish:
if (right_dust) glue_right_dust();
spec_pairs();
return;
}
void int32_v (FILE *fd, char *symb, int32_t value)
{ let (fd, symb); fprintf (fd, " = 0x%Xl\n", value); }
void int_vx (FILE *fd, char *symb, int value)
{ let (fd, symb); fprintf (fd, " = 0x%X\n", value); }
void int_v (FILE *fd, char *symb, int value)
{ let (fd, symb); fprintf (fd, " = %d\n", value); }
void str_v (FILE *fd, char *symb, const char *value)
{ let (fd, symb); fprintf (fd, " = \"%s\"\n", value); }
uptr_t exec_special(uptr_t *env, uptr_t form) {
uptr_t fn = CAR(form);
uptr_t args = CDR(form);
switch(SVAL(fn)) {
case S_LET:
return let(env, args);
case S_FN:
return form;
case S_LOOP:
return loop(env, args);
case S_DO: {
uptr_t *body_p = refer(args), rval = NIL;
while (*body_p) {
rval = eval(env, CAR(*body_p));
*body_p = CDR(*body_p);
}
release(1); // body_p
return rval;
}
case S_RECUR: {
uptr_t rval, *fn_p = refer(fn);
rval = build_cons(*fn_p, eval_list(env, args));
release(1); // fn_p
return rval;
}
case S_QUOTE:
return CAR(args);
case S_CAR:
return CAR(eval(env, CAR(args)));
case S_CDR:
return CDR(eval(env, CAR(args)));
case S_AND: {
if (IS_NIL(args)) return PS_TRUE;
uptr_t *rem_args = refer(args),
rval = NIL;
while ((rval = eval(env, CAR(*rem_args))) && (*rem_args = CDR(*rem_args)));
release(1);
return rval;
}
case S_OR: {
if (IS_NIL(args)) return NIL;
uptr_t *rem_args = refer(args),
rval = NIL;
while (!(rval = eval(env, CAR(*rem_args))) && (*rem_args = CDR(*rem_args)));
release(1);
return rval;
}
case S_NOT: {
if (IS_NIL(args)) return NIL;
uptr_t rval = eval(env, CAR(args));
return rval ? NIL : PS_TRUE;
}
case S_IF: {
uptr_t rval = NIL, *clauses = refer(args);
if (eval(env, CAR(*clauses)) && CDR(*clauses))
rval = eval(env, CADR(*clauses));
else if (CDDR(*clauses))
rval = eval(env, CADDR(*clauses));
release(1); // clauses
return rval;
}
case S_WHEN: {
uptr_t rval = NIL, *cond_p = refer(CAR(args)), *body_p = refer(CDR(args));
if (eval(env, *cond_p))
while(*body_p) {
rval = eval(env, CAR(*body_p));
*body_p = CDR(*body_p);
}
release(2); // cond_p, body_p
return rval;
}
case S_CONS: {
uptr_t rval = NIL, *args_p = refer(args);
rval = build_cons(eval(env, CAR(*args_p)), eval(env, CADR(*args_p)));
release(1); // args_p
return rval;
}
case S_PRINT:
print_form(eval(env, CAR(args)));
printf_P(PSTR("\n"));
return NIL;
case S_DEF: {
uptr_t *args_p = refer(args),
*binding = refer(eval(env, CADR(args)));
assoc(env, CAR(*args_p), *binding);
release(2); // args_p, binding
return *binding; // Yeah, it's been "released", but the pointer is still valid.
}
case S_EVAL:
return eval(env, eval(env, CAR(args)));
#define _COMPR(rval) { \
if (IS_NIL(args)) return NIL; \
\
uptr_t *args_p = refer(args); \
while(CDR(*args_p) && (eval(env, CAR(*args_p)) _COMP_OPR eval(env, CADR(*args_p)))) \
*args_p = CDR(*args_p); \
\
if (IS_NIL(CDR(*args_p))) \
rval = eval(env, CAR(*args_p)); \
release(1); \
}
#define _COMP_OPR ==
case S_EQL: {
uptr_t rval = NIL;
_COMPR(rval);
return rval;
}
case S_NEQL: {
uptr_t rval = NIL;
_COMPR(rval);
return rval ? NIL : PS_TRUE;
}
#undef _COMP_OPR
#define _COMP_OPR <
case S_LT: {
uptr_t rval = NIL;
_COMPR(rval);
return rval;
}
#undef _COMP_OPR
#define _COMP_OPR <=
case S_LTE: {
uptr_t rval = NIL;
_COMPR(rval);
return rval;
}
#undef _COMP_OPR
#define _COMP_OPR >
case S_GT: {
uptr_t rval = NIL;
_COMPR(rval);
return rval;
}
#undef _COMP_OPR
#define _COMP_OPR >=
case S_GTE: {
uptr_t rval = NIL;
_COMPR(rval);
return rval;
}
#undef _COMP_OPR
#define _ARITH(coll) { \
uptr_t *rem_args = refer(args); \
coll = TO_INT(eval(env, CAR(*rem_args))); \
*rem_args = CDR(*rem_args); \
while (*rem_args) { \
coll _ARITH_OPR TO_INT(eval(env, CAR(*rem_args))); \
*rem_args = CDR(*rem_args); \
} \
release(1); \
}
#define _ARITH_OPR +=
case S_PLUS: {
if (! args) return INTERN_INT(0);
if (! CDR(args)) return eval(env, CAR(args));
int rval;
_ARITH(rval);
return INTERN_INT(rval);
}
#undef _ARITH_OPR
#define _ARITH_OPR -=
case S_MINUS: {
if (! args) return NIL;
if (! CDR(args)) return INTERN_INT(0 - TO_INT(eval(env, CAR(args))));
int rval;
_ARITH(rval);
return INTERN_INT(rval);
}
#undef _ARITH_OPR
#define _ARITH_OPR *=
case S_MULT: {
if (! args) return INTERN_INT(1);
if (! CDR(args)) return eval(env, CAR(args));
int rval;
_ARITH(rval);
return INTERN_INT(rval);
}
#undef _ARITH_OPR
#define _ARITH_OPR /=
case S_DIV: {
if (! args) return NIL;
if (! CDR(args)) return INTERN_INT(eval(env, CAR(args)) == INTERN_INT(1) ? 1 : 0);
int rval;
_ARITH(rval);
return INTERN_INT(rval);
}
#undef _ARITH_OPR
#define _ARITH_OPR &=
case S_BAND: {
if (! args) return NIL;
if (! CDR(args)) return eval(env, CAR(args));
uint8_t rval;
_ARITH(rval);
return INTERN_INT((int)rval);
}
#undef _ARITH_OPR
#define _ARITH_OPR |=
case S_BOR: {
if (! args) return NIL;
if (! CDR(args)) return eval(env, CAR(args));
uint8_t rval;
_ARITH(rval);
return INTERN_INT((int)rval);
}
#undef _ARITH_OPR
#define _ARITH_OPR ^=
case S_BXOR: {
if (! args) return NIL;
if (! CDR(args)) return eval(env, CAR(args));
uint8_t rval;
_ARITH(rval);
return INTERN_INT((int)rval);
}
#undef _ARITH_OPR
#define _ARITH_OPR <<=
case S_BSL: {
if (! args) return NIL;
if (! CDR(args)) return eval(env, CAR(args));
uint8_t rval;
_ARITH(rval);
return INTERN_INT((int)rval);
}
#undef _ARITH_OPR
#define _ARITH_OPR >>=
case S_BSR: {
if (! args) return NIL;
if (! CDR(args)) return eval(env, CAR(args));
uint8_t rval;
_ARITH(rval);
return INTERN_INT((int)rval);
}
#undef _ARITH_OPR
case S_SREG: {
uptr_t *args_p = refer(args),
reg = eval(env, CAR(*args_p));
if (IS_REG(reg))
*BYTE_PTR(reg) = eval(env, CADR(*args_p));
else {
printf_P(PSTR("Invalid register: "));
print_form(reg);
printf_P(PSTR("\n"));
}
release(1); // args_p
return NIL;
}
case S_SLP:
_delay_ms(TO_INT(eval(env, CAR(args))));
return NIL;
default:
printf_P(PSTR("ERROR: "));
print_form(fn);
printf_P(PSTR(" is not a function.\n"));
return NIL;
}
}
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);
}
}
static
obj syntax(obj rt){
let(lfind_var(car(car(rt))), render(tSyntaxLam, list3(cdr(car(rt)), cdr(rt), nil)));
return nil;
}