The Pico Evaluator

{ eval(Exp):
 error('evaluator not initialized');
 
 init_eval(Dct):
 { DCT: Dct;
 eval_variable (Exp):
 { nam: Exp[VAR_NAM_idx];
 get(nam, DCT) };
 call_function (Exp, Dct):
 { dct: DCT;
 DCT:= Dct;
 val: eval(Exp);
 DCT:= dct;
 val };
 bind_variable (Exp, Var, Dct):
 { nam: Var[VAR_NAM_idx];
 val: eval(Exp);
 add(nam, val, Dct) };
 bind_application (Exp, Apl, Dct):
 { nam: Apl[APL_NAM_idx];
 arg: Apl[APL_ARG_idx]; 
 fun: FUN(nam, arg, Exp, DCT);
 add(nam, fun, Dct) };
 bind_error(Tab, Err, Dct):
 error('illegal parameter');
 
 bind_case : case(VAR_tag => bind_variable,
 APL_tag => bind_application,
 else => bind_error);
 
 call_table (TbA, TbP, Dct):
 { tbA: TbA[TAB_TAB_idx];
 tbP: TbP[TAB_TAB_idx];
 siz: size(tbA);
 if(siz = size(tbP),
 for(k: 1, k:= k+1, not(k> siz),
 { arg: tbA[k];
 par: tbP[k];
 tag: par[TAG_idx];
 cas: bind_case(tag);
 Dct:= cas(arg, par, Dct) }),
 error('Illegal argument count'));
 Dct };
 call_variable (Tab, Var, Dct):
 { nam: Var[VAR_NAM_idx];
 tab: Tab[TAB_TAB_idx];
 siz: size(tab);
 exp: if(siz> 0,
 { idx: 0;
 arg[siz]: eval(tab[idx:= idx+1]);
 TAB(arg) },
 Empty);
 add(nam, exp, Dct) };
 
 call_error(Tab, Apl, Dct):
 error('illegal parameter');
 
 call_case : case(TAB_tag => call_table,
 VAR_tag => call_variable,
 else => call_error);
 
 eval_call (Fun, Tab):
 { par: Fun[FUN_PAR_idx];
 exp: Fun[FUN_EXP_idx];
 dct: Fun[FUN_DCT_idx];
 tag: par[TAG_idx];
 cas: call_case(tag);
 dct:= cas(Tab, par, dct);
 call_function(exp, dct) };
 eval_application (Exp):
 { nam: Exp[APL_NAM_idx];
 arg: Exp[APL_ARG_idx];
 exp: get(nam, DCT);
 if(exp[TAG_idx] = FUN_tag,
 if(arg[TAG_idx] = TAB_tag,
 eval_call(exp, arg),
 { val: eval(arg);
 if(val[TAG_idx] = TAB_tag,
 eval_call(exp, val),
 error('illegal argument')) }),
 if(exp[TAG_idx] = NAT_tag,
 { nat: exp[NAT_NAT_idx]; 
 nat@arg },
 error('(native) function required'))) };
 eval_tabulation (Exp):
 { nam: Exp[TBL_NAM_idx];
 exp: get(nam, DCT);
 if(exp[TAG_idx] = TAB_tag,
 { idx: Exp[TBL_IDX_idx];
 val: eval(idx);
 if(val[TAG_idx] = NBR_tag,
 { nbr: val[NBR_VAL_idx];
 if(nbr> 0, 
 { tab: exp[TAB_TAB_idx];
 if(nbr> size(tab),
 error('index beyond size'),
 tab[nbr]) },
 error('non-positive index')) },
 error('invalid index')) },
 error('table required')) };
 define_variable (Var, Exp):
 { nam: Var[VAR_NAM_idx];
 val: eval(Exp);
 DCT:= add(nam, val, DCT);
 val };
 
 define_application (Apl, Exp):
 { nam: Apl[APL_NAM_idx];
 arg: Apl[APL_ARG_idx];
 DCT:= add(nam, Void, DCT);
 fun: FUN(nam, arg, Exp, DCT);
 set(nam, fun, DCT);
 fun };
 
 define_tabulation (Tbl, Exp):
 { nam: Tbl[TBL_NAM_idx];
 idx: Tbl[TBL_IDX_idx];
 val: eval(idx);
 if(val[TAG_idx] = NBR_tag,
 { nbr: val[NBR_VAL_idx];
 if(nbr < 0, error('negative size'), { exp: if(nbr> 0,
 { tab[nbr]: eval(Exp);
 TAB(tab) },
 Empty );
 DCT:= add(nam, exp, DCT);
 exp }) },
 error('invalid size')) }; 
 
 define_error(Inv, Exp):
 error('invocation required');
 
 define_case : case(VAR_tag => define_variable,
 APL_tag => define_application,
 TBL_tag => define_tabulation,
 else => define_error);
 
 eval_definition (Exp):
 { inv: Exp[DEF_INV_idx];
 exp: Exp[DEF_EXP_idx];
 tag: inv[TAG_idx];
 cas: define_case(tag);
 cas(inv, exp) };
 assign_variable (Var, Exp):
 { nam: Var[VAR_NAM_idx];
 val: eval(Exp);
 set(nam, val, DCT);
 val };
 
 assign_application (Apl, Exp):
 { nam: Apl[APL_NAM_idx];
 arg: Apl[APL_ARG_idx];
 fun: FUN(nam, arg, Exp, DCT);
 set(nam, fun, DCT);
 fun };
 
 assign_tabulation (Tbl, Exp):
 { nam: Tbl[TBL_NAM_idx];
 exp: get(nam, DCT);
 if(exp[TAG_idx] = TAB_tag,
 { idx: Tbl[TBL_IDX_idx];
 val: eval(idx);
 if(val[TAG_idx] = NBR_tag,
 { nbr: val[NBR_VAL_idx];
 if(nbr> 0, 
 { tab: exp[TAB_TAB_idx];
 if(nbr> size(tab),
 error('index beyond size'),
 { tab[nbr]:= eval(Exp);
 exp }) },
 error('non-positive index')) },
 error('invalid index')) },
 error('table required')) };
 
 assign_error(Inv, Exp):
 error('invocation required');
 
 assign_case : case(VAR_tag => assign_variable,
 APL_tag => assign_application,
 TBL_tag => assign_tabulation,
 else => assign_error);
 
 eval_assignment (Exp):
 { inv: Exp[SET_INV_idx];
 exp: Exp[SET_EXP_idx];
 tag: inv[TAG_idx];
 cas: assign_case(tag);
 cas(inv, exp) };
 
 eval_identity (Exp):
 Exp;
 
 eval_case : case(VAR_tag => eval_variable,
 APL_tag => eval_application,
 TBL_tag => eval_tabulation,
 DEF_tag => eval_definition,
 SET_tag => eval_assignment,
 else => eval_identity);
 
 init_eval(Dct):=
 { DCT:= Dct;
 void };
 eval (Exp):=
 { tag: Exp[TAG_idx];
 cas: eval_case(tag);
 cas(Exp) };
 
 void };
 display('evaluator installed', eoln) }

This page was made (with lots of hard work!) by Wolfgang De Meuter