more cleanup

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