diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 7 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 48 | ||||
| -rw-r--r-- | src/interp/define.boot | 3 |
3 files changed, 57 insertions, 1 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index f2303833..fe4e7bb4 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,12 @@ 2008-10-03 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/c-util.boot (clearReplacement): New. + (getFunctionReplacement): Likewise. + (replaceSimpleFunctions): Likewise. + * interp/define.boot (spadCompileOrSetq): Use it. + +2008-10-03 Gabriel Dos Reis <gdr@cs.tamu.edu> + * algebra/Makefile.pamphlet: Turn non optimization for algbera build. 2008-10-02 Gabriel Dos Reis <gdr@cs.tamu.edu> diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 7bf1e1b9..28221176 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -35,6 +35,10 @@ import g_-util namespace BOOT +module c_-util where + clearReplacement: %Symbol -> %Thing + replaceSimpleFunctions: %Form -> %Form + --% ++ if true continue compiling after errors $scanIfTrue := false @@ -830,7 +834,46 @@ ambiguousSignatureError(op, sigs) == stackSemanticError(['"signature of lhs not unique. Candidates are:", :displayAmbiguousSignatures($op,sigs)],nil) ---% +--% + +-- A function is simple if it looks like a super combinator, and it +-- does not use its environment argument. They can be safely replaced +-- by more efficient (hopefully) functions. + +getFunctionReplacement: %Symbol -> %Form +getFunctionReplacement name == + GET(compileTimeBindingOf name, "SPADreplace") + +++ remove any replacement info possibly associated with `name'. +clearReplacement name == + REMPROP(name,"SPADreplace") + +++ Walk `form' and replace simple functions as appropriate. +replaceSimpleFunctions form == + atom form => form + form is ["QUOTE",:.] => form + -- process argument first. + for args in tails rest form repeat + arg' := replaceSimpleFunctions(arg := first args) + not EQ(arg',arg) => + rplac(first args, arg') + -- now, see if we know something about this function. + [fun,:args] := form + atom fun => + null (fun' := getFunctionReplacement fun) => form + -- the renaming case. + atom fun' => + rplac(first form,fun') + NBUTLAST form + -- the substitution case; ignore for now. + form + fun' := replaceSimpleFunctions fun + not EQ(fun',fun) => rplac(first form,fun') + form + + + +++ record optimizations permitted at level `level'. setCompilerOptimizations level == level = nil => nil INTEGERP level => @@ -843,6 +886,9 @@ setCompilerOptimizations level == $optReplaceSimpleFunctions := true coreError '"unknown optimization level request" + +--% + ++ Proclaim the type of the capsule function `op' with signature `sig'. ++ Note that all capsule functions take an additional argument ++ standing for the domain of computation object. diff --git a/src/interp/define.boot b/src/interp/define.boot index b607cd4b..5939cdcb 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1231,6 +1231,9 @@ spadCompileOrSetq (form is [nam,[lam,vl,body]]) == renameParameter() == NUMBERP v or IDENTP v or STRINGP v => v GENSYM '"flag" + clearReplacement nam -- Make sure we have fresh info + if $optReplaceSimpleFunctions then + body := replaceSimpleFunctions body form := [nam,[lam,vl,body]] if vl is [:vl',E] and body is [nam',: =vl'] then |