aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-05-01 13:10:37 +0000
committerdos-reis <gdr@axiomatics.org>2011-05-01 13:10:37 +0000
commit8ca7f8357b22f6a24eeafeeddc6d18270d5fa9ad (patch)
tree3f4b24390293908da86345a544971b8302a4490c /src/interp
parentdd6933dbbfb9d8247876e818c7053218944e70a3 (diff)
downloadopen-axiom-8ca7f8357b22f6a24eeafeeddc6d18270d5fa9ad.tar.gz
* interp/vmlisp.lisp (EQSUBSTLIST): Remove.
* interp/c-util.boot (eqSubstAndCopy, eqSubst): Likewise. Adjust callers.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/c-util.boot15
-rw-r--r--src/interp/compiler.boot8
-rw-r--r--src/interp/define.boot6
-rw-r--r--src/interp/macros.lisp2
-rw-r--r--src/interp/showimp.boot8
-rw-r--r--src/interp/vmlisp.lisp2
6 files changed, 16 insertions, 25 deletions
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 38946378..bb67ffd7 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1139,15 +1139,6 @@ clearReplacement name ==
registerFunctionReplacement(name,body) ==
LAM_,EVALANDFILEACTQ ["PUT",MKQ name,MKQ "SPADreplace",quoteMinimally body]
-eqSubstAndCopy: (%List %Form, %List %Symbol, %Form) -> %Form
-eqSubstAndCopy(args,parms,body) ==
- applySubst(pairList(parms,args),body)
-
-eqSubst: (%List %Form, %List %Symbol, %Form) -> %Form
-eqSubst(args,parms,body) ==
- NSUBLIS(pairList(parms,args),body,KEYWORD::TEST,function EQ)
-
-
++ Attempt to resolve the indirect reference to a constant form
++ `[spadConstant,$,n]' to a simpler expression
resolveConstantForm form ==
@@ -1181,8 +1172,8 @@ inlineDirectCall call ==
and/[sideEffectFree? arg for arg in call.args] =>
-- alpha rename before substitution.
newparms := [gensym() for p in parms]
- body := eqSubstAndCopy(newparms,parms,body)
- eqSubst(call.args,newparms,body)
+ body := applySubst(pairList(parms,newparms),body)
+ applySubst!(pairList(newparms,call.args),body)
-- get cute later.
call
call
@@ -1332,7 +1323,7 @@ proclaimCapsuleFunction(op,sig) ==
backendCompileILAM: (%Symbol,%List %Symbol, %Code) -> %Symbol
backendCompileILAM(name,args,body) ==
args' := [gensym() for . in 1..#args]
- body' := eqSubst(args',args,body)
+ body' := applySubst!(pairList(args,args'),body)
property(name,'ILAM) := true
setDynamicBinding(name,["LAMBDA",args',:body'])
name
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 6df3e914..c679cadd 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1550,9 +1550,11 @@ compColon([":",f,t],m,e) ==
e:=
f is [op,:argl] =>
--for MPOLY--replace parameters by formal arguments: RDJ 3/83
- newTarget := EQSUBSTLIST(take(#argl,$FormalMapVariableList),
- [(x is [":",a,m] => a; x) for x in argl],t)
- signature:=
+ --FIXME: why? -- gdr 2011-04-30
+ newTarget :=
+ applySubst(pairList([(x is [":",a,m] => a; x) for x in argl],
+ $FormalMapVariableList),t)
+ signature :=
["Mapping",newTarget,:
[(x is [":",a,m] => m;
getmode(x,e) or systemErrorHere ['"compColon",x]) for x in argl]]
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 02c8a269..4cc81d97 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -395,8 +395,8 @@ templateVal(template,domform,index) ==
++ `pred' (a VM instruction form). Emit appropriate info into the
++ databases.
emitSubdomainInfo(form,super,pred) ==
- pred := eqSubst($AtVariables,form.args,pred)
- super := eqSubst($AtVariables,form.args,super)
+ pred := applySubst!(pairList(form.args,$AtVariables),pred)
+ super := applySubst!(pairList(form.args,$AtVariables),super)
evalAndRwriteLispForm("evalOnLoad2",["noteSubDomainInfo",
quoteForm form.op,quoteForm super, quoteForm pred])
@@ -739,7 +739,7 @@ mkCategoryPackage(form is [op,:argl],cat,def) ==
compDefineCategory2(form,signature,specialCases,body,m,e,
$prefix,$formalArgList) ==
--1. bind global variables
- $insideCategoryIfTrue: local:= true
+ $insideCategoryIfTrue: local := true
$definition: local := form --used by DomainSubstitutionFunction
$form: local := nil
$op: local := nil
diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp
index 3fadfeac..c98ab032 100644
--- a/src/interp/macros.lisp
+++ b/src/interp/macros.lisp
@@ -1,6 +1,6 @@
;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
;; All rights reserved.
-;; Copyright (C) 2007-2010, Gabriel Dos Reis.
+;; Copyright (C) 2007-2011, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot
index 5fcfc582..1b13836a 100644
--- a/src/interp/showimp.boot
+++ b/src/interp/showimp.boot
@@ -163,11 +163,11 @@ devaluateSlotDomain(u,dollar) ==
devaluate evalSlotDomain(u,dollar)
getCategoriesOfDomain domain ==
- predkeyVec := domain.4.0
- catforms := second domain.4
+ predkeyVec := first vectorRef(domain,4)
+ catforms := second vectorRef(domain,4)
[fn for i in 0..maxIndex predkeyVec | test] where
- test() == predkeyVec.i and
- (x := catforms . i) isnt ['DomainSubstitutionMacro,:.]
+ test() == arrayRef(predkeyVec,i) and
+ (x := vectorRef(catforms,i)) isnt ['DomainSubstitutionMacro,:.]
fn() ==
vector? x => devaluate x
devaluateSlotDomain(x,domain)
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index 1ba8da59..ff5ff941 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -957,8 +957,6 @@
(defun copy (x) (copy-tree x)) ; not right since should descend vectors
-(defun eqsubstlist (new old list) (sublis (mapcar #'cons old new) list))
-
; Gen code for SETQP expr
(eval-when