diff options
| -rw-r--r-- | src/ChangeLog | 10 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 11 | ||||
| -rw-r--r-- | src/interp/define.boot | 8 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 4 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 2 | ||||
| -rw-r--r-- | src/interp/spad.lisp | 2 | ||||
| -rw-r--r-- | src/interp/wi2.boot | 2 |
7 files changed, 30 insertions, 9 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index e5f8d552..c5ee7ffd 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,13 @@ +2010-03-04 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/c-util.boot (quoteMinimally): New. + (registerFunctionReplacement): Likewise. + * interp/define.boot (spadCompileOrSetq): Use it. + * interp/g-opt.boot (optSpecialCall): Likewise. + * interp/nruncomp.boot (optDeltaEntry): Likewise. + * interp/spad.lisp (|knownEqualPred|): Likewise. + * interp/wi2.boot (optDeltaEntry): Likewise. + 2010-03-01 Gabriel Dos Reis <gdr@cs.tamu.edu> * algebra/vector.spad.pamphlet (maxIndex$Vector): Define. diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 0f85c636..0b62a0f8 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -42,6 +42,8 @@ module c_-util where foldExportedFunctionReferences: %List -> %List diagnoseUnknownType: (%Mode,%Env) -> %Form declareUnusedParameters: (%List,%Code) -> %List + registerFunctionReplacement: (%Symbol,%Form) -> %Thing + getFunctionReplacement: %Symbol -> %Form --% @@ -86,6 +88,11 @@ $optExportedFunctionReference := false --% +++ Quote form, if not a basic value. +quoteMinimally form == + FIXP form or STRINGP form or form = nil or form = true => form + ["QUOTE",form] + ++ If using old `Rep' definition semantics, return `$' when m is `Rep'. ++ Otherwise, return `m'. dollarIfRepHack m == @@ -1035,6 +1042,10 @@ getFunctionReplacement name == clearReplacement name == REMPROP(name,"SPADreplace") +++ Register the inlinable form of a function. +registerFunctionReplacement(name,body) == + LAM_,EVALANDFILEACTQ ["PUT",MKQ name,MKQ "SPADreplace",quoteMinimally body] + eqSubstAndCopy: (%List, %List, %Form) -> %Form eqSubstAndCopy(args,parms,body) == SUBLIS(pairList(parms,args),body,KEYWORD::TEST,function EQ) diff --git a/src/interp/define.boot b/src/interp/define.boot index debdd992..e50aee3b 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -1247,16 +1247,16 @@ spadCompileOrSetq (form is [nam,[lam,vl,body]]) == body := replaceSimpleFunctions body if vl is [:vl',E] and body is [nam',: =vl'] then - LAM_,EVALANDFILEACTQ ['PUT,MKQ nam,MKQ 'SPADreplace,MKQ nam'] + registerFunctionReplacement(nam,nam') sayBrightly ['" ",:bright nam,'"is replaced by",:bright nam'] else if (isAtomicForm body or and/[isAtomicForm x for x in body]) and vl is [:vl',E] and not CONTAINED(E,body) then macform := ['XLAM,vl',body] - LAM_,EVALANDFILEACTQ ['PUT,MKQ nam,MKQ 'SPADreplace,MKQ macform] + registerFunctionReplacement(nam,macform) sayBrightly ['" ",:bright nam,'"is replaced by",:bright body] form := - GET(nam,"SPADreplace") => [nam,[lam,vl,["DECLARE",["IGNORE",E]],body]] + getFunctionReplacement nam => [nam,[lam,vl,["DECLARE",["IGNORE",E]],body]] [nam,[lam,vl,body]] $insideCapsuleFunctionIfTrue => diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 0e951254..cd095542 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -215,7 +215,7 @@ optSpecialCall(x,y,n) == keyedSystemError("S2GE0016",['"optSpecialCall", '"invalid constant"]) MKQ yval.n - fn := GETL(compileTimeBindingOf first yval.n,'SPADreplace) => + fn := getFunctionReplacement compileTimeBindingOf first yval.n => rplac(rest x,CDAR x) rplac(first x,fn) if fn is ["XLAM",:.] then x:=first optimize [x] diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 0dfd95f5..5194d7b8 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -175,7 +175,7 @@ optDeltaEntry(op,sig,dc,eltOrConst) == if CONSP fun then eltOrConst = "CONST" => return ['XLAM,'ignore, SPADCALL fun] fun := first fun - GETL(compileTimeBindingOf fun,'SPADreplace) + getFunctionReplacement compileTimeBindingOf fun genDeltaEntry opMmPair == --called from compApplyModemap diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp index 7761a1ef..3565ee15 100644 --- a/src/interp/spad.lisp +++ b/src/interp/spad.lisp @@ -456,7 +456,7 @@ (defun |knownEqualPred| (dom) (let ((fun (|compiledLookup| '= '((|Boolean|) $ $) dom))) - (if fun (get (bpiname (car fun)) '|SPADreplace|) + (if fun (|getFunctionReplacement| (bpiname (car fun))) nil))) (defun |hashable| (dom) diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot index b4e4c7f5..c2d4289e 100644 --- a/src/interp/wi2.boot +++ b/src/interp/wi2.boot @@ -691,7 +691,7 @@ optDeltaEntry(op,sig,dc,eltOrConst) == hehe fn [op] -----------> return just the op here -- ['XLAM,'ignore,MKQ SPADCALL fn] - GETL(compileTimeBindingOf first fn,'SPADreplace) + getFunctionReplacement compileTimeBindingOf first fn genDeltaEntry opMmPair == --called from compApplyModemap |