Avoid direct use or RPLACA and RPLACD

3 files changed, 43 insertions, 37 deletions

diff --git a/src/algebra/list.spad.pamphlet b/src/algebra/list.spad.pamphlet
index 3e7c6b28..2681cd47 100644
--- a/src/algebra/list.spad.pamphlet
+++ b/src/algebra/list.spad.pamphlet
@@ -44,7 +44,7 @@ IndexedList(S:Type, mn:Integer): Exports == Implementation where
 -- a knowledgeable person wants to update it:
 --   The following LISP dependencies are divided into two groups
 --   Those that are required
---   CONS, EQ, NIL, RPLACA, RPLACD
+--   CONS, EQ, NIL, 
 --   Those that are included for efficiency only
 --   LIST, NCONC2, LENGTH
 --   Also REVERSE, since it's called in Polynomial Ring
@@ -75,16 +75,20 @@ IndexedList(S:Type, mn:Integer): Exports == Implementation where
    elt(x,"rest")       == %tail x
    setfirst!(x,s)     ==
       empty? x => error "Cannot update an empty list"
-      %head RPLACA(x,s)$Lisp
+      %store(%head x,s)$Foreign(Builtin)
+      s
    setelt(x,"first",s) ==
       empty? x => error "Cannot update an empty list"
-      %head RPLACA(x,s)$Lisp
+      %store(%head x,s)$Foreign(Builtin)
+      s
    setrest!(x,y)      ==
       empty? x => error "Cannot update an empty list"
-      %tail RPLACD(x,y)$Lisp
+      %store(%tail x,y)$Foreign(Builtin)
+      %tail x
    setelt(x,"rest",y)  ==
       empty? x => error "Cannot update an empty list"
-      %tail RPLACD(x,y)$Lisp
+      %store(%tail x,y)$Foreign(Builtin)
+      %tail x
    construct l         == l pretend %
    parts s             == s pretend List S
    reverse! x         == %lreverse! x
@@ -150,12 +154,12 @@ IndexedList(S:Type, mn:Integer): Exports == Implementation where
       empty? x => 
         empty? y => x
         Qpush(first y,x)
-        QRPLACD(x,rest y)$Lisp
+        %store(%tail x,rest y)$Foreign(Builtin)
         x
       z:=x
       while not empty? %tail z repeat
         z:=%tail z
-      QRPLACD(z,y)$Lisp
+      %store(%tail z,y)$Foreign(Builtin)
       x
 
    -- Then a quicky:
@@ -169,7 +173,8 @@ IndexedList(S:Type, mn:Integer): Exports == Implementation where
          f:S:=%head p
          p:=%tail p
          while not empty? (pr:=%tail pp) repeat
-           if (%head pr)@S = f then QRPLACD(pp,%tail pr)$Lisp
+           if (%head pr)@S = f then
+             %store(%tail pp,%tail pr)$Foreign(Builtin)
            else pp:=pr
        l
 
@@ -187,16 +192,16 @@ IndexedList(S:Type, mn:Integer): Exports == Implementation where
        else (r := t := q; q := %tail q)
      while not empty? p and not empty? q repeat
        if f(%head p, %head q)
-         then (QRPLACD(t, p)$Lisp; t := p; p := %tail p)
-         else (QRPLACD(t, q)$Lisp; t := q; q := %tail q)
-     QRPLACD(t, if empty? p then q else p)$Lisp
+         then (%store(%tail t, p)$Foreign(Builtin); t := p; p := %tail p)
+         else (%store(%tail t, q)$Foreign(Builtin); t := q; q := %tail q)
+     %store(%tail t, if empty? p then q else p)$Foreign(Builtin)
      r
 
    split!(p, n) ==
       n < 1 => error "index out of range"
       p := rest(p, (n - 1)::NonNegativeInteger)
       q := %tail p
-      QRPLACD(p,%nil)$Lisp
+      %store(%tail p,%nil)$Foreign(Builtin)
       q
 
    mergeSort(f, p, n) ==
