aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/boot/strap/utility.clisp25
-rw-r--r--src/boot/utility.boot23
-rw-r--r--src/interp/c-util.boot10
-rw-r--r--src/interp/clammed.boot2
-rw-r--r--src/interp/daase.lisp2
-rw-r--r--src/interp/fortcall.boot8
-rw-r--r--src/interp/ht-util.boot5
-rw-r--r--src/interp/htsetvar.boot2
-rw-r--r--src/interp/i-analy.boot2
-rw-r--r--src/interp/i-eval.boot2
-rw-r--r--src/interp/i-funsel.boot6
-rw-r--r--src/interp/i-resolv.boot2
-rw-r--r--src/interp/i-special.boot2
-rw-r--r--src/interp/macros.lisp7
-rw-r--r--src/interp/modemap.boot7
-rw-r--r--src/interp/packtran.boot2
-rw-r--r--src/interp/patches.lisp1
-rw-r--r--src/interp/pf2atree.boot6
-rw-r--r--src/interp/pf2sex.boot6
-rw-r--r--src/interp/sys-macros.lisp2
-rw-r--r--src/interp/sys-utility.boot21
-rw-r--r--src/interp/termrw.boot2
-rw-r--r--src/interp/vmlisp.lisp4
23 files changed, 81 insertions, 68 deletions
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index 5e6003fc..4f9a741f 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -7,7 +7,8 @@
(EXPORT '(|objectMember?| |symbolMember?| |stringMember?| |charMember?|
|scalarMember?| |listMember?| |reverse| |reverse!|
- |lastNode| |append!| |copyList|))
+ |lastNode| |append!| |copyList| |substitute|
+ |substitute!|))
(DEFUN |objectMember?| (|x| |l|)
(LOOP
@@ -119,3 +120,25 @@
((NULL |y|) |x|)
(T (RPLACD (|lastNode| |x|) |y|) |x|)))
+(DEFUN |substitute!| (|y| |x| |s|)
+ (COND
+ ((NULL |s|) NIL)
+ ((EQ |x| |s|) |y|)
+ (T (COND
+ ((CONSP |s|) (RPLACA |s| (|substitute!| |y| |x| (CAR |s|)))
+ (RPLACD |s| (|substitute!| |y| |x| (CDR |s|)))))
+ |s|)))
+
+(DEFUN |substitute| (|y| |x| |s|)
+ (PROG (|t| |h|)
+ (RETURN
+ (COND
+ ((NULL |s|) NIL)
+ ((EQ |x| |s|) |y|)
+ ((CONSP |s|) (SETQ |h| (|substitute| |y| |x| (CAR |s|)))
+ (SETQ |t| (|substitute| |y| |x| (CDR |s|)))
+ (COND
+ ((AND (EQ |h| (CAR |s|)) (EQ |t| (CDR |s|))) |s|)
+ (T (CONS |h| |t|))))
+ (T |s|)))))
+
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index bde1090b..6527a07a 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -34,7 +34,7 @@ import initial_-env
namespace BOOTTRAN
module utility (objectMember?, symbolMember?, stringMember?,
charMember?, scalarMember?, listMember?, reverse, reverse!,
- lastNode, append!, copyList)
+ lastNode, append!, copyList, substitute, substitute!)
--% membership operators
@@ -133,3 +133,24 @@ append!(x,y) ==
y = nil => x
lastNode(x).rest := y
x
+
+--% substitution
+
+substitute!(y,x,s) ==
+ s = nil => nil
+ sameObject?(x,s) => y
+ if cons? s then
+ s.first := substitute!(y,x,first s)
+ s.rest := substitute!(y,x,rest s)
+ s
+
+substitute(y,x,s) ==
+ s = nil => nil
+ sameObject?(x,s) => y
+ cons? s =>
+ h := substitute(y,x,first s)
+ t := substitute(y,x,rest s)
+ sameObject?(h,first s) and sameObject?(t,rest s) => s
+ [h,:t]
+ s
+
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 855cf50c..619555d0 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -900,19 +900,19 @@ extendsCategoryForm(domain,form,form') ==
--Must be $e to pick up locally bound domains
form' is ["SIGNATURE",op,args,:.] =>
assoc([op,args],formVec.1) or
- assoc(SUBSTQ(domain,"$",[op,args]),
- SUBSTQ(domain,"$",formVec.1))
+ assoc(substitute(domain,"$",[op,args]),
+ substitute(domain,"$",formVec.1))
form' is ["ATTRIBUTE",at] =>
assoc(at,formVec.2) or
- assoc(SUBSTQ(domain,"$",at),SUBSTQ(domain,"$",formVec.2))
+ assoc(substitute(domain,"$",at),substitute(domain,"$",formVec.2))
form' is ["IF",:.] => true --temporary hack so comp won't fail
-- Are we dealing with an Aldor category? If so use the "has" function ...
# formVec = 1 => newHasTest(form,form')
catvlist:= formVec.4
listMember?(form',first catvlist) or
- listMember?(form',SUBSTQ(domain,"$",first catvlist)) or
+ listMember?(form',substitute(domain,"$",first catvlist)) or
(or/
- [extendsCategoryForm(domain,SUBSTQ(domain,"$",cat),form')
+ [extendsCategoryForm(domain,substitute(domain,"$",cat),form')
for [cat,:.] in second catvlist])
nil
diff --git a/src/interp/clammed.boot b/src/interp/clammed.boot
index eb3eda6d..4c04ddba 100644
--- a/src/interp/clammed.boot
+++ b/src/interp/clammed.boot
@@ -119,7 +119,7 @@ isValidType form ==
cl:= replaceSharps(cl,form)
and/[isValid for x in argl for c in cl] where isValid() ==
categoryForm?(c) =>
- evalCategory(x,MSUBSTQ(x,'_$,c)) and isValidType x
+ evalCategory(x,substitute(x,'_$,c)) and isValidType x
-- Arguments to constructors are general expressions. Below
-- domain constructors are not considered valid arguments (yet).
x' := opOf x
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index bec950bc..c51f8ef2 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -1566,7 +1566,7 @@
(flat expr)
(dolist (leaf leaves)
(when (setq pos (position leaf *compressvector*))
- (nsubst (- pos) leaf expr)))
+ (|substitute!| (- pos) leaf expr)))
expr)))
(defun write-operationdb ()
diff --git a/src/interp/fortcall.boot b/src/interp/fortcall.boot
index a4ed15dd..5f7096d6 100644
--- a/src/interp/fortcall.boot
+++ b/src/interp/fortcall.boot
@@ -757,7 +757,7 @@ multiToUnivariate f ==
newVariable := gensym()
for index in 0..#vars-1 repeat
-- Remember that AXIOM lists, vectors etc are indexed from 1
- body := NSUBST(["elt",newVariable,index+1],vars.index,body)
+ body := substitute!(["elt",newVariable,index+1],vars.index,body)
-- We want a Vector DoubleFloat -> DoubleFloat
target := [["DoubleFloat"],["Vector",["DoubleFloat"]]]
rest interpret ["ADEF",[newVariable],target,[[],[]],body]
@@ -780,8 +780,8 @@ functionAndJacobian f ==
newVariable := gensym()
for index in 0..#vars-1 repeat
-- Remember that AXIOM lists, vectors etc are indexed from 1
- funBodies := NSUBST(["elt",newVariable,index+1],vars.index,funBodies)
- jacBodies := NSUBST(["elt",newVariable,index+1],vars.index,jacBodies)
+ funBodies := substitute!(["elt",newVariable,index+1],vars.index,funBodies)
+ jacBodies := substitute!(["elt",newVariable,index+1],vars.index,jacBodies)
target := [["Vector",["DoubleFloat"]],["Vector",["DoubleFloat"]],["Integer"]]
rest interpret
["ADEF",[newVariable,"flag"],target,[[],[],[]],_
@@ -802,7 +802,7 @@ vectorOfFunctions f ==
newVariable := gensym()
for index in 0..#vars-1 repeat
-- Remember that AXIOM lists, vectors etc are indexed from 1
- funBodies := NSUBST(["elt",newVariable,index+1],vars.index,funBodies)
+ funBodies := substitute!(["elt",newVariable,index+1],vars.index,funBodies)
target := [["Vector",["DoubleFloat"]],["Vector",["DoubleFloat"]]]
rest interpret ["ADEF",[newVariable],target,[[],[]],["vector",["construct",:funBodies]]]
diff --git a/src/interp/ht-util.boot b/src/interp/ht-util.boot
index 0c97430f..9c35fab5 100644
--- a/src/interp/ht-util.boot
+++ b/src/interp/ht-util.boot
@@ -570,8 +570,9 @@ htEscapeString str ==
unescapeStringsInForm form ==
string? form =>
- str := NSUBSTITUTE(char "_"", $funnyQuote, form)
- NSUBSTITUTE(char "\", $funnyBacks, str)
+ for i in 0..maxIndex form repeat
+ stringChar(form,i) = $funnyQuote => stringChar(form,i) := char "_""
+ stringChar(form,i) = $funnyBacks => stringChar(form,i) := char "\"
cons? form =>
unescapeStringsInForm first form
unescapeStringsInForm rest form
diff --git a/src/interp/htsetvar.boot b/src/interp/htsetvar.boot
index 8c1af47e..f05c43fc 100644
--- a/src/interp/htsetvar.boot
+++ b/src/interp/htsetvar.boot
@@ -340,7 +340,7 @@ htMakePathKey path ==
fn(strconc(a,'".",PNAME first b),rest b)
htMarkTree(tree,n) ==
- LASTTAIL(tree).rest := n
+ lastNode(tree).rest := n
for branch in tree repeat
branch.3 = 'TREE => htMarkTree(branch.5,n + 1)
diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot
index b44a0ac1..718897ec 100644
--- a/src/interp/i-analy.boot
+++ b/src/interp/i-analy.boot
@@ -94,7 +94,7 @@ getMinimalVarMode(id,m) ==
$Symbol
null m => defaultMode
(vl := polyVarlist m) and ((id in vl) or 'all in vl) =>
- SUBSTQ($Integer,$EmptyMode,m)
+ substitute($Integer,$EmptyMode,m)
(um := underDomainOf m) => getMinimalVarMode(id,um)
defaultMode
diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot
index 216e64ad..e0772989 100644
--- a/src/interp/i-eval.boot
+++ b/src/interp/i-eval.boot
@@ -184,7 +184,7 @@ evaluateType1 (form is [op,:argl]) ==
for x in argl for m in ml for argnum in 1.. repeat
typeList := [v,:typeList] where v() ==
categoryForm?(m) =>
- m := evaluateType MSUBSTQ(x,'_$,m)
+ m := evaluateType substitute(x,'_$,m)
evalCategory(x' := (evaluateType x), m) => x'
throwEvalTypeMsg("S2IE0004",[form])
m := evaluateType m
diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot
index 0879b47d..ae8d799a 100644
--- a/src/interp/i-funsel.boot
+++ b/src/interp/i-funsel.boot
@@ -825,7 +825,7 @@ allOrMatchingMms(mms,args1,tar,dc) ==
x := NIL
for mm in mms repeat
[sig,:.] := mm
- [res,:args] := MSUBSTQ(dc,"$",sig)
+ [res,:args] := substitute(dc,"$",sig)
args ~= args1 => nil
x := [mm,:x]
if x then x
@@ -849,7 +849,7 @@ findFunctionInDomain1(omm,op,tar,args1,args2,SL) ==
[sig,slot,cond,y] := mm
[osig,:.] := omm
- osig := subCopy(osig, SUBSTQ(['$,:'$], dollarPair, SL))
+ osig := subCopy(osig, substitute(['$,:'$], dollarPair, SL))
if CONTAINED('_#, sig) or CONTAINED('construct,sig) then
sig := [replaceSharpCalls t for t in sig]
matchMmCond cond and matchMmSig(mm,tar,args1,args2) and
@@ -893,7 +893,7 @@ findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) ==
if maxargs ~= -1 then
SL:= NIL
for i in 1..maxargs repeat
- impls := SUBSTQ(gensym(),INTERNL('"#",STRINGIMAGE i),impls)
+ impls := substitute(gensym(),INTERNL('"#",STRINGIMAGE i),impls)
impls and
SL:= constructSubst dc
for mm in impls repeat
diff --git a/src/interp/i-resolv.boot b/src/interp/i-resolv.boot
index 7a1a223e..1308fb54 100644
--- a/src/interp/i-resolv.boot
+++ b/src/interp/i-resolv.boot
@@ -466,7 +466,7 @@ resolveTM(t,m) ==
$Subst : local := NIL
$Coerce : local := 'T
t := eqType t
- m := eqType SUBSTQ("**",$EmptyMode,m)
+ m := eqType substitute("**",$EmptyMode,m)
tt := resolveTM1(t,m)
result := tt and isValidType tt and eqType tt
stopTimingProcess 'resolve
diff --git a/src/interp/i-special.boot b/src/interp/i-special.boot
index a167f8e3..b1a5ae71 100644
--- a/src/interp/i-special.boot
+++ b/src/interp/i-special.boot
@@ -816,7 +816,7 @@ checkForFreeVariables(v,locals) ==
["getSimpleArrayEntry","envArg",positionInVec(0,#($freeVariables))]
v
LISTP v =>
- rest(LASTTAIL v) => -- Must be a better way to check for a genuine list?
+ rest(lastNode v) => -- Must be a better way to check for a genuine list?
v
[op,:args] := v
LISTP op =>
diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp
index 33e60ffe..39ee68f4 100644
--- a/src/interp/macros.lisp
+++ b/src/interp/macros.lisp
@@ -168,9 +168,6 @@
(DEFUN STRINGSUFFIX (TARGET SOURCE) "Suffix source to target if enough room else nil."
(concatenate 'string target source))
-(defun NSTRCONC (s1 s2) (concatenate 'string (string s1) (string s2)))
-
-
(defun THETACHECK (VAL VAR OP) (if (EQL VAL VAR) (THETA_ERROR OP) val))
; 15 LISTS
@@ -180,7 +177,7 @@
(defmacro TL (&rest L) `(tail . ,L))
-(DEFUN LASTELEM (X) (car (last X)))
+(DEFUN LASTELEM (X) (car (|lastNode| X)))
(defun LISTOFATOMS (X)
(COND ((NULL X) NIL)
@@ -189,8 +186,6 @@
(DEFUN LASTATOM (L) (if (ATOM L) L (LASTATOM (CDR L))))
-(define-function 'LASTTAIL #'last)
-
(defun DROP (N X &aux m)
"Return a pointer to the Nth cons of X, counting 0 as the first cons."
(COND ((EQL N 0) X)
diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot
index 3b36cdc6..75662d27 100644
--- a/src/interp/modemap.boot
+++ b/src/interp/modemap.boot
@@ -332,14 +332,11 @@ getOperationAlist(name,functorForm,form) ==
stackMessage('"not a category form: %1bp",[form])
substNames(domainName,viewName,functorForm,opalist) ==
- functorForm := SUBSTQ("$$","$", functorForm)
+ functorForm := substitute("$$","$", functorForm)
nameForDollar :=
isCategoryPackageName functorForm => second functorForm
domainName
-
- -- following calls to SUBSTQ must copy to save RPLAC's in
- -- putInLocalDomainReferences
- [[:SUBSTQ("$","$$",SUBSTQ(nameForDollar,"$",modemapform)),
+ [[:substitute("$","$$",substitute(nameForDollar,"$",modemapform)),
[sel, viewName,if domainName = "$" then pos else
modemapform.mmTarget]]
for [:modemapform,[sel,"$",pos]] in
diff --git a/src/interp/packtran.boot b/src/interp/packtran.boot
index 4b005cb8..a3d60e7f 100644
--- a/src/interp/packtran.boot
+++ b/src/interp/packtran.boot
@@ -54,6 +54,6 @@ packageTran sex ==
zeroOneTran sex ==
-- destructively translate the symbols |0| and |1| to their
-- integer counterparts
- NSUBST("$EmptyMode", "?", sex)
+ substitute!("$EmptyMode", "?", sex)
sex
diff --git a/src/interp/patches.lisp b/src/interp/patches.lisp
index cfbd9d0f..fc117573 100644
--- a/src/interp/patches.lisp
+++ b/src/interp/patches.lisp
@@ -114,7 +114,6 @@
(READSPADEXPR))
(t (|parseTransform| (|postTransform| (|string2SpadTree| line)))))))
-(define-function 'SUBSTQ #'SUBSTEQ) ;; needed for substNames (always copy)
#+(and :lucid (not :ibm/370))
(define-function 'RUN-AIX-PROGRAM #'SYS:RUN-AIX-PROGRAM)
;; following should be no longer necessary
diff --git a/src/interp/pf2atree.boot b/src/interp/pf2atree.boot
index 58b8e68e..584244f8 100644
--- a/src/interp/pf2atree.boot
+++ b/src/interp/pf2atree.boot
@@ -490,13 +490,13 @@ pfCollect2Atree pf ==
-- [name, predLhs, :predRhs] := pred
-- vars := patternVarsOf predRhs
-- rest vars => -- if there is more than one patternVariable
--- ruleLhs := NSUBST(predLhs, name, ruleLhs)
+-- ruleLhs := substitute!(predLhs, name, ruleLhs)
-- $multiVarPredicateList := [pred, :$multiVarPredicateList]
-- predicate :=
-- [., var] := predLhs
-- ["suchThat", predLhs, ["ADEF", [var],
-- '((Boolean) (Expression (Integer))), '(() ()), predRhs]]
--- ruleLhs := NSUBST(predicate, name, ruleLhs)
+-- ruleLhs := substitute!(predicate, name, ruleLhs)
-- ruleLhs
--
-- rulePredicateTran rule ==
@@ -516,7 +516,7 @@ pfCollect2Atree pf ==
--
-- pvarPredTran(rhs, varList) ==
-- for var in varList for i in 1.. repeat
--- rhs := NSUBST(['elt, 'predicateVariable, i], var, rhs)
+-- rhs := substitute!(['elt, 'predicateVariable, i], var, rhs)
-- rhs
--
-- patternVarsOf expr ==
diff --git a/src/interp/pf2sex.boot b/src/interp/pf2sex.boot
index 12cb1215..b531026b 100644
--- a/src/interp/pf2sex.boot
+++ b/src/interp/pf2sex.boot
@@ -439,13 +439,13 @@ ruleLhsTran ruleLhs ==
[name, predLhs, :predRhs] := pred
vars := patternVarsOf predRhs
rest vars => -- if there is more than one patternVariable
- ruleLhs := NSUBST(predLhs, name, ruleLhs)
+ ruleLhs := substitute!(predLhs, name, ruleLhs)
$multiVarPredicateList := [pred, :$multiVarPredicateList]
predicate :=
[., var] := predLhs
["suchThat", predLhs, ["ADEF", [var],
'((Boolean) (Expression (Integer))), '(() ()), predRhs]]
- ruleLhs := NSUBST(predicate, name, ruleLhs)
+ ruleLhs := substitute!(predicate, name, ruleLhs)
ruleLhs
rulePredicateTran rule ==
@@ -465,7 +465,7 @@ rulePredicateTran rule ==
pvarPredTran(rhs, varList) ==
for var in varList for i in 1.. repeat
- rhs := NSUBST(['elt, 'predicateVariable, i], var, rhs)
+ rhs := substitute!(['elt, 'predicateVariable, i], var, rhs)
rhs
patternVarsOf expr ==
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index 75beaa84..ae42eeb2 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -374,7 +374,7 @@
(defmacro SPADCALL (&rest L)
(let ((args (butlast l))
- (fn (car (last l)))
+ (fn (car (|lastNode| l)))
(gi (gensym)))
;; (values t) indicates a single return value
`(let ((,gi ,fn))
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index 6895926e..6d9bf52c 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -392,24 +392,3 @@ symbolLassoc(s,l) ==
p := symbolAssoc(s,l) => rest p
nil
-
---% substitute
-
-substitute(new,old,tree) ==
- sameObject?(old,tree) => new
- cons? tree =>
- h := substitute(new,old,first tree)
- t := substitute(new,old,rest tree)
- sameObject?(h,first tree) and sameObject?(t,rest tree) => tree
- [h,:t]
- tree
-
-substitute!(new,old,tree) ==
- sameObject?(old,tree) => new
- cons? tree =>
- h := substitute!(new,old,first tree)
- t := substitute!(new,old,rest tree)
- tree.first := h
- tree.rest := t
- tree
-
diff --git a/src/interp/termrw.boot b/src/interp/termrw.boot
index c10eda3a..cc1a4493 100644
--- a/src/interp/termrw.boot
+++ b/src/interp/termrw.boot
@@ -100,7 +100,7 @@ augmentSub(v,t,SL) ==
-- t doesn't contain any of the variables of SL
q := [v,:t]
null SL => [q]
--- for p in SL repeat p.rest := SUBSTQ(t,v,rest p)
+-- for p in SL repeat p.rest := substitute(t,v,rest p)
[q,:SL]
mergeSubs(S1,S2) ==
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index c6014d97..b766a79f 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -398,7 +398,7 @@
(defmacro seq (&rest form)
(let* ((body (|reverse| form))
(val `(return-from seq ,(pop body))))
- (nsubstitute '(progn) nil body) ;don't treat NIL as a label
+ (|substitute!| '(progn) nil body) ;don't treat NIL as a label
`(block seq (tagbody ,@(|reverse!| body) ,val))))
(defmacro sintp (n)
@@ -985,8 +985,6 @@
(defun MSUBST (new old tree) (subst new old tree :test #'equal))
; note subst isn't guaranteed to copy
(defun |nsubst| (new old tree) (nsubst new old tree :test #'equal))
-(define-function 'MSUBSTQ #'subst) ;default test is eql
-(define-function 'SUBSTQ #'SUBST) ;default test is eql subst is not guaranteed to copy
(defun copy (x) (copy-tree x)) ; not right since should descend vectors
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-28 16:43:36 +0000