aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/algebra/list.spad.pamphlet32
-rw-r--r--src/algebra/strap/ILIST.lsp46
-rw-r--r--src/algebra/strap/LIST.lsp2
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|))
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-27 20:29:09 +0000