diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/ChangeLog | 5 | ||||
-rw-r--r-- | src/interp/c-util.boot | 21 |
2 files changed, 16 insertions, 10 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 9c6184cc..6ca2d147 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,10 @@ 2012-05-02 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/c-util.boot (backendCompileSPADSLAM): Do not devaluate + argument list. Tidy. + +2012-05-02 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/c-util.boot (backendCompileSPADSLAM): Tidy. Do not devaluate argument of unary constructors. diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 9e83d502..8942b72b 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -1549,28 +1549,29 @@ backendCompileSPADSLAM(name,args,body) == auxfn := makeSymbol strconc(name,'";") -- name of the worker function. g2 := gensym() -- local name for the cache value. u := - args = nil => [nil,nil,[auxfn]] - args is [g] => [args,g,[auxfn,g]] - g1 := gensym() -- local binding to the worker parameter list - [g1,["devaluateList",g1],["APPLY",["FUNCTION",auxfn],g1]] - arg := first u -- parameter list - argtran := second u -- argument to the worker - app := third u -- code to compute value + args = nil => [nil,[auxfn]] + args is [g] => [g,[auxfn,g]] + [gensym(),[auxfn,:args]] + key := first u -- key into the instantiation table cache + app := second u -- code to compute value code := args = nil => ["COND",[al],[true,["SETQ",al,app]]] - ["LET",[[g2,["assoc",argtran,al]]], + [binder,:inits] := + args is [.] => ["LET",[g2,["assoc",key,al]]] + ["LET*",[key,["LIST",:args]],[g2,["assoc",key,al]]] + [binder,inits, ["COND", [g2,["CDR",g2]], [true, ["PROGN",["SETQ",g2,app], - ["SETQ",al,["cons5",["CONS",argtran, g2],al]],g2]]]] + ["SETQ",al,["cons5",["CONS",key,g2],al]],g2]]]] SETANDFILE(al,nil) -- define the global cache. -- compile the worker function first. u := [auxfn,["LAMBDA",args,:body]] if $PrettyPrint then PRETTYPRINT u COMP370 [u] -- then compile the wrapper (which is the user-visible constructor). - u := [name,["LAM",arg,code]] + u := [name,["LAM",args,code]] if $PrettyPrint then PRETTYPRINT u COMP370 [u] name |