aboutsummaryrefslogtreecommitdiff
path: root/src/algebra/strap
diff options
context:
space:
mode:
Diffstat (limited to 'src/algebra/strap')
-rw-r--r--src/algebra/strap/CLAGG-.lsp2
-rw-r--r--src/algebra/strap/DFLOAT.lsp14
-rw-r--r--src/algebra/strap/EUCDOM-.lsp2
-rw-r--r--src/algebra/strap/HOAGG-.lsp2
-rw-r--r--src/algebra/strap/ILIST.lsp12
-rw-r--r--src/algebra/strap/LIST.lsp6
-rw-r--r--src/algebra/strap/OUTFORM.lsp15
-rw-r--r--src/algebra/strap/POLYCAT-.lsp2
-rw-r--r--src/algebra/strap/SYMBOL.lsp12
-rw-r--r--src/algebra/strap/UFD-.lsp5
-rw-r--r--src/algebra/strap/URAGG-.lsp2
11 files changed, 42 insertions, 32 deletions
diff --git a/src/algebra/strap/CLAGG-.lsp b/src/algebra/strap/CLAGG-.lsp
index 9acb3b8b..759df315 100644
--- a/src/algebra/strap/CLAGG-.lsp
+++ b/src/algebra/strap/CLAGG-.lsp
@@ -42,7 +42,7 @@
|CLAGG-;removeDuplicates;2A;12|))
(DEFUN |CLAGG-;#;ANni;1| (|c| $)
- (LENGTH (SPADCALL |c| (|getShellEntry| $ 9))))
+ (LIST-LENGTH (SPADCALL |c| (|getShellEntry| $ 9))))
(DEFUN |CLAGG-;count;MANni;2| (|f| |c| $)
(LET ((#0=#:G1377 NIL) (#1=#:G1378 T)
diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp
index 2fb56809..d62aab80 100644
--- a/src/algebra/strap/DFLOAT.lsp
+++ b/src/algebra/strap/DFLOAT.lsp
@@ -64,7 +64,7 @@
(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|) |DFLOAT;pi;$;17|))
-(PUT '|DFLOAT;pi;$;17| '|SPADreplace| '(XLAM NIL PI))
+(PUT '|DFLOAT;pi;$;17| '|SPADreplace| '|%fcstpi|)
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Thing|)
|DFLOAT;coerce;$Of;18|))
@@ -470,7 +470,9 @@
(/ (FLOAT 534625820200 |$DoubleFloatMaximum|)
(FLOAT 196677847971 |$DoubleFloatMaximum|)))
-(DEFUN |DFLOAT;pi;$;17| ($) (DECLARE (IGNORE $)) PI)
+(DEFUN |DFLOAT;pi;$;17| ($)
+ (DECLARE (IGNORE $))
+ (COERCE PI 'DOUBLE-FLOAT))
(DEFUN |DFLOAT;coerce;$Of;18| (|x| $)
(SPADCALL |x| (|getShellEntry| $ 48)))
@@ -624,13 +626,15 @@
(SEQ (COND
((ZEROP |x|)
(COND
- ((PLUSP |y|) (/ PI 2))
- ((MINUSP |y|) (- (/ PI 2)))
+ ((PLUSP |y|) (/ (COERCE PI 'DOUBLE-FLOAT) 2))
+ ((MINUSP |y|) (- (/ (COERCE PI 'DOUBLE-FLOAT) 2)))
(T 0.0)))
(T (SEQ (LETT |theta| (ATAN (ABS (/ |y| |x|)))
|DFLOAT;atan;3$;79|)
(COND
- ((MINUSP |x|) (SETQ |theta| (- PI |theta|))))
+ ((MINUSP |x|)
+ (SETQ |theta|
+ (- (COERCE PI 'DOUBLE-FLOAT) |theta|))))
(COND ((MINUSP |y|) (SETQ |theta| (- |theta|))))
(EXIT |theta|))))))))
diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp
index 979c32c1..84a6ab20 100644
--- a/src/algebra/strap/EUCDOM-.lsp
+++ b/src/algebra/strap/EUCDOM-.lsp
@@ -292,7 +292,7 @@
(DEFUN |EUCDOM-;multiEuclidean;LSU;11| (|l| |z| $)
(PROG (|l1| |l2| |u| |v1| |v2|)
(RETURN
- (LET ((|n| (LENGTH |l|)))
+ (LET ((|n| (LIST-LENGTH |l|)))
(COND
((ZEROP |n|) (|error| "empty list passed to multiEuclidean"))
((EQL |n| 1) (CONS 0 (LIST |z|)))
diff --git a/src/algebra/strap/HOAGG-.lsp b/src/algebra/strap/HOAGG-.lsp
index be7ddc88..e7e8154e 100644
--- a/src/algebra/strap/HOAGG-.lsp
+++ b/src/algebra/strap/HOAGG-.lsp
@@ -42,7 +42,7 @@
(|getShellEntry| (|getShellEntry| $$ 0) 10)))
(DEFUN |HOAGG-;#;ANni;2| (|c| $)
- (LENGTH (SPADCALL |c| (|getShellEntry| $ 15))))
+ (LIST-LENGTH (SPADCALL |c| (|getShellEntry| $ 15))))
(DEFUN |HOAGG-;any?;MAB;3| (|f| |c| $)
(LET ((#0=#:G1380 NIL) (#1=#:G1381 T)
diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp
index 70b228e2..f8d9855d 100644
--- a/src/algebra/strap/ILIST.lsp
+++ b/src/algebra/strap/ILIST.lsp
@@ -4,7 +4,7 @@
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) (|%IntegerSection| 0))
|ILIST;#;$Nni;1|))
-(PUT '|ILIST;#;$Nni;1| '|SPADreplace| 'LENGTH)
+(PUT '|ILIST;#;$Nni;1| '|SPADreplace| '|%llength|)
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%List|)
|ILIST;concat;S2$;2|))
@@ -73,12 +73,12 @@
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%List|)
|ILIST;reverse!;2$;16|))
-(PUT '|ILIST;reverse!;2$;16| '|SPADreplace| 'NREVERSE)
+(PUT '|ILIST;reverse!;2$;16| '|SPADreplace| '|%lreverse!|)
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%List|)
|ILIST;reverse;2$;17|))
-(PUT '|ILIST;reverse;2$;17| '|SPADreplace| 'REVERSE)
+(PUT '|ILIST;reverse;2$;17| '|SPADreplace| '|%lreverse|)
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Integer|)
|ILIST;minIndex;$I;18|))
@@ -121,7 +121,9 @@
|%List|)
|ILIST;mergeSort|))
-(DEFUN |ILIST;#;$Nni;1| (|x| $) (DECLARE (IGNORE $)) (LENGTH |x|))
+(DEFUN |ILIST;#;$Nni;1| (|x| $)
+ (DECLARE (IGNORE $))
+ (LIST-LENGTH |x|))
(DEFUN |ILIST;concat;S2$;2| (|s| |x| $)
(DECLARE (IGNORE $))
@@ -336,7 +338,7 @@
(EXIT |l|))))))
(DEFUN |ILIST;sort!;M2$;27| (|f| |l| $)
- (|ILIST;mergeSort| |f| |l| (LENGTH |l|) $))
+ (|ILIST;mergeSort| |f| |l| (LIST-LENGTH |l|) $))
(DEFUN |ILIST;merge!;M3$;28| (|f| |p| |q| $)
(PROG (|r| |t|)
diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp
index c0e755de..cbec4d68 100644
--- a/src/algebra/strap/LIST.lsp
+++ b/src/algebra/strap/LIST.lsp
@@ -155,7 +155,7 @@
(DEFUN |LIST;convert;$If;13| (|x| $)
(SPADCALL
(CONS (SPADCALL '|construct| (|getShellEntry| $ 47))
- (LET ((#0=#:G1419 |x|) (#1=#:G1418 NIL))
+ (LET ((#0=#:G1420 |x|) (#1=#:G1419 NIL))
(LOOP
(COND
((ATOM #0#) (RETURN (NREVERSE #1#)))
@@ -167,9 +167,9 @@
(SETQ #0# (CDR #0#)))))
(|getShellEntry| $ 52)))
-(DEFUN |List| (#0=#:G1420)
+(DEFUN |List| (#0=#:G1421)
(DECLARE (SPECIAL |$ConstructorCache|))
- (PROG (#1=#:G1421)
+ (PROG (#1=#:G1422)
(RETURN
(COND
((SETQ #1#
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index 2f459f95..ddf4ab0c 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -130,19 +130,20 @@
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
|OUTFORM;pile;L$;32|))
-(PUT '|OUTFORM;pile;L$;32| '|SPADreplace| '(XLAM (|l|) (CONS 'SC |l|)))
+(PUT '|OUTFORM;pile;L$;32| '|SPADreplace|
+ '(XLAM (|l|) (|%makepair| 'SC |l|)))
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
|OUTFORM;commaSeparate;L$;33|))
(PUT '|OUTFORM;commaSeparate;L$;33| '|SPADreplace|
- '(XLAM (|l|) (CONS 'AGGLST |l|)))
+ '(XLAM (|l|) (|%makepair| 'AGGLST |l|)))
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
|OUTFORM;semicolonSeparate;L$;34|))
(PUT '|OUTFORM;semicolonSeparate;L$;34| '|SPADreplace|
- '(XLAM (|l|) (CONS 'AGGSET |l|)))
+ '(XLAM (|l|) (|%makepair| 'AGGSET |l|)))
(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
|OUTFORM;blankSeparate;L$;35|))
@@ -214,7 +215,7 @@
|OUTFORM;hconcat;L$;49|))
(PUT '|OUTFORM;hconcat;L$;49| '|SPADreplace|
- '(XLAM (|l|) (CONS 'CONCAT |l|)))
+ '(XLAM (|l|) (|%makepair| 'CONCAT |l|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;vconcat;3$;50|))
@@ -226,7 +227,7 @@
|OUTFORM;vconcat;L$;51|))
(PUT '|OUTFORM;vconcat;L$;51| '|SPADreplace|
- '(XLAM (|l|) (CONS 'VCONCAT |l|)))
+ '(XLAM (|l|) (|%makepair| 'VCONCAT |l|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|OUTFORM;~=;3$;52|))
@@ -361,7 +362,7 @@
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
|OUTFORM;elt;$L$;75|))
-(PUT '|OUTFORM;elt;$L$;75| '|SPADreplace| 'CONS)
+(PUT '|OUTFORM;elt;$L$;75| '|SPADreplace| '|%makepair|)
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
|OUTFORM;prefix;$L$;76|))
@@ -714,7 +715,7 @@
(DEFUN |OUTFORM;supersub;$L$;47| (|a| |l| $)
(SEQ (COND
- ((ODDP (LENGTH |l|))
+ ((ODDP (LIST-LENGTH |l|))
(SETQ |l| (APPEND |l| (LIST (|OUTFORM;empty;$;73| $))))))
(EXIT (CONS 'ALTSUPERSUB (CONS |a| |l|)))))
diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp
index e685fb74..705c2f82 100644
--- a/src/algebra/strap/POLYCAT-.lsp
+++ b/src/algebra/strap/POLYCAT-.lsp
@@ -559,7 +559,7 @@
(|getShellEntry| $ 75))
#3#)))))
(SETQ #2# (CDR #2#)))))
- (|n| (LENGTH |d|))
+ (|n| (LIST-LENGTH |d|))
(|mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $))
(|w| (|POLYCAT-;P2R| (|SPADfirst| |r|) |d| |n| $)))
(SEQ (SETQ |l| (CDR |l|)) (SETQ |r| (CDR |r|))
diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp
index 1ab934bc..583b62d2 100644
--- a/src/algebra/strap/SYMBOL.lsp
+++ b/src/algebra/strap/SYMBOL.lsp
@@ -195,12 +195,14 @@
(SPADCALL |x| (|getShellEntry| $ 79)))
(DEFUN |SYMBOL;syprefix| (|sc| $)
- (LET ((|ns| (LIST (LENGTH (QVELT |sc| 3)) (LENGTH (QVELT |sc| 2))
- (LENGTH (QVELT |sc| 1)) (LENGTH (QVELT |sc| 0)))))
+ (LET ((|ns| (LIST (LIST-LENGTH (QVELT |sc| 3))
+ (LIST-LENGTH (QVELT |sc| 2))
+ (LIST-LENGTH (QVELT |sc| 1))
+ (LIST-LENGTH (QVELT |sc| 0)))))
(SEQ (LOOP
(COND
((NOT (COND
- ((NOT (< (LENGTH |ns|) 2))
+ ((NOT (< (LIST-LENGTH |ns|) 2))
(ZEROP (|SPADfirst| |ns|)))
(T NIL)))
(RETURN NIL))
@@ -208,7 +210,7 @@
(EXIT (SPADCALL
(CONS (STRCONC (|getShellEntry| $ 38)
(|SYMBOL;istring|
- (LENGTH (QVELT |sc| 4)) $))
+ (LIST-LENGTH (QVELT |sc| 4)) $))
(LET ((#0=#:G1524 (NREVERSE |ns|))
(#1=#:G1523 NIL))
(LOOP
@@ -569,7 +571,7 @@
((ATOM #1#) (RETURN NIL))
(T (LET ((|n| (CAR #1#)))
(COND
- ((< (LENGTH |allscripts|) |n|)
+ ((< (LIST-LENGTH |allscripts|) |n|)
(|error|
"Improper script count in symbol"))
(T (SEQ
diff --git a/src/algebra/strap/UFD-.lsp b/src/algebra/strap/UFD-.lsp
index 8cf15830..22eb430f 100644
--- a/src/algebra/strap/UFD-.lsp
+++ b/src/algebra/strap/UFD-.lsp
@@ -33,8 +33,9 @@
(|getShellEntry| $ 15)))))
(DEFUN |UFD-;prime?;SB;2| (|x| $)
- (EQL (LENGTH (SPADCALL (SPADCALL |x| (|getShellEntry| $ 18))
- (|getShellEntry| $ 22)))
+ (EQL (LIST-LENGTH
+ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 18))
+ (|getShellEntry| $ 22)))
1))
(DEFUN |UniqueFactorizationDomain&| (|#1|)
diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp
index 12a47db1..901b077d 100644
--- a/src/algebra/strap/URAGG-.lsp
+++ b/src/algebra/strap/URAGG-.lsp
@@ -469,7 +469,7 @@
(DEFUN |URAGG-;setchildren!;ALA;30| (|u| |lv| $)
(COND
- ((EQL (LENGTH |lv|) 1)
+ ((EQL (LIST-LENGTH |lv|) 1)
(SPADCALL |u| (|SPADfirst| |lv|) (|getShellEntry| $ 74)))
(T (|error| "wrong number of children specified"))))
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-16 04:29:02 +0000