@@ -271,11 +276,12 @@ List(S:Type): Exports == Implementation where
       import %nil: %                 from Foreign Builtin
       import %peq: (%,%) -> Boolean  from Foreign Builtin
       import %makepair: (S,%) -> %   from Foreign Builtin
+      import %lconcat: (%,%) -> %    from Foreign Builtin
 
       nil                      == %nil
       null l                   == %peq(l,%nil)
       cons(s, l)               == %makepair(s,l)
-      append(l:%, t:%)         == APPEND(l, t)$Lisp
+      append(l:%, t:%)         == %lconcat(l,t)
 
       if S has OpenMath then
         writeOMList(dev: OpenMathDevice, x: %): Void ==
diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp
index 666f6015..84a22d1f 100644
--- a/src/algebra/strap/ILIST.lsp
+++ b/src/algebra/strap/ILIST.lsp
@@ -150,24 +150,24 @@
 (DEFUN |ILIST;elt;$rest$;9| (|x| T1 $) (DECLARE (IGNORE $)) (CDR |x|)) 
 
 (DEFUN |ILIST;setfirst!;$2S;10| (|x| |s| $)
-  (COND
-    ((NULL |x|) (|error| "Cannot update an empty list"))
-    (T (CAR (RPLACA |x| |s|))))) 
+  (SEQ (COND
+         ((NULL |x|) (|error| "Cannot update an empty list"))
+         (T (SEQ (RPLACA |x| |s|) (EXIT |s|)))))) 
 
 (DEFUN |ILIST;setelt;$first2S;11| (|x| T2 |s| $)
-  (COND
-    ((NULL |x|) (|error| "Cannot update an empty list"))
-    (T (CAR (RPLACA |x| |s|))))) 
+  (SEQ (COND
+         ((NULL |x|) (|error| "Cannot update an empty list"))
+         (T (SEQ (RPLACA |x| |s|) (EXIT |s|)))))) 
 
 (DEFUN |ILIST;setrest!;3$;12| (|x| |y| $)
-  (COND
-    ((NULL |x|) (|error| "Cannot update an empty list"))
-    (T (CDR (RPLACD |x| |y|))))) 
+  (SEQ (COND
+         ((NULL |x|) (|error| "Cannot update an empty list"))
+         (T (SEQ (RPLACD |x| |y|) (EXIT (CDR |x|))))))) 
 
 (DEFUN |ILIST;setelt;$rest2$;13| (|x| T3 |y| $)
-  (COND
-    ((NULL |x|) (|error| "Cannot update an empty list"))
-    (T (CDR (RPLACD |x| |y|))))) 
+  (SEQ (COND
+         ((NULL |x|) (|error| "Cannot update an empty list"))
+         (T (SEQ (RPLACD |x| |y|) (EXIT (CDR |x|))))))) 
 
 (DEFUN |ILIST;construct;L$;14| (|l| $) (DECLARE (IGNORE $)) |l|) 
 
@@ -301,13 +301,13 @@
               (COND
                 ((NULL |y|) |x|)
                 (T (SEQ (PUSH (|SPADfirst| |y|) |x|)
-                        (QRPLACD |x| (CDR |y|)) (EXIT |x|)))))
+                        (RPLACD |x| (CDR |y|)) (EXIT |x|)))))
              (T (SEQ (LETT |z| |x| |ILIST;concat!;3$;25|)
                      (LOOP
                        (COND
                          ((NOT (NOT (NULL (CDR |z|)))) (RETURN NIL))
                          (T (SETQ |z| (CDR |z|)))))
-                     (QRPLACD |z| |y|) (EXIT |x|)))))))) 
+                     (RPLACD |z| |y|) (EXIT |x|)))))))) 
 
 (DEFUN |ILIST;removeDuplicates!;2$;26| (|l| $)
   (PROG (|pp| |f| |pr|)
@@ -333,7 +333,7 @@
                                     (COND
                                       ((SPADCALL (CAR |pr|) |f|
                                         (|getShellEntry| $ 59))
-                                       (QRPLACD |pp| (CDR |pr|)))
+                                       (RPLACD |pp| (CDR |pr|)))
                                       (T (SETQ |pp| |pr|)))))))))))
              (EXIT |l|)))))) 
 
