aboutsummaryrefslogtreecommitdiff
path: root/src/algebra/strap
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-02-01 00:40:15 +0000
committerdos-reis <gdr@axiomatics.org>2011-02-01 00:40:15 +0000
commitf1fe7d232e54727f76f7c550af0926487ce88f88 (patch)
treee9bee6301da4d3ffdaa7a150f6dec7f50fe40d8f /src/algebra/strap
parentad7cf3f5d7ae1735c80fb98616cd870b64c80fdd (diff)
downloadopen-axiom-f1fe7d232e54727f76f7c550af0926487ce88f88.tar.gz
Avoid direct use or RPLACA and RPLACD
Diffstat (limited to 'src/algebra/strap')
-rw-r--r--src/algebra/strap/ILIST.lsp46
-rw-r--r--src/algebra/strap/LIST.lsp2
2 files changed, 24 insertions, 24 deletions
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|))