aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2010-03-04 07:47:36 +0000
committerdos-reis <gdr@axiomatics.org>2010-03-04 07:47:36 +0000
commit5c643bf0dce03bf61ead5b95c27de845ac242680 (patch)
treebbfc41a53872a179105e843f32ce7fe74fe55083 /src/interp
parent89122c246b751bba715be67884000a0ef236975d (diff)
downloadopen-axiom-5c643bf0dce03bf61ead5b95c27de845ac242680.tar.gz
* 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.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/c-util.boot11
-rw-r--r--src/interp/define.boot8
-rw-r--r--src/interp/g-opt.boot4
-rw-r--r--src/interp/nruncomp.boot2
-rw-r--r--src/interp/spad.lisp2
-rw-r--r--src/interp/wi2.boot2
6 files changed, 20 insertions, 9 deletions
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