From 320bfbef8191b62cc00cbd89b93f06ada8801585 Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Sat, 27 Jul 2024 20:09:22 -0700 Subject: [PATCH] Continue optimizing eval_expr & friends --- images/apple/DRAWL.po | Bin 143360 -> 143360 bytes src/lisp/s-expr.pla | 190 +++++++++++++++++++++--------------------- 2 files changed, 95 insertions(+), 95 deletions(-) diff --git a/images/apple/DRAWL.po b/images/apple/DRAWL.po index b6cd0a6d7b7240e5f4ffd754528bdaf8e36ae8ae..9d79a957da67e05e1dbcf6e6c953345c4c797bfc 100644 GIT binary patch delta 3291 zcmaLYeNY_b9S88=v$qGwp|HU5a=cu)<2W$YB?+}6$s}C3Bc(3Kc`S$|Q{|Fek?7?` zg0(MRb{gBHDn0SWPF*C7a=7;+LSg?o7$?5b84>kJH{EF&>Z2Fj}aQb&vUdEuf5WzXecbkeYatEpvwXuH2Hv69wi zw-Y1cmdawCfqG+UW_+4hJkf2Od4bEY43rO5Cg%tILy29*#(jZFq_rfTOr8Xb615p`L445v=G%9gZK@b)LkQNMP$L&&tpW$RA<;D zAJ6?3x_p~X zX=Pf|#dVr7om8ona1X8&9NHZ6i?%LvuR1ou9Fg~MId;W)QR^9k`ab(jp)`F1&U1vm zAt+hUhP1pP*wIh^G3I|6ncf+}xrY2zq#Y!PUwOeMVrNzb|W;OX{7yY}n zx?c&-)sgr(tt2}>BtE`C4{*0Ae(u;b^{B({!)g0oF{2yX_(sV|VyR!t@YcSE zc81Hn9d4;!Che$K3eggFV8kb{mpK2b6&r%RXVv*pw#xMgg>cE4uVrI94w>-81b>~Qg?vQfTd@8V-M@jJUOp1_x9A0OgkIkk42x$x?Bjk9l{ zd3BtvZCS82^zqwxZLlS&I?QQr78if8s~QrM`|(zA+T+32MsQ=}^V)p>SPXGkQ2p8o zR#LNI+vl4{B2gqimWLDcFOAmTo;|T?;=4M0g4wa1sT1tZoCO&i2bAp}5nNR(c z?Z%*$6Ku>bREBv;i0>qR*bu)*dvmBRJ&1J$_0tKqnoX#;pJZP`QRhi^6wL=GnTWIah2sN8QL`ldtZaR@lrkxABo+CNP)+uB1_{hapBBftrJ$h+m%7CkI=h@AIcJy>*z>Av=s zjoyG?&ty78gReDF8?j*_x6h+rY^)Hu*2Jn9$@|(RNx#N9MN?C|uTgGp_35coPBG2n zZEE&;^#pT?Mt30KzF&{$T-bPhXuTtomEkK2xI1gNcYmn(6t`ru*RzX}N z^uQ6Ag)8tea8BY*flx`@1TYtIbKt5XZU-EK%kUu>tBI?wCS?aBB@DY6O>g}?IPB~-(supfqD3NB|;)GY8ywm{Kb!JynBkkSO3VGrzu zC*c4b!Jb(KT~K>euw^B5Sd5fIubV#up(0Ozy@}37Ex3#;+1V^52GDIZWJb9 z2Dy3Ua;z8!Rj|@Z(FSXI)N8GXN>+z*FLL)mH*A9*coh2Kad^T?5oJF*Pr;Aid3Xs% zVH{4wFX6ZFCj1d*VGb_CJY0i+!>7O(vjw)o zL$DXV4c~)<5Cs(m;RP6l2{;4i;3E7P-i5!x`|uG^2`OnHKmn|PN~nQ5VLfWELwux1inq>|ee*33RxTwWQEiN^xDYZ_|TRBoWe zAJbY&C$Cu>tC&7G)>07s|A0eK(TJK5N?1lvs(kSneNMEd4j`C|YuyExDwqe4Hg7sFhryvf7|`n}5;1 zZ{n6VWh{MQwEsJGHh+DSBHUgZ=>#wr0b1t{54y0 zQPI}q#B0fkVI-;-ea%;>(BByJHQifG6d0omNn5-^w692blE|N3MZ3o{-eeDFv4QB; zLH0FEjaHpv_U6>RPP6i4PDMyi))#l1LbSoy#{U}Ho_Crr1&j+%JYaUsG4u>=ohF2vx*jNT%~HsOguei-_7E*> z=_a{QkpIjFjcxw>;%&D{K9AnsNwe$wq)o;&5APZHHnA6fjvi^7!)PXt!^XC5w1KO4 z<)85S_sp(!Ja264QwDd!K7in#NJd?M=udtsL=qsk;PE+81 zlF|dset(It#p~aw5XzK)7NDi>T#_4^Y(!5)rFIY3qvb-o?F#p= z^cKsurP*lj5Ze`gfn*0s%j!G3TRZl&|DVN3-cGX2H?7~Wm-pk_<}J2O@+zK-Uo3Bt zDdL$F?W%c;3_m!IhF%JKf!KUVc-~orH;or73J8kK#9uUN9}Ou3(e=Zup82EdFgvt% zz}`tcL+Sjf{J@VW*GeA~wYvC?_rw!<0v!}Xf|iRuIKtfcD1#&HDKzhnu&VL_d-XxF zUF4JV7FBl&r|?Y(@gr7LE7zjMqpS!oGVs;ikf1+X6!;kgem-pXR0i*BZ@VWji&=>s zDTi`#0(>C)D0Xbvua(7jb$FDOVmm{l?0eY*cH|bHBl@3FHi0vboMF#ml4Fbwms-m@ zMZY<|a(uy%xIg|SrnF&QYjkdmtzi>U*ID);isZBGIGV4{G6_v#jMbvq6=TbD@L`&$ zL^cpT=P*C*Fyov@Vyqg&AIF%z>Zqq%;2)Z>ct>{Jf*$)V3x`^GPOKqFp?-^$+(J15We3)E&V`kimd)g@(YP><^n1x3-c~qN-x}1_& z(->&d2Tvg6zdH5sR;eUFm51l@i?vhgLngcaTePcjRO}Qjft*@>=;L{UnZpr8k2E9Ayg!rFFdTu`;kWQMoQ4=oz$N$q>{+C)gCD^@IGsh2 z3t6K2KH5KJ8Ppl%$V{pQRzoHDU<>RtQ{)-5sCJ=!5p550FPkYG=`|bF2!ehLoX5Z< z+9~96vPmt4Rj>xu!6xuR9XtWMp%+Hs@9;0U16etwE{77RfNk&|+y+A~sb+A%4|2n# zZboM}bihG41S&+}7@ULw7=z331zd-3p(>BmmOP4d<%#N#(LR@FP+vmsRX74~!x@Od zN5CwkdMp(2T5OTWEutC-hu3TV!!$WQY{^%b-~%QvXw$bAYo z5oZ^O>iq>2X+hgwfK9_;_$9m!zlTALpD7U3N%SwG|6zea{S5u9Fo!t&4H70RscBFI zZdd^;trXd571a*3Z=yYeTnr}QGIDds*=(2xtD(|HkuA28NQ2E8QEU!%2Xeb$4|G5m zyZ|qO3cYaHMq%|0boyZsh9Cy#;Uc^be}T{8A21CwFbi{V3+{qYNa}r%1vy}WB5=YA zSOe>!8tR}Cn&I(6y#ID|o`GlKMR*y00TDO`zk!o*3Suw;AHv7*1$+tD;cNIW+=0|0 zQZvB{cJRO|SPu_D9r&SzPuvOZ(d$!e7Qb6Rzrb2EJ*9vAcdr=>car // Lambda expression if funexpr->type <> CONS_TYPE @@ -789,118 +789,118 @@ def apply_funargs(funarg, argvals) // push_sweep_stack(assoc_list) // Save current association list argbase = eval_args(argvals) - assoc_list = funarg=>cdr=>cdr=>car // Swap association list pointer + funalist = funarg=>cdr=>cdr + assoc_list = funalist=>car // Swap association list pointer pair_args(funexpr=>cdr=>car, argbase) - funexpr = eval_expr(funexpr=>cdr=>cdr=>car) - funarg=>cdr=>cdr=>car = assoc_list // Save updated FUNARG associations - assoc_list = pop_sweep_stack // Restore association list + funexpr = eval_expr(funexpr=>cdr=>cdr=>car) + funalist=>car = assoc_list // Save updated FUNARG associations + assoc_list = pop_sweep_stack // Restore association list return funexpr end -export def eval_expr(expr)#1 - var alist_enter, curl, expr_car +def eval_atom(atom)#1 + // + // Atom - return the symbol value or the atom itself + // + if atom and atom->type & TYPE_MASK == SYM_TYPE + if atom=>lambda // DEFINEd lambda S-expression + return atom=>lambda + fin + if atom=>apval // Constant + return atom=>apval ^ NULL_HACK + fin + if atom=>array // Array + return atom=>array + fin // Look on the association list last + return assoc(atom) + fin + return atom +end - if hook_eval; expr = hook_eval(expr); fin - if gc_pull > GC_TRIGGER; gc; fin - alist_enter = assoc_list - curl = NULL // Current lambda - while expr - if expr->type == CONS_TYPE - // - // List - first element better be a function - // - expr_car = expr=>car - if expr_car->type & TYPE_MASK == SYM_TYPE - if expr_car=>natv - expr = expr_car=>natv(expr_car, expr=>cdr) // Native function - break - elsif expr_car=>lambda // DEFINEd lambda S-expression - expr_car = expr_car=>lambda - elsif expr_car == sym_cond // Inline cond() evaluation - expr = expr=>cdr - while expr - if eval_expr(expr=>car=>car) - expr = expr=>car=>cdr=>car - break +export def eval_expr(expr)#1 + var alist_enter, curl, func, args + + if expr + if expr->type <> CONS_TYPE; return eval_atom(expr); fin + if hook_eval; expr = hook_eval(expr); fin + if gc_pull > GC_TRIGGER; gc; fin + alist_enter = assoc_list + curl = NULL // Current lambda + while expr + if expr->type == CONS_TYPE + // + // List - first element better be a function + // + func = expr=>car + args = expr=>cdr + if func->type & TYPE_MASK == SYM_TYPE + if func=>natv + expr = func=>natv(func, args) // Native function + break + elsif func == sym_cond // Inline cond() evaluation + while args + if eval_expr(args=>car=>car) + expr = args=>car=>cdr=>car + break + fin + args = args=>cdr + loop + elsif func == sym_if // Inline if() evaluation + if eval_expr(args=>car) + expr = args=>cdr=>car // THEN clause + else + expr = args=>cdr=>cdr + if expr // Check for ELSE clause + expr = expr=>car + fin fin - expr = expr=>cdr - loop - elsif expr_car == sym_if // Inline if() evaluation - expr = expr=>cdr - if eval_expr(expr=>car) - expr = expr=>cdr=>car // THEN clause - else - expr = expr=>cdr=>cdr - if expr // Check for ELSE clause - expr = expr=>car + else // Associated symbol + func = eval_atom(func) + if !func or func->type <> CONS_TYPE + puts("Non-function EVAL:"); print_expr(expr); putln + expr = NULL fin fin - else // Associated symbol - if expr_car=>apval - expr_car = expr_car=>apval ^ NULL_HACK - else - expr_car = assoc(expr_car) - if !expr_car // Make sure we don't hang - puts("NULL EVAL:"); print_expr(expr); putln - expr = NULL - break + else + curl = NULL // Set-up for in-line LAMBDA + fin + if func->type == CONS_TYPE + if func=>car == sym_label // LABEL + new_assoc(func=>cdr=>car, func=>cdr=>cdr=>car) // Add LABEL + func = func=>cdr=>cdr=>car // Continue evaluating LAMBDA + fin + if func=>car == sym_lambda // LAMBDA + if curl == func // Tail recursion: overwrite associations + set_args(func=>cdr=>car, eval_args(args)) + else // Add argument association pair list + pair_args(func=>cdr=>car, eval_args(args)) + curl = func fin + expr = func=>cdr=>cdr=>car + if trace + puts("\nTRACE:"); print_expr(func) + puts("\n ASSOC:"); print_expr(assoc_list); putln + fin + elsif func=>car == sym_funarg // FUNARG + expr = apply_funargs(func, expr=>cdr) + break + else + puts("Non-LAMBDA EVAL:"); print_expr(expr); putln + expr = NULL fin fin else - curl = NULL // Set-up for in-line LAMBDA + expr = eval_atom(expr) + break fin - if expr_car->type == CONS_TYPE - if expr_car=>car == sym_label // LABEL - new_assoc(expr_car=>cdr=>car, expr_car=>cdr=>cdr=>car) // Add LABEL - expr_car = expr_car=>cdr=>cdr=>car // Continue evaluating LAMBDA - fin - if expr_car=>car == sym_lambda // LAMBDA - if curl == expr_car // Tail recursion: overwrite associations - set_args(expr_car=>cdr=>car, eval_args(expr=>cdr)) - else // Add argument association pair list - pair_args(expr_car=>cdr=>car, eval_args(expr=>cdr)) - curl = expr_car - fin - expr = expr_car=>cdr=>cdr=>car - if trace - puts("\nTRACE:"); print_expr(expr_car) - puts("\n ASSOC:"); print_expr(assoc_list); putln - fin - elsif expr_car=>car == sym_funarg // FUNARG - expr = apply_funargs(expr_car, expr=>cdr) - break - else - puts("Invalid EVAL:"); print_expr(expr); putln - expr = NULL - break - fin - fin - else - // - // Atom - return the symbol value or the atom itself - // - if expr->type & TYPE_MASK == SYM_TYPE - if expr=>apval // Constant - expr = expr=>apval ^ NULL_HACK - elsif expr=>lambda // DEFINEd lambda S-expression - expr = expr=>lambda - elsif expr=>array // Array - expr = expr=>array - else // Look on the association list last - expr = assoc(expr) - fin - fin - break - fin - loop - assoc_list = alist_enter // Unwind assoc_list + loop + assoc_list = alist_enter // Unwind assoc_list + fin return expr end export def eval_quote(expr, hook)#1 hook_eval = hook - assoc_list = NULL push_sweep_stack(expr) // Keep expr from being GC'ed expr = eval_expr(expr) pop_sweep_stack