@@ -366,15 +366,15 @@
                           (RETURN NIL))
                          (T (COND
                               ((SPADCALL (CAR |p|) (CAR |q|) |f|)
-                               (SEQ (QRPLACD |t| |p|)
+                               (SEQ (RPLACD |t| |p|)
                                     (LETT |t| |p|
                                      |ILIST;merge!;M3$;28|)
                                     (EXIT (SETQ |p| (CDR |p|)))))
-                              (T (SEQ (QRPLACD |t| |q|)
+                              (T (SEQ (RPLACD |t| |q|)
                                       (LETT |t| |q|
                                        |ILIST;merge!;M3$;28|)
                                       (EXIT (SETQ |q| (CDR |q|)))))))))
-                     (QRPLACD |t| (COND ((NULL |p|) |q|) (T |p|)))
+                     (RPLACD |t| (COND ((NULL |p|) |q|) (T |p|)))
                      (EXIT |r|)))))))) 
 
 (DEFUN |ILIST;split!;$I$;29| (|p| |n| $)
@@ -384,12 +384,12 @@
              ((< |n| 1) (|error| "index out of range"))
              (T (SEQ (SETQ |p|
                            (|ILIST;rest;$Nni$;19| |p|
-                               (LET ((#0=#:G1481 (- |n| 1)))
+                               (LET ((#0=#:G1485 (- |n| 1)))
                                  (|check-subtype| (NOT (MINUSP #0#))
                                      '(|NonNegativeInteger|) #0#))
                                $))
                      (LETT |q| (CDR |p|) |ILIST;split!;$I$;29|)
-                     (QRPLACD |p| NIL) (EXIT |q|)))))))) 
+                     (RPLACD |p| NIL) (EXIT |q|)))))))) 
 
 (DEFUN |ILIST;mergeSort| (|f| |p| |n| $)
   (PROG (|l| |q|)
@@ -403,7 +403,7 @@
            (EXIT (COND
                    ((< |n| 3) |p|)
                    (T (SEQ (LETT |l|
-                                 (LET ((#0=#:G1486 (TRUNCATE |n| 2)))
+                                 (LET ((#0=#:G1490 (TRUNCATE |n| 2)))
                                    (|check-subtype| (NOT (MINUSP #0#))
                                     '(|NonNegativeInteger|) #0#))
                                  |ILIST;mergeSort|)
@@ -415,10 +415,10 @@
                                      $))
                            (EXIT (|ILIST;merge!;M3$;28| |f| |p| |q| $)))))))))) 
 
-(DEFUN |IndexedList| (&REST #0=#:G1495 &AUX #1=#:G1493)
+(DEFUN |IndexedList| (&REST #0=#:G1499 &AUX #1=#:G1497)
   (DECLARE (SPECIAL |$ConstructorCache|))
   (DSETQ #1# #0#)
-  (PROG (#2=#:G1494)
+  (PROG (#2=#:G1498)
     (RETURN
       (COND
         ((SETQ #2#
diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp
index d8f5c568..ddf8b5f5 100644
--- a/src/algebra/strap/LIST.lsp
+++ b/src/algebra/strap/LIST.lsp
@@ -19,7 +19,7 @@
 (DECLAIM (FTYPE (FUNCTION (|%List| |%List| |%Shell|) |%List|)
                 |LIST;append;3$;4|)) 
 
-(PUT '|LIST;append;3$;4| '|SPADreplace| 'APPEND) 
+(PUT '|LIST;append;3$;4| '|SPADreplace| '|%lconcat|) 
 
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Void|)
                 |LIST;writeOMList|))