* interp/nruncomp.boot (NRTsetVector4Part1): Add environment parameter.

	Adjust caller.
	(NRTsetVector4a): Likewise.  Avoid special variable for environment.
	* boot/utility.boot: Add and export substSource, substTarget.
	* interp/define.boot: Use them.

5 files changed, 56 insertions, 14 deletions

diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 985611d3..fcb8a2ef 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -388,7 +388,7 @@
       (COND (|done| (RETURN NIL))
             (T
              (SETQ |found|
-                     (LET ((#1=#:G720
+                     (LET ((#1=#:G727
                             (CATCH :OPEN-AXIOM-CATCH-POINT
                               (APPLY |f| |ps| NIL))))
                        (COND
@@ -1371,7 +1371,7 @@
      (SETQ |op| (|enclosingFunction| (|parserLoadUnit| |ps|)))
      (SETQ |varno| (|parserGensymSequenceNumber| |ps|))
      (UNWIND-PROTECT
-         (LET ((#1=#:G721
+         (LET ((#1=#:G728
                 (CATCH :OPEN-AXIOM-CATCH-POINT
                   (PROGN
                    (SETF (|enclosingFunction| (|parserLoadUnit| |ps|)) NIL)
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index afd689ad..55653a76 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -84,10 +84,10 @@
   (LET* (|s|)
     (COND
      ((SETQ |s|
-              (WITH-HASH-TABLE-ITERATOR (#1=#:G719 |shoeKeyTable|)
+              (WITH-HASH-TABLE-ITERATOR (#1=#:G726 |shoeKeyTable|)
                 (LET ((|bfVar#1| NIL))
                   (LOOP
-                   (MULTIPLE-VALUE-BIND (#2=#:G720 |k| |v|)
+                   (MULTIPLE-VALUE-BIND (#2=#:G727 |k| |v|)
                        (#1#)
                      (COND ((NOT #2#) (RETURN |bfVar#1|))
                            (T
@@ -138,9 +138,9 @@
                  (COND ((> |i| 255) (RETURN NIL)) (T (SETF (ELT |a| |i|) |b|)))
                  (SETQ |i| (+ |i| 1))))
               |a|))
-     (WITH-HASH-TABLE-ITERATOR (#1=#:G721 |shoeKeyTable|)
+     (WITH-HASH-TABLE-ITERATOR (#1=#:G728 |shoeKeyTable|)
        (LOOP
-        (MULTIPLE-VALUE-BIND (#2=#:G722 |s| #:G723)
+        (MULTIPLE-VALUE-BIND (#2=#:G729 |s| #:G730)
             (#1#)
           (COND ((NOT #2#) (RETURN NIL)) (T (|shoeInsert| |s| |d|))))))
      |d|)))
@@ -154,9 +154,9 @@
      (LET ((|i| 0))
        (LOOP (COND ((> |i| 255) (RETURN NIL)) (T (SETF (SBIT |a| |i|) 0)))
              (SETQ |i| (+ |i| 1))))
-     (WITH-HASH-TABLE-ITERATOR (#1=#:G724 |shoeKeyTable|)
+     (WITH-HASH-TABLE-ITERATOR (#1=#:G731 |shoeKeyTable|)
        (LOOP
-        (MULTIPLE-VALUE-BIND (#2=#:G725 |k| #:G726)
+        (MULTIPLE-VALUE-BIND (#2=#:G732 |k| #:G733)
             (#1#)
           (COND ((NOT #2#) (RETURN NIL)) ((|shoeStartsId| (SCHAR |k| 0)) NIL)
                 (T (SETF (SBIT |a| (CHAR-CODE (SCHAR |k| 0))) 1))))))
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index d3f85676..99d7f82a 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -416,7 +416,7 @@
      (SETQ |ps| (|makeParserState| |toks|))
      (|bpFirstTok| |ps|)
      (SETQ |found|
-             (LET ((#1=#:G729
+             (LET ((#1=#:G736
                     (CATCH :OPEN-AXIOM-CATCH-POINT (|bpOutItem| |ps|))))
                (COND
                 ((AND (CONSP #1#) (EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT))
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index 2e303001..1a288c10 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -20,10 +20,10 @@
                      |lastNode| |append| |append!| |copyList| |substitute|
                      |substitute!| |setDifference| |setUnion| |setIntersection|
                      |symbolAssoc| |applySubst| |applySubst!| |applySubstNQ|
-                     |objectAssoc| |remove| |removeSymbol| |atomic?| |every?|
-                     |any?| |take| |takeWhile| |drop| |copyTree| |finishLine|
-                     |stringPrefix?| |stringSuffix?| |findChar|
-                     |charPosition|)))
+                     |objectAssoc| |invertSubst| |substTarget| |substSource|
+                     |remove| |removeSymbol| |atomic?| |every?| |any?| |take|
+                     |takeWhile| |drop| |copyTree| |finishLine| |stringPrefix?|
+                     |stringSuffix?| |findChar| |charPosition|)))
 
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%Thing|) |substitute|))
 
@@ -338,6 +338,40 @@
           ((AND (SYMBOLP |t|) (SETQ |p| (|symbolAssoc| |t| |sl|))) (CDR |p|))
           (T |t|))))
 
+(DEFUN |invertSubst| (|sl|)
+  (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |sl|) (|x| NIL))
+    (LOOP
+     (COND
+      ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL))
+       (RETURN |bfVar#2|))
+      ((NULL |bfVar#2|)
+       (SETQ |bfVar#2| #1=(CONS (CONS (CDR |x|) (CAR |x|)) NIL))
+       (SETQ |bfVar#3| |bfVar#2|))
+      (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|))))
+     (SETQ |bfVar#1| (CDR |bfVar#1|)))))
+
+(DEFUN |substSource| (|sl|)
+  (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |sl|) (|x| NIL))
+    (LOOP
+     (COND
+      ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL))
+       (RETURN |bfVar#2|))
+      ((NULL |bfVar#2|) (SETQ |bfVar#2| #1=(CONS (CAR |x|) NIL))
+       (SETQ |bfVar#3| |bfVar#2|))
+      (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|))))
+     (SETQ |bfVar#1| (CDR |bfVar#1|)))))
+
+(DEFUN |substTarget| (|sl|)
+  (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |sl|) (|x| NIL))
+    (LOOP
+     (COND
+      ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL))
+       (RETURN |bfVar#2|))
+      ((NULL |bfVar#2|) (SETQ |bfVar#2| #1=(CONS (CDR |x|) NIL))
+       (SETQ |bfVar#3| |bfVar#2|))
+      (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|))))
+     (SETQ |bfVar#1| (CDR |bfVar#1|)))))
+
 (DEFUN |setDifference| (|x| |y|)
   (LET* (|a| |l| |p|)
     (COND ((NULL |x|) NIL) ((NULL |y|) |x|)
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index 839e9b1a..d3f999ad 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -48,7 +48,7 @@ module utility (objectMember?, symbolMember?, stringMember?,
   lastNode, append, append!, copyList, substitute, substitute!,
   setDifference, setUnion, setIntersection,
   symbolAssoc, applySubst, applySubst!, applySubstNQ, objectAssoc,
-  invertSubst,
+  invertSubst, substTarget, substSource,
   remove, removeSymbol, atomic?, every?, any?, take, takeWhile, drop,
   copyTree, finishLine, stringPrefix?, stringSuffix?,
   findChar, charPosition) where
@@ -285,6 +285,14 @@ applySubstNQ(sl,t) ==
 invertSubst sl ==
   [[rest x,:first x] for x in sl]
 
+++ Return the list of source values of a map given by a alist.
+substSource sl ==
+  [first x for x in sl]
+
+++ Return the list of target values of a map given by a alist.
+substTarget sl ==
+  [rest x for x in sl]
+
 --% set operations
 
 setDifference(x,y) ==