aboutsummaryrefslogtreecommitdiff
path: root/src/algebra
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2010-04-30 14:53:30 +0000
committerdos-reis <gdr@axiomatics.org>2010-04-30 14:53:30 +0000
commitf0b6be21e20a76251afe2bc2ae92800fb267da0b (patch)
tree738bf6386eb25b036815808639ae1dd5e78d8cc9 /src/algebra
parent95a8891a808572509f7449aa32022df42f8b7ab8 (diff)
downloadopen-axiom-f0b6be21e20a76251afe2bc2ae92800fb267da0b.tar.gz
* interp/macros.lisp (|check-subtype|): Return coerced value if can.
(|check-union|): Likewise. * interp/compiler.boot (coerceSuperset): Tidy. Generate %Retract instruction. * interp/g-opt.boot (optRetract): New.
Diffstat (limited to 'src/algebra')
-rw-r--r--src/algebra/strap/CHAR.lsp14
-rw-r--r--src/algebra/strap/DFLOAT.lsp83
-rw-r--r--src/algebra/strap/FFIELDC-.lsp7
-rw-r--r--src/algebra/strap/FPS-.lsp21
-rw-r--r--src/algebra/strap/ILIST.lsp32
-rw-r--r--src/algebra/strap/INS-.lsp22
-rw-r--r--src/algebra/strap/ISTRING.lsp126
-rw-r--r--src/algebra/strap/LIST.lsp15
-rw-r--r--src/algebra/strap/LNAGG-.lsp2
-rw-r--r--src/algebra/strap/LNAGG.lsp19
-rw-r--r--src/algebra/strap/LSAGG-.lsp57
-rw-r--r--src/algebra/strap/NNI.lsp5
-rw-r--r--src/algebra/strap/OUTFORM.lsp5
-rw-r--r--src/algebra/strap/POLYCAT-.lsp120
-rw-r--r--src/algebra/strap/SINT.lsp9
-rw-r--r--src/algebra/strap/STAGG-.lsp41
-rw-r--r--src/algebra/strap/SYMBOL.lsp47
-rw-r--r--src/algebra/strap/URAGG-.lsp10
-rw-r--r--src/algebra/strap/VECTOR.lsp17
19 files changed, 297 insertions, 355 deletions
diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp
index e1d85545..e8bfbd0f 100644
--- a/src/algebra/strap/CHAR.lsp
+++ b/src/algebra/strap/CHAR.lsp
@@ -123,17 +123,13 @@
(DEFUN |CHAR;size;Nni;6| ($) (DECLARE (IGNORE $)) 256)
(DEFUN |CHAR;index;Pi$;7| (|n| $)
- (PROG (#0=#:G1403)
- (RETURN
- (CODE-CHAR
- (PROG1 (LETT #0# (- |n| 1) |CHAR;index;Pi$;7|)
- (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#))))))
+ (CODE-CHAR
+ (LET ((#0=#:G1404 (- |n| 1)))
+ (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#))))
(DEFUN |CHAR;lookup;$Pi;8| (|c| $)
- (PROG (#0=#:G1405)
- (RETURN
- (PROG1 (LETT #0# (+ 1 (CHAR-CODE |c|)) |CHAR;lookup;$Pi;8|)
- (|check-subtype| (> #0# 0) '(|PositiveInteger|) #0#)))))
+ (LET ((#0=#:G1406 (+ 1 (CHAR-CODE |c|))))
+ (|check-subtype| (> #0# 0) '(|PositiveInteger|) #0#)))
(DEFUN |CHAR;char;Nni$;9| (|n| $)
(DECLARE (IGNORE $))
diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp
index 61278b24..5a1a8cf3 100644
--- a/src/algebra/strap/DFLOAT.lsp
+++ b/src/algebra/strap/DFLOAT.lsp
@@ -455,22 +455,19 @@
(FLOAT-DIGITS 0.0))
(DEFUN |DFLOAT;bits;Pi;10| ($)
- (PROG (#0=#:G1423)
- (RETURN
- (COND
- ((EQL (FLOAT-RADIX 0.0) 2) (FLOAT-DIGITS 0.0))
- ((EQL (FLOAT-RADIX 0.0) 16) (* 4 (FLOAT-DIGITS 0.0)))
- ('T
- (PROG1 (LETT #0#
- (FIX (SPADCALL (FLOAT-DIGITS 0.0)
- (|DFLOAT;log2;2$;40|
- (FLOAT (FLOAT-RADIX 0.0)
- |$DoubleFloatMaximum|)
- $)
- (|getShellEntry| $ 34)))
- |DFLOAT;bits;Pi;10|)
- (|check-subtype| (AND (>= #0# 0) (> #0# 0))
- '(|PositiveInteger|) #0#)))))))
+ (COND
+ ((EQL (FLOAT-RADIX 0.0) 2) (FLOAT-DIGITS 0.0))
+ ((EQL (FLOAT-RADIX 0.0) 16) (* 4 (FLOAT-DIGITS 0.0)))
+ ('T
+ (LET ((#0=#:G1424
+ (FIX (SPADCALL (FLOAT-DIGITS 0.0)
+ (|DFLOAT;log2;2$;40|
+ (FLOAT (FLOAT-RADIX 0.0)
+ |$DoubleFloatMaximum|)
+ $)
+ (|getShellEntry| $ 34)))))
+ (|check-subtype| (AND (>= #0# 0) (> #0# 0)) '(|PositiveInteger|)
+ #0#)))))
(DEFUN |DFLOAT;max;$;11| ($)
(DECLARE (IGNORE $))
@@ -664,24 +661,17 @@
(EXIT |theta|))))))))
(DEFUN |DFLOAT;retract;$F;80| (|x| $)
- (PROG (#0=#:G1502)
- (RETURN
- (|DFLOAT;rationalApproximation;$2NniF;87| |x|
- (PROG1 (LETT #0# (- (FLOAT-DIGITS 0.0) 1)
- |DFLOAT;retract;$F;80|)
- (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#))
- (FLOAT-RADIX 0.0) $))))
+ (|DFLOAT;rationalApproximation;$2NniF;87| |x|
+ (LET ((#0=#:G1503 (- (FLOAT-DIGITS 0.0) 1)))
+ (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#))
+ (FLOAT-RADIX 0.0) $))
(DEFUN |DFLOAT;retractIfCan;$U;81| (|x| $)
- (PROG (#0=#:G1507)
- (RETURN
- (CONS 0
- (|DFLOAT;rationalApproximation;$2NniF;87| |x|
- (PROG1 (LETT #0# (- (FLOAT-DIGITS 0.0) 1)
- |DFLOAT;retractIfCan;$U;81|)
- (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|)
- #0#))
- (FLOAT-RADIX 0.0) $)))))
+ (CONS 0
+ (|DFLOAT;rationalApproximation;$2NniF;87| |x|
+ (LET ((#0=#:G1511 (- (FLOAT-DIGITS 0.0) 1)))
+ (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#))
+ (FLOAT-RADIX 0.0) $)))
(DEFUN |DFLOAT;retract;$I;82| (|x| $)
(PROG (|n|)
@@ -742,9 +732,9 @@
#0# (EXIT #0#)))))
(DEFUN |DFLOAT;rationalApproximation;$2NniF;87| (|f| |d| |b| $)
- (PROG (|#G109| |nu| |ex| BASE #0=#:G1531 |de| |tol| |#G110| |q| |r|
- |p2| |q2| #1=#:G1540 |#G111| |#G112| |p0| |p1| |#G113|
- |#G114| |q0| |q1| |#G115| |#G116| |s| |t|)
+ (PROG (|#G109| |nu| |ex| BASE |de| |tol| |#G110| |q| |r| |p2| |q2|
+ #0=#:G1538 |#G111| |#G112| |p0| |p1| |#G113| |#G114|
+ |q0| |q1| |#G115| |#G116| |s| |t|)
(RETURN
(SEQ (EXIT (SEQ (PROGN
(LETT |#G109| (|DFLOAT;manexp| |f| $)
@@ -761,18 +751,15 @@
(SPADCALL
(* |nu|
(EXPT BASE
- (PROG1 |ex|
- (|check-subtype| (>= |ex| 0)
- '(|NonNegativeInteger|) |ex|))))
+ (|check-subtype| (>= |ex| 0)
+ '(|NonNegativeInteger|) |ex|)))
(|getShellEntry| $ 136)))
('T
(SEQ (LETT |de|
(EXPT BASE
- (PROG1
- (LETT #0# (- |ex|)
- |DFLOAT;rationalApproximation;$2NniF;87|)
- (|check-subtype| (>= #0# 0)
- '(|NonNegativeInteger|) #0#)))
+ (LET ((#1=#:G1539 (- |ex|)))
+ (|check-subtype| (>= #1# 0)
+ '(|NonNegativeInteger|) #1#)))
|DFLOAT;rationalApproximation;$2NniF;87|)
(EXIT
(COND
@@ -824,12 +811,12 @@
(* |de| (ABS |p2|))))
(EXIT
(PROGN
- (LETT #1#
+ (LETT #0#
(SPADCALL |p2| |q2|
(|getShellEntry| $
143))
|DFLOAT;rationalApproximation;$2NniF;87|)
- (GO #1#)))))
+ (GO #0#)))))
(PROGN
(LETT |#G111| |p1|
|DFLOAT;rationalApproximation;$2NniF;87|)
@@ -860,10 +847,10 @@
|DFLOAT;rationalApproximation;$2NniF;87|))))
NIL (GO G190) G191
(EXIT NIL)))))))))))))
- #1# (EXIT #1#)))))
+ #0# (EXIT #0#)))))
(DEFUN |DFLOAT;**;$F$;88| (|x| |r| $)
- (PROG (|n| |d| #0=#:G1550)
+ (PROG (|n| |d| #0=#:G1549)
(RETURN
(SEQ (EXIT (COND
((ZEROP |x|)
@@ -925,7 +912,7 @@
(DEFUN |DoubleFloat| ()
(PROG ()
(RETURN
- (PROG (#0=#:G1562)
+ (PROG (#0=#:G1561)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|DoubleFloat|)
diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp
index 47393a53..9a019e8d 100644
--- a/src/algebra/strap/FFIELDC-.lsp
+++ b/src/algebra/strap/FFIELDC-.lsp
@@ -108,10 +108,9 @@
G190 (COND ((NULL (NOT |found|)) (GO G191)))
(SEQ (LETT |e|
(SPADCALL
- (PROG1 |i|
- (|check-subtype|
- (AND (>= |i| 0) (> |i| 0))
- '(|PositiveInteger|) |i|))
+ (|check-subtype|
+ (AND (>= |i| 0) (> |i| 0))
+ '(|PositiveInteger|) |i|)
(|getShellEntry| $ 14))
|FFIELDC-;createPrimitiveElement;S;8|)
(EXIT (LETT |found|
diff --git a/src/algebra/strap/FPS-.lsp b/src/algebra/strap/FPS-.lsp
index 98012446..def89ef7 100644
--- a/src/algebra/strap/FPS-.lsp
+++ b/src/algebra/strap/FPS-.lsp
@@ -12,18 +12,15 @@
(|getShellEntry| $ 10)))
(DEFUN |FPS-;digits;Pi;2| ($)
- (PROG (#0=#:G1400)
- (RETURN
- (PROG1 (LETT #0#
- (MAX 1
- (QUOTIENT2
- (SPADCALL 4004
- (- (SPADCALL (|getShellEntry| $ 14)) 1)
- (|getShellEntry| $ 16))
- 13301))
- |FPS-;digits;Pi;2|)
- (|check-subtype| (AND (>= #0# 0) (> #0# 0))
- '(|PositiveInteger|) #0#)))))
+ (LET ((#0=#:G1401
+ (MAX 1
+ (QUOTIENT2
+ (SPADCALL 4004
+ (- (SPADCALL (|getShellEntry| $ 14)) 1)
+ (|getShellEntry| $ 16))
+ 13301))))
+ (|check-subtype| (AND (>= #0# 0) (> #0# 0)) '(|PositiveInteger|)
+ #0#)))
(DEFUN |FloatingPointSystem&| (|#1|)
(PROG (|dv$1| |dv$| $ |pv$|)
diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp
index 056e79c8..4f10431d 100644
--- a/src/algebra/strap/ILIST.lsp
+++ b/src/algebra/strap/ILIST.lsp
@@ -421,15 +421,14 @@
(EXIT |r|))))))))
(DEFUN |ILIST;split!;$I$;29| (|p| |n| $)
- (PROG (#0=#:G1505 |q|)
+ (PROG (|q|)
(RETURN
(SEQ (COND
((< |n| 1) (|error| "index out of range"))
('T
(SEQ (LETT |p|
(|ILIST;rest;$Nni$;19| |p|
- (PROG1 (LETT #0# (- |n| 1)
- |ILIST;split!;$I$;29|)
+ (LET ((#0=#:G1507 (- |n| 1)))
(|check-subtype| (>= #0# 0)
'(|NonNegativeInteger|) #0#))
$)
@@ -438,7 +437,7 @@
(QRPLACD |p| NIL) (EXIT |q|))))))))
(DEFUN |ILIST;mergeSort| (|f| |p| |n| $)
- (PROG (#0=#:G1509 |l| |q|)
+ (PROG (|l| |q|)
(RETURN
(SEQ (COND
((EQL |n| 2)
@@ -450,8 +449,7 @@
((< |n| 3) |p|)
('T
(SEQ (LETT |l|
- (PROG1 (LETT #0# (QUOTIENT2 |n| 2)
- |ILIST;mergeSort|)
+ (LET ((#0=#:G1512 (QUOTIENT2 |n| 2)))
(|check-subtype| (>= #0# 0)
'(|NonNegativeInteger|) #0#))
|ILIST;mergeSort|)
@@ -606,16 +604,16 @@
898 > 904 = 910 <= 916 < 922 |#| 928)
'((|shallowlyMutable| . 0) (|finiteAggregate| . 0))
(CONS (|makeByteWordVec2| 5
- '(0 0 0 0 0 0 0 0 0 0 5 0 0 1 4 0 0 1 2 3 4))
+ '(0 0 0 0 0 0 0 0 0 0 0 5 0 0 0 1 4 0 1 2 3 4))
(CONS '#(|ListAggregate&| |StreamAggregate&|
|ExtensibleLinearAggregate&|
|FiniteLinearAggregate&|
|UnaryRecursiveAggregate&| |LinearAggregate&|
|RecursiveAggregate&| |IndexedAggregate&|
|Collection&| |HomogeneousAggregate&|
- |OrderedSet&| |Aggregate&| |EltableAggregate&|
- |Evalable&| |SetCategory&| NIL NIL
- |InnerEvalable&| NIL NIL |BasicType&|)
+ |EltableAggregate&| |OrderedSet&| NIL
+ |Aggregate&| NIL |Evalable&| |SetCategory&|
+ NIL |InnerEvalable&| NIL NIL |BasicType&|)
(CONS '#((|ListAggregate| 6)
(|StreamAggregate| 6)
(|ExtensibleLinearAggregate| 6)
@@ -626,12 +624,12 @@
(|IndexedAggregate| 30 6)
(|Collection| 6)
(|HomogeneousAggregate| 6)
- (|OrderedSet|) (|Aggregate|)
- (|EltableAggregate| 30 6) (|Evalable| 6)
- (|SetCategory|) (|Eltable| 30 6)
- (|Type|) (|InnerEvalable| 6 6)
- (|CoercibleTo| 36) (|ConvertibleTo| 81)
- (|BasicType|))
+ (|EltableAggregate| 30 6) (|OrderedSet|)
+ (|Eltable| 77 $$) (|Aggregate|)
+ (|Eltable| 30 6) (|Evalable| 6)
+ (|SetCategory|) (|Type|)
+ (|InnerEvalable| 6 6) (|CoercibleTo| 36)
+ (|ConvertibleTo| 81) (|BasicType|))
(|makeByteWordVec2| 84
'(1 11 0 0 33 1 0 11 0 34 0 37 0 38 1 0
0 0 39 1 6 36 0 40 2 37 0 36 0 41 1
@@ -683,7 +681,7 @@
1 0 8 0 1 1 0 0 0 39 2 7 8 6 0 1 2 0
8 75 0 1 3 0 0 0 0 30 1 1 0 0 0 35 1
3 81 0 1 1 0 0 25 26 2 0 0 0 6 1 2 0
- 0 0 0 60 1 0 0 43 1 2 0 0 0 6 1 2 0 0
+ 0 0 0 60 2 0 0 0 6 1 1 0 0 43 1 2 0 0
6 0 10 2 0 0 0 0 1 1 8 36 0 49 1 0 43
0 1 2 7 11 0 0 1 2 7 11 0 0 1 2 0 11
75 0 1 2 5 11 0 0 1 2 5 11 0 0 1 2 7
diff --git a/src/algebra/strap/INS-.lsp b/src/algebra/strap/INS-.lsp
index d9e55191..6babf099 100644
--- a/src/algebra/strap/INS-.lsp
+++ b/src/algebra/strap/INS-.lsp
@@ -120,19 +120,15 @@
(DEFUN |INS-;rational?;SB;8| (|x| $) (DECLARE (IGNORE $)) T)
(DEFUN |INS-;euclideanSize;SNni;9| (|x| $)
- (PROG (#0=#:G1424 #1=#:G1425)
- (RETURN
- (COND
- ((SPADCALL |x| (|spadConstant| $ 10) (|getShellEntry| $ 27))
- (|error| "euclideanSize called on zero"))
- ((SPADCALL |x| (|spadConstant| $ 10) (|getShellEntry| $ 28))
- (PROG1 (LETT #0# (- (SPADCALL |x| (|getShellEntry| $ 30)))
- |INS-;euclideanSize;SNni;9|)
- (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)))
- ('T
- (PROG1 (LETT #1# (SPADCALL |x| (|getShellEntry| $ 30))
- |INS-;euclideanSize;SNni;9|)
- (|check-subtype| (>= #1# 0) '(|NonNegativeInteger|) #1#)))))))
+ (COND
+ ((SPADCALL |x| (|spadConstant| $ 10) (|getShellEntry| $ 27))
+ (|error| "euclideanSize called on zero"))
+ ((SPADCALL |x| (|spadConstant| $ 10) (|getShellEntry| $ 28))
+ (LET ((#0=#:G1425 (- (SPADCALL |x| (|getShellEntry| $ 30)))))
+ (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)))
+ ('T
+ (LET ((#1=#:G1426 (SPADCALL |x| (|getShellEntry| $ 30))))
+ (|check-subtype| (>= #1# 0) '(|NonNegativeInteger|) #1#)))))
(DEFUN |INS-;convert;SF;10| (|x| $)
(SPADCALL (SPADCALL |x| (|getShellEntry| $ 30))
diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index 12d4a5cb..71091f35 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -178,8 +178,7 @@
(STRCONC "\\mbox{``" (STRCONC |s| "''}")))
(DEFUN |ISTRING;replace;$Us2$;15| (|s| |sg| |t| $)
- (PROG (|l| |m| |n| |h| #0=#:G1435 |r| #1=#:G1531 #2=#:G1532 |i|
- #3=#:G1533 |k|)
+ (PROG (|l| |m| |n| |h| |r| #0=#:G1531 #1=#:G1532 |i| #2=#:G1533 |k|)
(RETURN
(SEQ (LETT |l|
(- (SPADCALL |sg| (|getShellEntry| $ 44))
@@ -201,16 +200,16 @@
(EXIT (|error| "index out of range"))))
(LETT |r|
(MAKE-FULL-CVEC
- (PROG1 (LETT #0# (+ (- |m| (+ (- |h| |l|) 1)) |n|)
- |ISTRING;replace;$Us2$;15|)
- (|check-subtype| (>= #0# 0)
- '(|NonNegativeInteger|) #0#))
+ (LET ((#3=#:G1440
+ (+ (- |m| (+ (- |h| |l|) 1)) |n|)))
+ (|check-subtype| (>= #3# 0)
+ '(|NonNegativeInteger|) #3#))
(|spadConstant| $ 53))
|ISTRING;replace;$Us2$;15|)
(SEQ (LETT |i| 0 |ISTRING;replace;$Us2$;15|)
- (LETT #1# (- |l| 1) |ISTRING;replace;$Us2$;15|)
+ (LETT #0# (- |l| 1) |ISTRING;replace;$Us2$;15|)
(LETT |k| 0 |ISTRING;replace;$Us2$;15|) G190
- (COND ((QSGREATERP |i| #1#) (GO G191)))
+ (COND ((QSGREATERP |i| #0#) (GO G191)))
(SEQ (EXIT (QESET |r| |k| (CHAR |s| |i|))))
(LETT |k|
(PROG1 (QSADD1 |k|)
@@ -219,9 +218,9 @@
|ISTRING;replace;$Us2$;15|)
(GO G190) G191 (EXIT NIL))
(SEQ (LETT |i| 0 |ISTRING;replace;$Us2$;15|)
- (LETT #2# (- |n| 1) |ISTRING;replace;$Us2$;15|)
+ (LETT #1# (- |n| 1) |ISTRING;replace;$Us2$;15|)
(LETT |k| |k| |ISTRING;replace;$Us2$;15|) G190
- (COND ((QSGREATERP |i| #2#) (GO G191)))
+ (COND ((QSGREATERP |i| #1#) (GO G191)))
(SEQ (EXIT (QESET |r| |k| (CHAR |t| |i|))))
(LETT |k|
(PROG1 (+ |k| 1)
@@ -230,9 +229,9 @@
|ISTRING;replace;$Us2$;15|)
(GO G190) G191 (EXIT NIL))
(SEQ (LETT |i| (+ |h| 1) |ISTRING;replace;$Us2$;15|)
- (LETT #3# (- |m| 1) |ISTRING;replace;$Us2$;15|)
+ (LETT #2# (- |m| 1) |ISTRING;replace;$Us2$;15|)
(LETT |k| |k| |ISTRING;replace;$Us2$;15|) G190
- (COND ((> |i| #3#) (GO G191)))
+ (COND ((> |i| #2#) (GO G191)))
(SEQ (EXIT (QESET |r| |k| (CHAR |s| |i|))))
(LETT |k|
(PROG1 (+ |k| 1)
@@ -703,24 +702,22 @@
(|stringMatch| |pattern| |target| (CHARACTER |wildcard|)))
(DEFUN |ISTRING;match?;2$CB;34| (|pattern| |target| |dontcare| $)
- (PROG (|n| |m| #0=#:G1511 #1=#:G1514 |s| #2=#:G1515 #3=#:G1524 |i|
- |p| #4=#:G1516 |q|)
+ (PROG (|n| |m| |s| #0=#:G1520 |i| |p| |q|)
(RETURN
(SEQ (EXIT (SEQ (LETT |n|
(SPADCALL |pattern| (|getShellEntry| $ 47))
|ISTRING;match?;2$CB;34|)
(LETT |p|
- (PROG1 (LETT #0#
- (|ISTRING;position;C$2I;19|
- |dontcare| |pattern|
- (LETT |m|
- (|ISTRING;minIndex;$I;11|
- |pattern| $)
- |ISTRING;match?;2$CB;34|)
- $)
- |ISTRING;match?;2$CB;34|)
- (|check-subtype| (>= #0# 0)
- '(|NonNegativeInteger|) #0#))
+ (LET ((#1=#:G1521
+ (|ISTRING;position;C$2I;19|
+ |dontcare| |pattern|
+ (LETT |m|
+ (|ISTRING;minIndex;$I;11|
+ |pattern| $)
+ |ISTRING;match?;2$CB;34|)
+ $)))
+ (|check-subtype| (>= #1# 0)
+ '(|NonNegativeInteger|) #1#))
|ISTRING;match?;2$CB;34|)
(EXIT (COND
((EQL |p| (- |m| 1))
@@ -743,14 +740,13 @@
(LETT |i| |p|
|ISTRING;match?;2$CB;34|)
(LETT |q|
- (PROG1
- (LETT #1#
- (|ISTRING;position;C$2I;19|
- |dontcare| |pattern| (+ |p| 1)
- $)
- |ISTRING;match?;2$CB;34|)
- (|check-subtype| (>= #1# 0)
- '(|NonNegativeInteger|) #1#))
+ (LET
+ ((#2=#:G1522
+ (|ISTRING;position;C$2I;19|
+ |dontcare| |pattern| (+ |p| 1)
+ $)))
+ (|check-subtype| (>= #2# 0)
+ '(|NonNegativeInteger|) #2#))
|ISTRING;match?;2$CB;34|)
(SEQ G190
(COND
@@ -766,21 +762,20 @@
$)
|ISTRING;match?;2$CB;34|)
(LETT |i|
- (PROG1
- (LETT #2#
- (|ISTRING;position;2$2I;18|
- |s| |target| |i| $)
- |ISTRING;match?;2$CB;34|)
- (|check-subtype| (>= #2# 0)
- '(|NonNegativeInteger|) #2#))
+ (LET
+ ((#3=#:G1523
+ (|ISTRING;position;2$2I;18|
+ |s| |target| |i| $)))
+ (|check-subtype| (>= #3# 0)
+ '(|NonNegativeInteger|) #3#))
|ISTRING;match?;2$CB;34|)
(EXIT
(COND
((EQL |i| (- |m| 1))
(PROGN
- (LETT #3# NIL
+ (LETT #0# NIL
|ISTRING;match?;2$CB;34|)
- (GO #3#)))
+ (GO #0#)))
('T
(SEQ
(LETT |i|
@@ -790,12 +785,11 @@
|ISTRING;match?;2$CB;34|)
(EXIT
(LETT |q|
- (PROG1
- (LETT #4#
- (|ISTRING;position;C$2I;19|
- |dontcare| |pattern|
- (+ |q| 1) $)
- |ISTRING;match?;2$CB;34|)
+ (LET
+ ((#4=#:G1524
+ (|ISTRING;position;C$2I;19|
+ |dontcare| |pattern|
+ (+ |q| 1) $)))
(|check-subtype|
(>= #4# 0)
'(|NonNegativeInteger|)
@@ -816,7 +810,7 @@
|target| $))
(EXIT NIL)))))
(EXIT T)))))))
- #3# (EXIT #3#)))))
+ #0# (EXIT #0#)))))
(DEFUN |IndexedString| (#0=#:G1541)
(PROG ()
@@ -944,15 +938,15 @@
806 |#| 812)
'((|shallowlyMutable| . 0) (|finiteAggregate| . 0))
(CONS (|makeByteWordVec2| 5
- '(0 0 0 0 0 0 0 5 0 0 1 4 0 0 1 2 3 4))
+ '(0 0 0 0 0 0 0 0 5 0 0 0 1 4 0 1 2 3 4))
(CONS '#(|StringAggregate&|
|OneDimensionalArrayAggregate&|
|FiniteLinearAggregate&| |LinearAggregate&|
|IndexedAggregate&| |Collection&|
- |HomogeneousAggregate&| |OrderedSet&|
- |Aggregate&| |EltableAggregate&| |Evalable&|
- |SetCategory&| NIL NIL |InnerEvalable&| NIL
- NIL |BasicType&|)
+ |HomogeneousAggregate&| |EltableAggregate&|
+ |OrderedSet&| NIL |Aggregate&| NIL |Evalable&|
+ |SetCategory&| NIL |InnerEvalable&| NIL NIL
+ |BasicType&|)
(CONS '#((|StringAggregate|)
(|OneDimensionalArrayAggregate| 8)
(|FiniteLinearAggregate| 8)
@@ -960,12 +954,12 @@
(|IndexedAggregate| 11 8)
(|Collection| 8)
(|HomogeneousAggregate| 8)
- (|OrderedSet|) (|Aggregate|)
- (|EltableAggregate| 11 8) (|Evalable| 8)
- (|SetCategory|) (|Eltable| 11 8)
- (|Type|) (|InnerEvalable| 8 8)
- (|CoercibleTo| 29) (|ConvertibleTo| 95)
- (|BasicType|))
+ (|EltableAggregate| 11 8) (|OrderedSet|)
+ (|Eltable| 23 $$) (|Aggregate|)
+ (|Eltable| 11 8) (|Evalable| 8)
+ (|SetCategory|) (|Type|)
+ (|InnerEvalable| 8 8) (|CoercibleTo| 29)
+ (|ConvertibleTo| 95) (|BasicType|))
(|makeByteWordVec2| 100
'(0 11 0 12 2 11 13 0 0 14 0 11 0 21 2
11 0 0 0 22 2 23 0 11 11 24 1 23 0 11
@@ -1011,10 +1005,10 @@
2 0 8 0 11 67 3 0 8 0 11 8 1 2 0 0 0
11 1 2 0 0 0 23 1 2 7 7 8 0 1 2 0 7
96 0 1 3 0 0 0 0 11 82 1 0 0 0 20 1 3
- 95 0 1 1 0 0 91 1 1 0 0 73 83 2 0 0 0
- 0 19 2 0 0 0 8 1 2 0 0 8 0 1 1 8 29 0
- 31 1 0 0 8 1 2 7 13 0 0 1 2 0 13 96 0
- 1 2 5 13 0 0 1 2 5 13 0 0 1 2 7 13 0
- 0 17 2 5 13 0 0 1 2 5 13 0 0 18 1 0 7
- 0 16)))))
+ 95 0 1 1 0 0 91 1 2 0 0 0 0 19 1 0 0
+ 73 83 2 0 0 8 0 1 2 0 0 0 8 1 1 8 29
+ 0 31 1 0 0 8 1 2 7 13 0 0 1 2 0 13 96
+ 0 1 2 5 13 0 0 1 2 5 13 0 0 1 2 7 13
+ 0 0 17 2 5 13 0 0 1 2 5 13 0 0 18 1 0
+ 7 0 16)))))
'|lookupComplete|))
diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp
index b043b4af..6d480bd5 100644
--- a/src/algebra/strap/LIST.lsp
+++ b/src/algebra/strap/LIST.lsp
@@ -320,16 +320,16 @@
|OMwrite| 270)
'((|shallowlyMutable| . 0) (|finiteAggregate| . 0))
(CONS (|makeByteWordVec2| 6
- '(0 0 0 0 0 0 0 0 0 0 5 0 0 1 4 0 0 1 2 3 4 6))
+ '(0 0 0 0 0 0 0 0 0 0 0 5 0 0 0 1 4 0 1 2 3 4 6))
(CONS '#(|ListAggregate&| |StreamAggregate&|
|ExtensibleLinearAggregate&|
|FiniteLinearAggregate&|
|UnaryRecursiveAggregate&| |LinearAggregate&|
|RecursiveAggregate&| |IndexedAggregate&|
|Collection&| |HomogeneousAggregate&|
- |OrderedSet&| |Aggregate&| |EltableAggregate&|
- |Evalable&| |SetCategory&| NIL NIL
- |InnerEvalable&| NIL NIL |BasicType&| NIL)
+ |EltableAggregate&| |OrderedSet&| NIL
+ |Aggregate&| NIL |Evalable&| |SetCategory&|
+ NIL |InnerEvalable&| NIL NIL |BasicType&| NIL)
(CONS '#((|ListAggregate| 6)
(|StreamAggregate| 6)
(|ExtensibleLinearAggregate| 6)
@@ -340,9 +340,10 @@
(|IndexedAggregate| 7 6)
(|Collection| 6)
(|HomogeneousAggregate| 6)
- (|OrderedSet|) (|Aggregate|)
- (|EltableAggregate| 7 6) (|Evalable| 6)
- (|SetCategory|) (|Eltable| 7 6) (|Type|)
+ (|EltableAggregate| 7 6) (|OrderedSet|)
+ (|Eltable| 61 $$) (|Aggregate|)
+ (|Eltable| 7 6) (|Evalable| 6)
+ (|SetCategory|) (|Type|)
(|InnerEvalable| 6 6) (|CoercibleTo| 45)
(|ConvertibleTo| 46) (|BasicType|)
(|OpenMath|))
diff --git a/src/algebra/strap/LNAGG-.lsp b/src/algebra/strap/LNAGG-.lsp
index b8aa5086..2ed21c8f 100644
--- a/src/algebra/strap/LNAGG-.lsp
+++ b/src/algebra/strap/LNAGG-.lsp
@@ -21,7 +21,7 @@
|LNAGG-;maxIndex;AI;6|))
(DEFUN |LNAGG-;indices;AL;1| (|a| $)
- (PROG (#0=#:G1409 |i| #1=#:G1410)
+ (PROG (#0=#:G1410 |i| #1=#:G1411)
(RETURN
(SEQ (PROGN
(LETT #0# NIL |LNAGG-;indices;AL;1|)
diff --git a/src/algebra/strap/LNAGG.lsp b/src/algebra/strap/LNAGG.lsp
index 04e85650..ce7cf516 100644
--- a/src/algebra/strap/LNAGG.lsp
+++ b/src/algebra/strap/LNAGG.lsp
@@ -6,13 +6,16 @@
(DEFPARAMETER |LinearAggregate;AL| 'NIL)
(DEFUN |LinearAggregate;| (|t#1|)
- (PROG (#0=#:G1398)
+ (PROG (#0=#:G1399)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
(PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
(|sublisV|
- (PAIR '(#1=#:G1397) (LIST '(|Integer|)))
+ (PAIR '(#1=#:G1397 #2=#:G1398)
+ (LIST '(|Integer|)
+ '(|UniversalSegment|
+ (|Integer|))))
(COND
(|LinearAggregate;CAT|)
('T
@@ -20,6 +23,7 @@
(|Join|
(|IndexedAggregate| '#1# '|t#1|)
(|Collection| '|t#1|)
+ (|Eltable| '#2# '$)
(|mkCategory| '|domain|
'(((|new|
($ (|NonNegativeInteger|)
@@ -35,11 +39,6 @@
|t#1|)
$ $))
T)
- ((|elt|
- ($ $
- (|UniversalSegment|
- (|Integer|))))
- T)
((|delete| ($ $ (|Integer|)))
T)
((|delete|
@@ -66,12 +65,12 @@
(|Integer|) (|List| $)
(|NonNegativeInteger|))
NIL))
- . #2=(|LinearAggregate|)))))) . #2#)
+ . #3=(|LinearAggregate|)))))) . #3#)
(|setShellEntry| #0# 0
(LIST '|LinearAggregate| (|devaluate| |t#1|)))))))
-(DEFUN |LinearAggregate| (#0=#:G1399)
- (LET (#1=#:G1400)
+(DEFUN |LinearAggregate| (#0=#:G1400)
+ (LET (#1=#:G1401)
(COND
((SETQ #1# (|assoc| (|devaluate| #0#) |LinearAggregate;AL|))
(CDR #1#))
diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp
index d9080d7e..52e52069 100644
--- a/src/algebra/strap/LSAGG-.lsp
+++ b/src/algebra/strap/LSAGG-.lsp
@@ -230,7 +230,7 @@
(EXIT |r|))))))))
(DEFUN |LSAGG-;insert!;SAIA;7| (|s| |x| |i| $)
- (PROG (|m| #0=#:G1463 |y| |z|)
+ (PROG (|m| |y| |z|)
(RETURN
(SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 33))
|LSAGG-;insert!;SAIA;7|)
@@ -241,9 +241,8 @@
('T
(SEQ (LETT |y|
(SPADCALL |x|
- (PROG1
- (LETT #0# (- (- |i| 1) |m|)
- |LSAGG-;insert!;SAIA;7|)
+ (LET
+ ((#0=#:G1466 (- (- |i| 1) |m|)))
(|check-subtype| (>= #0# 0)
'(|NonNegativeInteger|) #0#))
(|getShellEntry| $ 39))
@@ -257,7 +256,7 @@
(EXIT |x|)))))))))
(DEFUN |LSAGG-;insert!;2AIA;8| (|w| |x| |i| $)
- (PROG (|m| #0=#:G1467 |y| |z|)
+ (PROG (|m| |y| |z|)
(RETURN
(SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 33))
|LSAGG-;insert!;2AIA;8|)
@@ -268,9 +267,8 @@
('T
(SEQ (LETT |y|
(SPADCALL |x|
- (PROG1
- (LETT #0# (- (- |i| 1) |m|)
- |LSAGG-;insert!;2AIA;8|)
+ (LET
+ ((#0=#:G1470 (- (- |i| 1) |m|)))
(|check-subtype| (>= #0# 0)
'(|NonNegativeInteger|) #0#))
(|getShellEntry| $ 39))
@@ -336,7 +334,7 @@
(EXIT |x|)))))))))
(DEFUN |LSAGG-;delete!;AIA;10| (|x| |i| $)
- (PROG (|m| #0=#:G1479 |y|)
+ (PROG (|m| |y|)
(RETURN
(SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 33))
|LSAGG-;delete!;AIA;10|)
@@ -347,9 +345,8 @@
('T
(SEQ (LETT |y|
(SPADCALL |x|
- (PROG1
- (LETT #0# (- (- |i| 1) |m|)
- |LSAGG-;delete!;AIA;10|)
+ (LET
+ ((#0=#:G1482 (- (- |i| 1) |m|)))
(|check-subtype| (>= #0# 0)
'(|NonNegativeInteger|) #0#))
(|getShellEntry| $ 39))
@@ -360,7 +357,7 @@
(EXIT |x|)))))))))
(DEFUN |LSAGG-;delete!;AUsA;11| (|x| |i| $)
- (PROG (|l| |m| |h| #0=#:G1484 #1=#:G1485 |t| #2=#:G1486)
+ (PROG (|l| |m| |h| |t|)
(RETURN
(SEQ (LETT |l| (SPADCALL |i| (|getShellEntry| $ 46))
|LSAGG-;delete!;AUsA;11|)
@@ -380,18 +377,17 @@
((< |h| |l|) |x|)
((EQL |l| |m|)
(SPADCALL |x|
- (PROG1
- (LETT #0# (- (+ |h| 1) |m|)
- |LSAGG-;delete!;AUsA;11|)
+ (LET
+ ((#0=#:G1488 (- (+ |h| 1) |m|)))
(|check-subtype| (>= #0# 0)
'(|NonNegativeInteger|) #0#))
(|getShellEntry| $ 39)))
('T
(SEQ (LETT |t|
(SPADCALL |x|
- (PROG1
- (LETT #1# (- (- |l| 1) |m|)
- |LSAGG-;delete!;AUsA;11|)
+ (LET
+ ((#1=#:G1489
+ (- (- |l| 1) |m|)))
(|check-subtype| (>= #1# 0)
'(|NonNegativeInteger|)
#1#))
@@ -399,9 +395,9 @@
|LSAGG-;delete!;AUsA;11|)
(SPADCALL |t|
(SPADCALL |t|
- (PROG1
- (LETT #2# (+ (- |h| |l|) 2)
- |LSAGG-;delete!;AUsA;11|)
+ (LET
+ ((#2=#:G1490
+ (+ (- |h| |l|) 2)))
(|check-subtype| (>= #2# 0)
'(|NonNegativeInteger|)
#2#))
@@ -453,7 +449,7 @@
('T |k|)))))))
(DEFUN |LSAGG-;mergeSort| (|f| |p| |n| $)
- (PROG (#0=#:G1506 |l| |q|)
+ (PROG (|l| |q|)
(RETURN
(SEQ (COND
((EQL |n| 2)
@@ -468,8 +464,7 @@
((< |n| 3) |p|)
('T
(SEQ (LETT |l|
- (PROG1 (LETT #0# (QUOTIENT2 |n| 2)
- |LSAGG-;mergeSort|)
+ (LET ((#0=#:G1509 (QUOTIENT2 |n| 2)))
(|check-subtype| (>= #0# 0)
'(|NonNegativeInteger|) #0#))
|LSAGG-;mergeSort|)
@@ -667,7 +662,7 @@
(EXIT (SPADCALL |y| (|getShellEntry| $ 57)))))))
(DEFUN |LSAGG-;copyInto!;2AIA;22| (|y| |x| |s| $)
- (PROG (|m| #0=#:G1544 |z|)
+ (PROG (|m| |z|)
(RETURN
(SEQ (LETT |m| (SPADCALL |y| (|getShellEntry| $ 33))
|LSAGG-;copyInto!;2AIA;22|)
@@ -676,9 +671,7 @@
('T
(SEQ (LETT |z|
(SPADCALL |y|
- (PROG1
- (LETT #0# (- |s| |m|)
- |LSAGG-;copyInto!;2AIA;22|)
+ (LET ((#0=#:G1550 (- |s| |m|)))
(|check-subtype| (>= #0# 0)
'(|NonNegativeInteger|) #0#))
(|getShellEntry| $ 39))
@@ -711,7 +704,7 @@
(EXIT |y|)))))))))
(DEFUN |LSAGG-;position;SA2I;23| (|w| |x| |s| $)
- (PROG (|m| #0=#:G1551 |k|)
+ (PROG (|m| |k|)
(RETURN
(SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 33))
|LSAGG-;position;SA2I;23|)
@@ -720,9 +713,7 @@
('T
(SEQ (LETT |x|
(SPADCALL |x|
- (PROG1
- (LETT #0# (- |s| |m|)
- |LSAGG-;position;SA2I;23|)
+ (LET ((#0=#:G1556 (- |s| |m|)))
(|check-subtype| (>= #0# 0)
'(|NonNegativeInteger|) #0#))
(|getShellEntry| $ 39))
diff --git a/src/algebra/strap/NNI.lsp b/src/algebra/strap/NNI.lsp
index 8ec72966..1288e89c 100644
--- a/src/algebra/strap/NNI.lsp
+++ b/src/algebra/strap/NNI.lsp
@@ -37,9 +37,8 @@
((< |c| 0) (CONS 1 "failed"))
('T
(CONS 0
- (PROG1 |c|
- (|check-subtype| (>= |c| 0)
- '(|NonNegativeInteger|) |c|))))))))))
+ (|check-subtype| (>= |c| 0)
+ '(|NonNegativeInteger|) |c|)))))))))
(DEFUN |NonNegativeInteger| ()
(PROG ()
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index 2d765749..a8b02a51 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -981,9 +981,8 @@
('T
(SEQ (LETT |r|
(SPADCALL
- (PROG1 |nn|
- (|check-subtype| (> |nn| 0)
- '(|PositiveInteger|) |nn|))
+ (|check-subtype| (> |nn| 0)
+ '(|PositiveInteger|) |nn|)
(|getShellEntry| $ 137))
|OUTFORM;differentiate;$Nni$;97|)
(LETT |s| (SPADCALL |r| (|getShellEntry| $ 138))
diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp
index e3cc7b35..d7bb1719 100644
--- a/src/algebra/strap/POLYCAT-.lsp
+++ b/src/algebra/strap/POLYCAT-.lsp
@@ -896,11 +896,10 @@
(DEFUN |POLYCAT-;conditionP;MU;27| (|mat| $)
(PROG (|ll| #0=#:G1719 |z| #1=#:G1720 |ch| |l| #2=#:G1721 #3=#:G1722
#4=#:G1582 #5=#:G1580 #6=#:G1581 #7=#:G1723 |vars| |degs|
- #8=#:G1724 |d| #9=#:G1725 |nd| #10=#:G1609 #11=#:G1589
- |deg1| |redmons| #12=#:G1726 |v| #13=#:G1728 |u|
- #14=#:G1727 |llR| |monslist| |ans| #15=#:G1610 |mons|
- #16=#:G1729 |m| #17=#:G1730 |i| #18=#:G1605 #19=#:G1603
- #20=#:G1604)
+ #8=#:G1724 |d| #9=#:G1725 |nd| #10=#:G1608 |deg1|
+ |redmons| #11=#:G1726 |v| #12=#:G1728 |u| #13=#:G1727
+ |llR| |monslist| |ans| #14=#:G1609 |mons| #15=#:G1729 |m|
+ #16=#:G1730 |i| #17=#:G1604 #18=#:G1602 #19=#:G1603)
(RETURN
(SEQ (EXIT (SEQ (LETT |ll|
(SPADCALL
@@ -1051,14 +1050,13 @@
|POLYCAT-;conditionP;MU;27|)
(GO #10#)))
('T
- (PROG1
- (LETT #11#
- (QCDR |nd|)
- |POLYCAT-;conditionP;MU;27|)
+ (LET
+ ((#20=#:G1611
+ (QCDR |nd|)))
(|check-subtype|
- (>= #11# 0)
+ (>= #20# 0)
'(|NonNegativeInteger|)
- #11#))))))
+ #20#))))))
#8#)
|POLYCAT-;conditionP;MU;27|)))
(LETT #9# (CDR #9#)
@@ -1076,33 +1074,33 @@
(EXIT
(LETT |llR|
(PROGN
- (LETT #12# NIL
+ (LETT #11# NIL
|POLYCAT-;conditionP;MU;27|)
(SEQ
(LETT |v| NIL
|POLYCAT-;conditionP;MU;27|)
- (LETT #13# |llR|
+ (LETT #12# |llR|
|POLYCAT-;conditionP;MU;27|)
(LETT |u| NIL
|POLYCAT-;conditionP;MU;27|)
- (LETT #14# |l|
+ (LETT #13# |l|
|POLYCAT-;conditionP;MU;27|)
G190
(COND
- ((OR (ATOM #14#)
+ ((OR (ATOM #13#)
(PROGN
- (LETT |u| (CAR #14#)
+ (LETT |u| (CAR #13#)
|POLYCAT-;conditionP;MU;27|)
NIL)
- (ATOM #13#)
+ (ATOM #12#)
(PROGN
- (LETT |v| (CAR #13#)
+ (LETT |v| (CAR #12#)
|POLYCAT-;conditionP;MU;27|)
NIL))
(GO G191)))
(SEQ
(EXIT
- (LETT #12#
+ (LETT #11#
(CONS
(CONS
(SPADCALL
@@ -1113,15 +1111,15 @@
(|getShellEntry| $
175))
|v|)
- #12#)
+ #11#)
|POLYCAT-;conditionP;MU;27|)))
- (LETT #14#
- (PROG1 (CDR #14#)
- (LETT #13# (CDR #13#)
+ (LETT #13#
+ (PROG1 (CDR #13#)
+ (LETT #12# (CDR #12#)
|POLYCAT-;conditionP;MU;27|))
|POLYCAT-;conditionP;MU;27|)
(GO G190) G191
- (EXIT (NREVERSE0 #12#))))
+ (EXIT (NREVERSE0 #11#))))
|POLYCAT-;conditionP;MU;27|)))
(LETT #7# (CDR #7#)
|POLYCAT-;conditionP;MU;27|)
@@ -1148,51 +1146,51 @@
(EXIT
(CONS 0
(LET
- ((#21=#:G1611
+ ((#21=#:G1610
(|makeSimpleArray|
(|getVMType|
(|getShellEntry| $ 6))
(SIZE |monslist|))))
(SEQ
- (LETT #15# 0
+ (LETT #14# 0
|POLYCAT-;conditionP;MU;27|)
(LETT |mons| NIL
|POLYCAT-;conditionP;MU;27|)
- (LETT #16# |monslist|
+ (LETT #15# |monslist|
|POLYCAT-;conditionP;MU;27|)
G190
(COND
- ((OR (ATOM #16#)
+ ((OR (ATOM #15#)
(PROGN
- (LETT |mons| (CAR #16#)
+ (LETT |mons| (CAR #15#)
|POLYCAT-;conditionP;MU;27|)
NIL))
(GO G191)))
(SEQ
(EXIT
(|setSimpleArrayEntry| #21#
- #15#
+ #14#
(PROGN
- (LETT #20# NIL
+ (LETT #19# NIL
|POLYCAT-;conditionP;MU;27|)
(SEQ
(LETT |m| NIL
|POLYCAT-;conditionP;MU;27|)
- (LETT #17# |mons|
+ (LETT #16# |mons|
|POLYCAT-;conditionP;MU;27|)
G190
(COND
- ((OR (ATOM #17#)
+ ((OR (ATOM #16#)
(PROGN
(LETT |m|
- (CAR #17#)
+ (CAR #16#)
|POLYCAT-;conditionP;MU;27|)
NIL))
(GO G191)))
(SEQ
(EXIT
(PROGN
- (LETT #18#
+ (LETT #17#
(SPADCALL |m|
(SPADCALL
(SPADCALL
@@ -1208,30 +1206,30 @@
182))
|POLYCAT-;conditionP;MU;27|)
(COND
- (#20#
- (LETT #19#
- (SPADCALL #19#
- #18#
+ (#19#
+ (LETT #18#
+ (SPADCALL #18#
+ #17#
(|getShellEntry|
$ 183))
|POLYCAT-;conditionP;MU;27|))
('T
(PROGN
- (LETT #19# #18#
+ (LETT #18# #17#
|POLYCAT-;conditionP;MU;27|)
- (LETT #20# 'T
+ (LETT #19# 'T
|POLYCAT-;conditionP;MU;27|)))))))
- (LETT #17# (CDR #17#)
+ (LETT #16# (CDR #16#)
|POLYCAT-;conditionP;MU;27|)
(GO G190) G191
(EXIT NIL))
(COND
- (#20# #19#)
+ (#19# #18#)
('T
(|spadConstant| $ 27)))))))
- (LETT #16#
- (PROG1 (CDR #16#)
- (LETT #15# (QSADD1 #15#)
+ (LETT #15#
+ (PROG1 (CDR #15#)
+ (LETT #14# (QSADD1 #14#)
|POLYCAT-;conditionP;MU;27|))
|POLYCAT-;conditionP;MU;27|)
(GO G190) G191 (EXIT NIL))
@@ -1264,7 +1262,7 @@
$))))))))))
(DEFUN |POLYCAT-;charthRootlv| (|p| |vars| |ch| $)
- (PROG (|v| |dd| |cp| |d| #0=#:G1632 |ans| |ansx| #1=#:G1639)
+ (PROG (|v| |dd| |cp| |d| |ans| |ansx| #0=#:G1638)
(RETURN
(SEQ (EXIT (COND
((NULL |vars|)
@@ -1300,9 +1298,9 @@
(COND
((QEQCAR |dd| 1)
(PROGN
- (LETT #1# (CONS 1 "failed")
+ (LETT #0# (CONS 1 "failed")
|POLYCAT-;charthRootlv|)
- (GO #1#)))
+ (GO #0#)))
('T
(SEQ
(LETT |cp|
@@ -1323,10 +1321,10 @@
(COND
((QEQCAR |ansx| 1)
(PROGN
- (LETT #1#
+ (LETT #0#
(CONS 1 "failed")
|POLYCAT-;charthRootlv|)
- (GO #1#)))
+ (GO #0#)))
('T
(SEQ
(LETT |d|
@@ -1338,13 +1336,13 @@
(SPADCALL |ans|
(SPADCALL (QCDR |ansx|)
|v|
- (PROG1
- (LETT #0# (QCDR |dd|)
- |POLYCAT-;charthRootlv|)
+ (LET
+ ((#1=#:G1639
+ (QCDR |dd|)))
(|check-subtype|
- (>= #0# 0)
+ (>= #1# 0)
'(|NonNegativeInteger|)
- #0#))
+ #1#))
(|getShellEntry| $ 47))
(|getShellEntry| $ 183))
|POLYCAT-;charthRootlv|)))))))))))
@@ -1356,18 +1354,18 @@
(EXIT (COND
((QEQCAR |ansx| 1)
(PROGN
- (LETT #1# (CONS 1 "failed")
+ (LETT #0# (CONS 1 "failed")
|POLYCAT-;charthRootlv|)
- (GO #1#)))
+ (GO #0#)))
('T
(PROGN
- (LETT #1#
+ (LETT #0#
(CONS 0
(SPADCALL |ans| (QCDR |ansx|)
(|getShellEntry| $ 183)))
|POLYCAT-;charthRootlv|)
- (GO #1#)))))))))
- #1# (EXIT #1#)))))
+ (GO #0#)))))))))
+ #0# (EXIT #0#)))))
(DEFUN |POLYCAT-;monicDivide;2SVarSetR;30| (|p1| |p2| |mvar| $)
(PROG (|result|)
diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp
index fc221547..6f8e2a64 100644
--- a/src/algebra/strap/SINT.lsp
+++ b/src/algebra/strap/SINT.lsp
@@ -491,11 +491,8 @@
(+ (- |$ShortMaximum| |$ShortMinimum|) 1))
(DEFUN |SINT;index;Pi$;55| (|i| $)
- (PROG (#0=#:G1459)
- (RETURN
- (PROG1 (LETT #0# (- (+ |i| |$ShortMinimum|) 1)
- |SINT;index;Pi$;55|)
- (|check-subtype| (SMINTP #0#) '(|SingleInteger|) #0#)))))
+ (LET ((#0=#:G1460 (- (+ |i| |$ShortMinimum|) 1)))
+ (|check-subtype| (SMINTP #0#) '(|SingleInteger|) #0#)))
(DEFUN |SINT;lookup;$Pi;56| (|x| $)
(DECLARE (IGNORE $))
@@ -518,7 +515,7 @@
('T |r|)))))))
(DEFUN |SINT;coerce;I$;59| (|x| $)
- (PROG1 |x| (|check-subtype| (SMINTP |x|) '(|SingleInteger|) |x|)))
+ (|check-subtype| (SMINTP |x|) '(|SingleInteger|) |x|))
(DEFUN |SINT;random;$;60| ($)
(SEQ (|setShellEntry| $ 6
diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp
index d58c703a..01db7560 100644
--- a/src/algebra/strap/STAGG-.lsp
+++ b/src/algebra/strap/STAGG-.lsp
@@ -84,9 +84,8 @@
(SPADCALL
(LETT |x|
(SPADCALL |x|
- (PROG1 |i|
- (|check-subtype| (>= |i| 0)
- '(|NonNegativeInteger|) |i|))
+ (|check-subtype| (>= |i| 0)
+ '(|NonNegativeInteger|) |i|)
(|getShellEntry| $ 25))
|STAGG-;elt;AIS;5|)
(|getShellEntry| $ 18)))
@@ -94,7 +93,7 @@
(EXIT (SPADCALL |x| (|getShellEntry| $ 19)))))
(DEFUN |STAGG-;elt;AUsA;6| (|x| |i| $)
- (PROG (|l| |h| #0=#:G1416)
+ (PROG (|l| |h|)
(RETURN
(SEQ (LETT |l|
(- (SPADCALL |i| (|getShellEntry| $ 28))
@@ -105,9 +104,8 @@
((NOT (SPADCALL |i| (|getShellEntry| $ 29)))
(SPADCALL
(SPADCALL |x|
- (PROG1 |l|
- (|check-subtype| (>= |l| 0)
- '(|NonNegativeInteger|) |l|))
+ (|check-subtype| (>= |l| 0)
+ '(|NonNegativeInteger|) |l|)
(|getShellEntry| $ 25))
(|getShellEntry| $ 30)))
('T
@@ -121,13 +119,11 @@
('T
(SPADCALL
(SPADCALL |x|
- (PROG1 |l|
- (|check-subtype| (>= |l| 0)
- '(|NonNegativeInteger|) |l|))
+ (|check-subtype| (>= |l| 0)
+ '(|NonNegativeInteger|) |l|)
(|getShellEntry| $ 25))
- (PROG1
- (LETT #0# (+ (- |h| |l|) 1)
- |STAGG-;elt;AUsA;6|)
+ (LET
+ ((#0=#:G1419 (+ (- |h| |l|) 1)))
(|check-subtype| (>= #0# 0)
'(|NonNegativeInteger|) #0#))
(|getShellEntry| $ 35)))))))))))))
@@ -185,9 +181,8 @@
(SPADCALL
(LETT |x|
(SPADCALL |x|
- (PROG1 |i|
- (|check-subtype| (>= |i| 0)
- '(|NonNegativeInteger|) |i|))
+ (|check-subtype| (>= |i| 0)
+ '(|NonNegativeInteger|) |i|)
(|getShellEntry| $ 25))
|STAGG-;setelt;AI2S;11|)
(|getShellEntry| $ 18)))
@@ -195,7 +190,7 @@
(EXIT (SPADCALL |x| |s| (|getShellEntry| $ 46)))))
(DEFUN |STAGG-;setelt;AUs2S;12| (|x| |i| |s| $)
- (PROG (|l| |h| #0=#:G1436 |z| |y|)
+ (PROG (|l| |h| |z| |y|)
(RETURN
(SEQ (LETT |l|
(- (SPADCALL |i| (|getShellEntry| $ 28))
@@ -219,17 +214,15 @@
('T
(SEQ (LETT |y|
(SPADCALL |x|
- (PROG1 |l|
- (|check-subtype| (>= |l| 0)
- '(|NonNegativeInteger|)
- |l|))
+ (|check-subtype| (>= |l| 0)
+ '(|NonNegativeInteger|) |l|)
(|getShellEntry| $ 25))
|STAGG-;setelt;AUs2S;12|)
(LETT |z|
(SPADCALL |y|
- (PROG1
- (LETT #0# (+ (- |h| |l|) 1)
- |STAGG-;setelt;AUs2S;12|)
+ (LET
+ ((#0=#:G1442
+ (+ (- |h| |l|) 1)))
(|check-subtype| (>= #0# 0)
'(|NonNegativeInteger|)
#0#))
diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp
index b5df14c9..91e8f1e8 100644
--- a/src/algebra/strap/SYMBOL.lsp
+++ b/src/algebra/strap/SYMBOL.lsp
@@ -607,8 +607,8 @@
#1# (EXIT #1#)))))
(DEFUN |SYMBOL;scripts;$R;32| (|sy| $)
- (PROG (|lscripts| |str| |nstr| |j| #0=#:G1533 |nscripts| |m| |n|
- #1=#:G1551 |i| #2=#:G1552 |a| #3=#:G1553 |allscripts|)
+ (PROG (|lscripts| |str| |nstr| |j| |nscripts| |m| |n| #0=#:G1551 |i|
+ #1=#:G1552 |a| #2=#:G1553 |allscripts|)
(RETURN
(SEQ (COND
((NOT (|SYMBOL;scripted?;$B;30| |sy| $))
@@ -639,16 +639,15 @@
(|getShellEntry| $ 139))))
(GO G191)))
(SPADCALL |nscripts| |i|
- (PROG1 (LETT #0#
- (-
- (SPADCALL
- (SPADCALL |str| |j|
- (|getShellEntry| $ 106))
- (|getShellEntry| $ 44))
- (|getShellEntry| $ 45))
- |SYMBOL;scripts;$R;32|)
- (|check-subtype| (>= #0# 0)
- '(|NonNegativeInteger|) #0#))
+ (LET ((#3=#:G1541
+ (-
+ (SPADCALL
+ (SPADCALL |str| |j|
+ (|getShellEntry| $ 106))
+ (|getShellEntry| $ 44))
+ (|getShellEntry| $ 45))))
+ (|check-subtype| (>= #3# 0)
+ '(|NonNegativeInteger|) #3#))
(|getShellEntry| $ 148))
(LETT |i|
(PROG1 (+ |i| 1)
@@ -668,12 +667,12 @@
(SPADCALL |lscripts| (|getShellEntry| $ 153))
|SYMBOL;scripts;$R;32|)
(SEQ (LETT |n| NIL |SYMBOL;scripts;$R;32|)
- (LETT #1# |nscripts| |SYMBOL;scripts;$R;32|)
+ (LETT #0# |nscripts| |SYMBOL;scripts;$R;32|)
(LETT |i| |m| |SYMBOL;scripts;$R;32|) G190
(COND
- ((OR (ATOM #1#)
+ ((OR (ATOM #0#)
(PROGN
- (LETT |n| (CAR #1#)
+ (LETT |n| (CAR #0#)
|SYMBOL;scripts;$R;32|)
NIL))
(GO G191)))
@@ -683,32 +682,32 @@
('T
(SEQ (SPADCALL |lscripts| |i|
(PROGN
- (LETT #2# NIL
+ (LETT #1# NIL
|SYMBOL;scripts;$R;32|)
(SEQ
(LETT |a| NIL
|SYMBOL;scripts;$R;32|)
- (LETT #3#
+ (LETT #2#
(SPADCALL |allscripts| |n|
(|getShellEntry| $ 156))
|SYMBOL;scripts;$R;32|)
G190
(COND
- ((OR (ATOM #3#)
+ ((OR (ATOM #2#)
(PROGN
- (LETT |a| (CAR #3#)
+ (LETT |a| (CAR #2#)
|SYMBOL;scripts;$R;32|)
NIL))
(GO G191)))
- (LETT #2#
+ (LETT #1#
(CONS
(|SYMBOL;coerce;$Of;11| |a| $)
- #2#)
+ #1#)
|SYMBOL;scripts;$R;32|)
- (LETT #3# (CDR #3#)
+ (LETT #2# (CDR #2#)
|SYMBOL;scripts;$R;32|)
(GO G190) G191
- (EXIT (NREVERSE0 #2#))))
+ (EXIT (NREVERSE0 #1#))))
(|getShellEntry| $ 157))
(EXIT (LETT |allscripts|
(SPADCALL |allscripts| |n|
@@ -716,7 +715,7 @@
|SYMBOL;scripts;$R;32|)))))
(LETT |i|
(PROG1 (+ |i| 1)
- (LETT #1# (CDR #1#)
+ (LETT #0# (CDR #0#)
|SYMBOL;scripts;$R;32|))
|SYMBOL;scripts;$R;32|)
(GO G190) G191 (EXIT NIL))
diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp
index 45a75b9c..f69e3773 100644
--- a/src/algebra/strap/URAGG-.lsp
+++ b/src/algebra/strap/URAGG-.lsp
@@ -435,7 +435,7 @@
(EXIT |x|)))))
(DEFUN |URAGG-;last;ANniA;22| (|x| |n| $)
- (PROG (|m| #0=#:G1497)
+ (PROG (|m|)
(RETURN
(SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 57))
|URAGG-;last;ANniA;22|)
@@ -444,8 +444,7 @@
('T
(SPADCALL
(SPADCALL |x|
- (PROG1 (LETT #0# (- |m| |n|)
- |URAGG-;last;ANniA;22|)
+ (LET ((#0=#:G1499 (- |m| |n|)))
(|check-subtype| (>= #0# 0)
'(|NonNegativeInteger|) #0#))
(|getShellEntry| $ 59))
@@ -574,15 +573,14 @@
(SPADCALL |u| |s| (|getShellEntry| $ 67)))
(DEFUN |URAGG-;split!;AIA;32| (|p| |n| $)
- (PROG (#0=#:G1523 |q|)
+ (PROG (|q|)
(RETURN
(SEQ (COND
((< |n| 1) (|error| "index out of range"))
('T
(SEQ (LETT |p|
(SPADCALL |p|
- (PROG1 (LETT #0# (- |n| 1)
- |URAGG-;split!;AIA;32|)
+ (LET ((#0=#:G1525 (- |n| 1)))
(|check-subtype| (>= #0# 0)
'(|NonNegativeInteger|) #0#))
(|getShellEntry| $ 59))
diff --git a/src/algebra/strap/VECTOR.lsp b/src/algebra/strap/VECTOR.lsp
index 2bb16105..1e069c4c 100644
--- a/src/algebra/strap/VECTOR.lsp
+++ b/src/algebra/strap/VECTOR.lsp
@@ -118,15 +118,15 @@
|construct| 54)
'((|shallowlyMutable| . 0) (|finiteAggregate| . 0))
(CONS (|makeByteWordVec2| 5
- '(0 0 0 0 0 0 0 5 0 0 1 4 0 0 1 2 3 4))
+ '(0 0 0 0 0 0 0 0 5 0 0 0 1 4 0 1 2 3 4))
(CONS '#(|VectorCategory&|
|OneDimensionalArrayAggregate&|
|FiniteLinearAggregate&| |LinearAggregate&|
|IndexedAggregate&| |Collection&|
- |HomogeneousAggregate&| |OrderedSet&|
- |Aggregate&| |EltableAggregate&| |Evalable&|
- |SetCategory&| NIL NIL |InnerEvalable&| NIL
- NIL |BasicType&|)
+ |HomogeneousAggregate&| |EltableAggregate&|
+ |OrderedSet&| NIL |Aggregate&| NIL |Evalable&|
+ |SetCategory&| NIL |InnerEvalable&| NIL NIL
+ |BasicType&|)
(CONS '#((|VectorCategory| 6)
(|OneDimensionalArrayAggregate| 6)
(|FiniteLinearAggregate| 6)
@@ -134,9 +134,10 @@
(|IndexedAggregate| 7 6)
(|Collection| 6)
(|HomogeneousAggregate| 6)
- (|OrderedSet|) (|Aggregate|)
- (|EltableAggregate| 7 6) (|Evalable| 6)
- (|SetCategory|) (|Eltable| 7 6) (|Type|)
+ (|EltableAggregate| 7 6) (|OrderedSet|)
+ (|Eltable| 28 $$) (|Aggregate|)
+ (|Eltable| 7 6) (|Evalable| 6)
+ (|SetCategory|) (|Type|)
(|InnerEvalable| 6 6) (|CoercibleTo| 13)
(|ConvertibleTo| 14) (|BasicType|))
(|makeByteWordVec2| 20
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-03 14:15:31 +0000