aboutsummaryrefslogtreecommitdiff
path: root/src/algebra
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-02-24 04:40:09 +0000
committerdos-reis <gdr@axiomatics.org>2011-02-24 04:40:09 +0000
commitf2d31d8bc90b46e0c3373d2980cfa6f730148d1e (patch)
tree986da80f585f5b6d221c61f54413ccf4c63d628f /src/algebra
parent7eca3ee736c49024a85ad00ff9b0a912d640380c (diff)
downloadopen-axiom-f2d31d8bc90b46e0c3373d2980cfa6f730148d1e.tar.gz
* interp/c-util.boot (isSimple): Accept constructor instantiations.
* algebra/formula.spad.pamphlet: Avoid Lispisms. * algebra/mathml.spad.pamphlet: Likewise. * algebra/op.spad.pamphlet: Likewise. * algebra/sex.spad.pamphlet: Likewise.
Diffstat (limited to 'src/algebra')
-rw-r--r--src/algebra/formula.spad.pamphlet2
-rw-r--r--src/algebra/mathml.spad.pamphlet10
-rw-r--r--src/algebra/op.spad.pamphlet2
-rw-r--r--src/algebra/sex.spad.pamphlet2
-rw-r--r--src/algebra/strap/DFLOAT.lsp77
-rw-r--r--src/algebra/strap/EUCDOM-.lsp25
-rw-r--r--src/algebra/strap/FFIELDC-.lsp81
-rw-r--r--src/algebra/strap/ILIST.lsp16
-rw-r--r--src/algebra/strap/INT.lsp2
-rw-r--r--src/algebra/strap/ISTRING.lsp154
-rw-r--r--src/algebra/strap/LIST.lsp10
-rw-r--r--src/algebra/strap/LSAGG-.lsp37
-rw-r--r--src/algebra/strap/POLYCAT-.lsp65
-rw-r--r--src/algebra/strap/STAGG-.lsp44
-rw-r--r--src/algebra/strap/SYMBOL.lsp41
-rw-r--r--src/algebra/strap/URAGG-.lsp76
-rw-r--r--src/algebra/strap/VECTOR.lsp8
-rw-r--r--src/algebra/symbol.spad.pamphlet2
-rw-r--r--src/algebra/syntax.spad.pamphlet2
-rw-r--r--src/algebra/tex.spad.pamphlet2
20 files changed, 314 insertions, 344 deletions
diff --git a/src/algebra/formula.spad.pamphlet b/src/algebra/formula.spad.pamphlet
index 384fad69..a39f786d 100644
--- a/src/algebra/formula.spad.pamphlet
+++ b/src/algebra/formula.spad.pamphlet
@@ -398,7 +398,7 @@ ScriptFormulaFormat(): public == private where
formatFormula(expr,prec) ==
i : Integer
- ATOM(expr)$Lisp pretend Boolean =>
+ not %pair?(expr)$Foreign(Builtin) =>
str := stringify expr
%integer?(expr)$Foreign(Builtin) =>
i := expr : Integer
diff --git a/src/algebra/mathml.spad.pamphlet b/src/algebra/mathml.spad.pamphlet
index 9bf7e720..e6927612 100644
--- a/src/algebra/mathml.spad.pamphlet
+++ b/src/algebra/mathml.spad.pamphlet
@@ -590,7 +590,7 @@ returning Void. I really only need the one coerce function.
a : E
expr := precondition expr
-- sayTeX$Lisp "0: "stringify expr
- (ATOM(expr)$Lisp@Boolean) or (stringify expr = "NOTHING") =>
+ (not %pair?(expr)$Foreign(Builtin)) or (stringify expr = "NOTHING") =>
concat ["{",stringify expr,"}"]
le : L E := (expr pretend L E)
op := first le
@@ -751,7 +751,7 @@ have to be switched by swapping names.
le : L E := nil()
a : E
letmp : L E
- (ATOM(expr)$Lisp@Boolean) or (stringify expr = "NOTHING") =>
+ (not %pair?(expr)$Foreign(Builtin)) or (stringify expr = "NOTHING") =>
le := append(le,list(expr))
letmp := expr pretend L E
for a in letmp repeat
@@ -1197,7 +1197,7 @@ have to be switched by swapping names.
p < 1 => error "unknown binary op"
opPrec := binaryPrecs.p
-- if base op is product or sum need to add parentheses
- if ATOM(first args)$Lisp@Boolean then
+ if not %pair?(first args)$Foreign(Builtin) then
opa:S := stringify first args
else
la : L E := (first args pretend L E)
@@ -1289,7 +1289,7 @@ have to be switched by swapping names.
if checkargs then
if count < #args then
-- check here for sum or product
- if ATOM(a)$Lisp@Boolean then
+ if not %pair?(a)$Foreign(Builtin) then
opa:S := stringify a
else
la : L E := (a pretend L E)
@@ -1329,7 +1329,7 @@ have to be switched by swapping names.
formatMml(expr : E,prec : I) ==
i,len : Integer
intSplitLen : Integer := 20
- ATOM(expr)$Lisp@Boolean =>
+ not %pair?(expr)$Foreign(Builtin) =>
str := stringify expr
len := #str
-- this bit seems to deal with integers
diff --git a/src/algebra/op.spad.pamphlet b/src/algebra/op.spad.pamphlet
index 383747bd..cb2b1731 100644
--- a/src/algebra/op.spad.pamphlet
+++ b/src/algebra/op.spad.pamphlet
@@ -452,7 +452,7 @@ CommonOperators(): Exports == Implementation where
operator(s)$OP
dpi l == '%pi::O
- dfact x == postfix("!"::Symbol::O, (ATOM(x)$Lisp => x; paren x))
+ dfact x == postfix("!"::Symbol::O, (not %pair?(x)$Foreign(Builtin) => x; paren x))
dquote l == prefix(quote(first(l)::O), rest l)
dgamma l == prefix(hconcat("|"::Symbol::O, overbar(" "::Symbol::O)), l)
setDummyVar(op, n) == setProperty(op, DUMMYVAR, n pretend None)
diff --git a/src/algebra/sex.spad.pamphlet b/src/algebra/sex.spad.pamphlet
index 52b6d049..2c0a019d 100644
--- a/src/algebra/sex.spad.pamphlet
+++ b/src/algebra/sex.spad.pamphlet
@@ -125,7 +125,7 @@ SExpressionOf(Str, Sym, Int, Flt, Expr): Decl == Body where
eq(b1, b2) == %peq(b1,b2)
null? b == %peq(b,%nil)
- atom? b == ATOM(b)$Lisp
+ atom? b == not pair? b
pair? b == %pair? b
list? b == pair? b or null? b
diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp
index 77282ff7..7f68cab6 100644
--- a/src/algebra/strap/DFLOAT.lsp
+++ b/src/algebra/strap/DFLOAT.lsp
@@ -780,7 +780,7 @@
(|getShellEntry| $ 134)))
(T (SEQ (LETT |de|
(EXPT BASE
- (LET ((#0=#:G1524 (- |ex|)))
+ (LET ((#0=#:G1525 (- |ex|)))
(|check-subtype|
(NOT (MINUSP #0#))
'(|NonNegativeInteger|) #0#)))
@@ -826,41 +826,46 @@
(LETT |q2|
(+ (* |q| |q1|) |q0|)
|DFLOAT;rationalApproximation;$2NniF;86|)
- (COND
- ((OR (ZEROP |r|)
- (<
- (SPADCALL |tol|
- (ABS
- (- (* |nu| |q2|)
- (* |de| |p2|)))
- (|getShellEntry| $
- 143))
- (* |de| (ABS |p2|))))
- (RETURN-FROM
- |DFLOAT;rationalApproximation;$2NniF;86|
- (SPADCALL |p2| |q2|
- (|getShellEntry| $
- 141)))))
- (LETT |#G107| |p1|
- |DFLOAT;rationalApproximation;$2NniF;86|)
- (LETT |#G108| |p2|
- |DFLOAT;rationalApproximation;$2NniF;86|)
- (SETQ |p0| |#G107|)
- (SETQ |p1| |#G108|)
- (LETT |#G109| |q1|
- |DFLOAT;rationalApproximation;$2NniF;86|)
- (LETT |#G110| |q2|
- |DFLOAT;rationalApproximation;$2NniF;86|)
- (SETQ |q0| |#G109|)
- (SETQ |q1| |#G110|)
(EXIT
- (PROGN
- (LETT |#G111| |t|
- |DFLOAT;rationalApproximation;$2NniF;86|)
- (LETT |#G112| |r|
- |DFLOAT;rationalApproximation;$2NniF;86|)
- (SETQ |s| |#G111|)
- (SETQ |t| |#G112|)))))))))))))))))))))
+ (COND
+ ((OR (ZEROP |r|)
+ (<
+ (SPADCALL |tol|
+ (ABS
+ (- (* |nu| |q2|)
+ (* |de| |p2|)))
+ (|getShellEntry| $
+ 143))
+ (* |de| (ABS |p2|))))
+ (RETURN-FROM
+ |DFLOAT;rationalApproximation;$2NniF;86|
+ (SPADCALL |p2| |q2|
+ (|getShellEntry| $
+ 141))))
+ (T
+ (SEQ
+ (LETT |#G107| |p1|
+ |DFLOAT;rationalApproximation;$2NniF;86|)
+ (LETT |#G108| |p2|
+ |DFLOAT;rationalApproximation;$2NniF;86|)
+ (SETQ |p0| |#G107|)
+ (SETQ |p1| |#G108|)
+ (LETT |#G109| |q1|
+ |DFLOAT;rationalApproximation;$2NniF;86|)
+ (LETT |#G110| |q2|
+ |DFLOAT;rationalApproximation;$2NniF;86|)
+ (SETQ |q0| |#G109|)
+ (SETQ |q1| |#G110|)
+ (EXIT
+ (PROGN
+ (LETT |#G111| |t|
+ |DFLOAT;rationalApproximation;$2NniF;86|)
+ (LETT |#G112| |r|
+ |DFLOAT;rationalApproximation;$2NniF;86|)
+ (SETQ |s|
+ |#G111|)
+ (SETQ |t|
+ |#G112|)))))))))))))))))))))))))
(DEFUN |DFLOAT;**;$F$;87| (|x| |r| $)
(COND
@@ -893,7 +898,7 @@
(DEFUN |DoubleFloat| ()
(DECLARE (SPECIAL |$ConstructorCache|))
- (PROG (#0=#:G1555)
+ (PROG (#0=#:G1556)
(RETURN
(COND
((SETQ #0# (HGET |$ConstructorCache| '|DoubleFloat|))
diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp
index 2e47e3d4..28c0a095 100644
--- a/src/algebra/strap/EUCDOM-.lsp
+++ b/src/algebra/strap/EUCDOM-.lsp
@@ -134,23 +134,22 @@
(|EUCDOM-;unitNormalizeIdealElt|
|s3| $)))))))
(COND
- ((NOT (SPADCALL (SVREF |s1| 0)
- (|getShellEntry| $ 8)))
- (COND
- ((NOT (SPADCALL (SVREF |s1| 0) |y|
- (|getShellEntry| $ 32)))
- (SEQ (SETQ |qr|
- (SPADCALL (SVREF |s1| 0) |y|
+ ((AND (NOT (SPADCALL (SVREF |s1| 0)
+ (|getShellEntry| $ 8)))
+ (NOT (SPADCALL (SVREF |s1| 0) |y|
+ (|getShellEntry| $ 32))))
+ (SEQ (SETQ |qr|
+ (SPADCALL (SVREF |s1| 0) |y|
(|getShellEntry| $ 16)))
- (SETF (SVREF |s1| 0) (CDR |qr|))
- (SETF (SVREF |s1| 1)
- (SPADCALL (SVREF |s1| 1)
+ (SETF (SVREF |s1| 0) (CDR |qr|))
+ (SETF (SVREF |s1| 1)
+ (SPADCALL (SVREF |s1| 1)
(SPADCALL (CAR |qr|) |x|
(|getShellEntry| $ 29))
(|getShellEntry| $ 33)))
- (EXIT (SETQ |s1|
- (|EUCDOM-;unitNormalizeIdealElt|
- |s1| $))))))))
+ (EXIT (SETQ |s1|
+ (|EUCDOM-;unitNormalizeIdealElt|
+ |s1| $))))))
(EXIT |s1|))))))))
(DEFUN |EUCDOM-;extendedEuclidean;3SU;8| (|x| |y| |z| $)
diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp
index 36320aa1..67a74101 100644
--- a/src/algebra/strap/FFIELDC-.lsp
+++ b/src/algebra/strap/FFIELDC-.lsp
@@ -402,8 +402,11 @@
(T
(SEQ
(LETT |rho|
- (* (CDR |rhoHelp|)
- |mult|)
+ (SPADCALL
+ (CDR |rhoHelp|)
+ |mult|
+ (|getShellEntry| $
+ 92))
|FFIELDC-;discreteLog;2SU;12|)
(SETQ |disclog|
(+ |disclog| |rho|))
@@ -424,44 +427,44 @@
(EXIT (CONS 0 |disclog|))))))))))
(DEFUN |FFIELDC-;squareFreePolynomial| (|f| $)
- (SPADCALL |f| (|getShellEntry| $ 96)))
+ (SPADCALL |f| (|getShellEntry| $ 97)))
(DEFUN |FFIELDC-;factorPolynomial| (|f| $)
- (SPADCALL |f| (|getShellEntry| $ 98)))
+ (SPADCALL |f| (|getShellEntry| $ 99)))
(DEFUN |FFIELDC-;factorSquareFreePolynomial| (|f| $)
(COND
- ((SPADCALL |f| (|spadConstant| $ 99) (|getShellEntry| $ 100))
- (|spadConstant| $ 101))
- (T (LET ((|flist| (SPADCALL |f| T (|getShellEntry| $ 105))))
- (SPADCALL (SPADCALL (CAR |flist|) (|getShellEntry| $ 106))
+ ((SPADCALL |f| (|spadConstant| $ 100) (|getShellEntry| $ 101))
+ (|spadConstant| $ 102))
+ (T (LET ((|flist| (SPADCALL |f| T (|getShellEntry| $ 106))))
+ (SPADCALL (SPADCALL (CAR |flist|) (|getShellEntry| $ 107))
(LET ((#0=#:G1483 NIL) (#1=#:G1484 T)
(#2=#:G1495 (CDR |flist|)))
(LOOP
(COND
((ATOM #2#)
(RETURN
- (COND (#1# (|spadConstant| $ 109)) (T #0#))))
+ (COND (#1# (|spadConstant| $ 110)) (T #0#))))
(T (LET ((|u| (CAR #2#)))
(LET ((#3=#:G1482
(SPADCALL (CAR |u|) (CDR |u|)
- (|getShellEntry| $ 107))))
+ (|getShellEntry| $ 108))))
(COND
(#1# (SETQ #0# #3#))
(T (SETQ #0#
(SPADCALL #0# #3#
- (|getShellEntry| $ 108)))))
+ (|getShellEntry| $ 109)))))
(SETQ #1# NIL)))))
(SETQ #2# (CDR #2#))))
- (|getShellEntry| $ 110))))))
+ (|getShellEntry| $ 111))))))
(DEFUN |FFIELDC-;gcdPolynomial;3Sup;16| (|f| |g| $)
- (SPADCALL |f| |g| (|getShellEntry| $ 112)))
+ (SPADCALL |f| |g| (|getShellEntry| $ 113)))
(DEFUN |FiniteFieldCategory&| (|#1|)
(LET* ((|dv$1| (|devaluate| |#1|))
(|dv$| (LIST '|FiniteFieldCategory&| |dv$1|))
- ($ (|newShell| 115)) (|pv$| (|buildPredVector| 0 0 NIL)))
+ ($ (|newShell| 116)) (|pv$| (|buildPredVector| 0 0 NIL)))
(|setShellEntry| $ 0 |dv$|)
(|setShellEntry| $ 3 |pv$|)
(|stuffDomainSlots| $)
@@ -503,27 +506,27 @@
(225 . |rem|) (231 . |zero?|) (|Factored| $)
(236 . |factor|) (|Factored| 20) (241 . |factors|)
(|DiscreteLogarithmPackage| 6)
- (246 . |shanksDiscLogAlgorithm|)
+ (246 . |shanksDiscLogAlgorithm|) (253 . *)
|FFIELDC-;discreteLog;2SU;12|
- (|SparseUnivariatePolynomial| 6) (|Factored| 93)
- (|UnivariatePolynomialSquareFree| 6 93)
- (253 . |squareFree|) (|DistinctDegreeFactorize| 6 93)
- (258 . |factor|) (263 . |Zero|) (267 . =) (273 . |Zero|)
- (|Record| (|:| |irr| 93) (|:| |pow| 20)) (|List| 102)
- (|Record| (|:| |cont| 6) (|:| |factors| 103))
- (277 . |distdfact|) (283 . |coerce|) (288 . |primeFactor|)
- (294 . *) (300 . |One|) (304 . *) (|EuclideanDomain&| 93)
- (310 . |gcd|) (|SparseUnivariatePolynomial| $)
+ (|SparseUnivariatePolynomial| 6) (|Factored| 94)
+ (|UnivariatePolynomialSquareFree| 6 94)
+ (259 . |squareFree|) (|DistinctDegreeFactorize| 6 94)
+ (264 . |factor|) (269 . |Zero|) (273 . =) (279 . |Zero|)
+ (|Record| (|:| |irr| 94) (|:| |pow| 20)) (|List| 103)
+ (|Record| (|:| |cont| 6) (|:| |factors| 104))
+ (283 . |distdfact|) (289 . |coerce|) (294 . |primeFactor|)
+ (300 . *) (306 . |One|) (310 . *) (|EuclideanDomain&| 94)
+ (316 . |gcd|) (|SparseUnivariatePolynomial| $)
|FFIELDC-;gcdPolynomial;3Sup;16|)
- '#(|primitive?| 316 |order| 321 |nextItem| 331 |init| 336
- |gcdPolynomial| 340 |discreteLog| 346 |differentiate| 357
- |createPrimitiveElement| 362 |conditionP| 366 |charthRoot|
- 371)
+ '#(|primitive?| 322 |order| 327 |nextItem| 337 |init| 342
+ |gcdPolynomial| 346 |discreteLog| 352 |differentiate| 363
+ |createPrimitiveElement| 368 |conditionP| 372 |charthRoot|
+ 377)
'NIL
(CONS (|makeByteWordVec2| 1 'NIL)
(CONS '#()
(CONS '#()
- (|makeByteWordVec2| 114
+ (|makeByteWordVec2| 115
'(0 6 0 7 1 6 10 0 11 0 10 0 12 2 10 0
0 0 13 1 6 0 10 14 1 6 15 0 16 1 6 10
0 19 1 21 0 20 22 1 26 25 0 27 1 25
@@ -540,14 +543,14 @@
2 20 0 20 0 75 1 20 0 0 76 2 6 0 0 0
77 2 20 0 0 0 78 1 82 80 81 83 2 39 0
0 0 84 1 39 15 0 85 1 20 86 0 87 1 88
- 55 0 89 3 90 70 6 6 39 91 1 95 94 93
- 96 1 97 94 93 98 0 93 0 99 2 93 15 0
- 0 100 0 94 0 101 2 97 104 93 15 105 1
- 93 0 6 106 2 94 0 93 20 107 2 94 0 0
- 0 108 0 94 0 109 2 94 0 93 0 110 2
- 111 0 0 0 112 1 0 15 0 60 1 0 10 0 64
- 1 0 21 0 23 1 0 17 0 18 0 0 0 9 2 0
- 113 113 113 114 1 0 39 0 79 2 0 70 0
- 0 92 1 0 0 0 8 0 0 0 53 1 0 36 37 38
- 1 0 0 0 44 1 0 17 0 45)))))
+ 55 0 89 3 90 70 6 6 39 91 2 20 0 39 0
+ 92 1 96 95 94 97 1 98 95 94 99 0 94 0
+ 100 2 94 15 0 0 101 0 95 0 102 2 98
+ 105 94 15 106 1 94 0 6 107 2 95 0 94
+ 20 108 2 95 0 0 0 109 0 95 0 110 2 95
+ 0 94 0 111 2 112 0 0 0 113 1 0 15 0
+ 60 1 0 10 0 64 1 0 21 0 23 1 0 17 0
+ 18 0 0 0 9 2 0 114 114 114 115 1 0 39
+ 0 79 2 0 70 0 0 93 1 0 0 0 8 0 0 0 53
+ 1 0 36 37 38 1 0 0 0 44 1 0 17 0 45)))))
'|lookupComplete|))
diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp
index ccff6c9a..f5da4692 100644
--- a/src/algebra/strap/ILIST.lsp
+++ b/src/algebra/strap/ILIST.lsp
@@ -201,10 +201,9 @@
(COND
((NOT (NOT (NULL |x|))) (RETURN NIL))
(T (SEQ (COND
- ((EQL |i| 1000)
- (COND
- ((SPADCALL |x| (|getShellEntry| $ 35))
- (|error| "cyclic list")))))
+ ((AND (EQL |i| 1000)
+ (SPADCALL |x| (|getShellEntry| $ 35)))
+ (|error| "cyclic list")))
(SETQ |y| (CONS (CAR |x|) |y|))
(EXIT (SETQ |x| (CDR |x|))))))
(SETQ |i| (+ |i| 1))))
@@ -385,11 +384,10 @@
(PROG (|l| |q|)
(RETURN
(SEQ (COND
- ((EQL |n| 2)
- (COND
- ((SPADCALL (|SPADfirst| (CDR |p|)) (|SPADfirst| |p|)
- |f|)
- (SETQ |p| (NREVERSE |p|))))))
+ ((AND (EQL |n| 2)
+ (SPADCALL (|SPADfirst| (CDR |p|)) (|SPADfirst| |p|)
+ |f|))
+ (SETQ |p| (NREVERSE |p|))))
(EXIT (COND
((< |n| 3) |p|)
(T (SEQ (LETT |l|
diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp
index b1b53d3e..05e4417f 100644
--- a/src/algebra/strap/INT.lsp
+++ b/src/algebra/strap/INT.lsp
@@ -370,7 +370,7 @@
(DEFUN |INT;latex;$S;27| (|x| $)
(LET ((|s| (WRITE-TO-STRING |x|)))
- (SEQ (COND ((< -1 |x|) (COND ((< |x| 10) (EXIT |s|)))))
+ (SEQ (COND ((AND (< -1 |x|) (< |x| 10)) (EXIT |s|)))
(EXIT (STRCONC "{" (STRCONC |s| "}"))))))
(DEFUN |INT;positiveRemainder;3$;28| (|a| |b| $)
diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index 692f7a04..578dd99f 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -196,41 +196,40 @@
(SVREF $ 6)))
(T (- (SPADCALL |s| (|getShellEntry| $ 47))
(SVREF $ 6))))))
- (SEQ (COND
- ((OR (OR (MINUSP |l|) (NOT (< |h| |m|)))
- (< |h| (- |l| 1)))
- (EXIT (|error| "index out of range"))))
- (LETT |r|
- (MAKE-FULL-CVEC
- (LET ((#0=#:G1419
- (+ (- |m| (+ (- |h| |l|) 1)) |n|)))
- (|check-subtype| (NOT (MINUSP #0#))
- '(|NonNegativeInteger|) #0#))
- (|spadConstant| $ 53))
- |ISTRING;replace;$Us2$;15|)
- (LETT |k| 0 |ISTRING;replace;$Us2$;15|)
- (LET ((|i| 0) (#1=#:G1510 (- |l| 1)))
- (LOOP
- (COND
- ((> |i| #1#) (RETURN NIL))
- (T (SEQ (SETF (CHAR |r| |k|) (CHAR |s| |i|))
- (EXIT (SETQ |k| (+ |k| 1))))))
- (SETQ |i| (+ |i| 1))))
- (LET ((|i| 0) (#2=#:G1511 (- |n| 1)))
- (LOOP
- (COND
- ((> |i| #2#) (RETURN NIL))
- (T (SEQ (SETF (CHAR |r| |k|) (CHAR |t| |i|))
- (EXIT (SETQ |k| (+ |k| 1))))))
- (SETQ |i| (+ |i| 1))))
- (LET ((|i| (+ |h| 1)) (#3=#:G1512 (- |m| 1)))
- (LOOP
- (COND
- ((> |i| #3#) (RETURN NIL))
- (T (SEQ (SETF (CHAR |r| |k|) (CHAR |s| |i|))
- (EXIT (SETQ |k| (+ |k| 1))))))
- (SETQ |i| (+ |i| 1))))
- (EXIT |r|))))))
+ (COND
+ ((OR (OR (MINUSP |l|) (NOT (< |h| |m|))) (< |h| (- |l| 1)))
+ (|error| "index out of range"))
+ (T (SEQ (LETT |r|
+ (MAKE-FULL-CVEC
+ (LET ((#0=#:G1420
+ (+ (- |m| (+ (- |h| |l|) 1)) |n|)))
+ (|check-subtype| (NOT (MINUSP #0#))
+ '(|NonNegativeInteger|) #0#))
+ (|spadConstant| $ 53))
+ |ISTRING;replace;$Us2$;15|)
+ (LETT |k| 0 |ISTRING;replace;$Us2$;15|)
+ (LET ((|i| 0) (#1=#:G1511 (- |l| 1)))
+ (LOOP
+ (COND
+ ((> |i| #1#) (RETURN NIL))
+ (T (SEQ (SETF (CHAR |r| |k|) (CHAR |s| |i|))
+ (EXIT (SETQ |k| (+ |k| 1))))))
+ (SETQ |i| (+ |i| 1))))
+ (LET ((|i| 0) (#2=#:G1512 (- |n| 1)))
+ (LOOP
+ (COND
+ ((> |i| #2#) (RETURN NIL))
+ (T (SEQ (SETF (CHAR |r| |k|) (CHAR |t| |i|))
+ (EXIT (SETQ |k| (+ |k| 1))))))
+ (SETQ |i| (+ |i| 1))))
+ (LET ((|i| (+ |h| 1)) (#3=#:G1513 (- |m| 1)))
+ (LOOP
+ (COND
+ ((> |i| #3#) (RETURN NIL))
+ (T (SEQ (SETF (CHAR |r| |k|) (CHAR |s| |i|))
+ (EXIT (SETQ |k| (+ |k| 1))))))
+ (SETQ |i| (+ |i| 1))))
+ (EXIT |r|))))))))
(DEFUN |ISTRING;setelt;$I2C;16| (|s| |i| |c| $)
(COND
@@ -245,7 +244,7 @@
(EXIT (COND
((MINUSP |startpos|) (|error| "index out of bounds"))
((< (- |nw| |startpos|) |np|) NIL)
- (T (SEQ (LET ((|ip| 0) (#0=#:G1513 (- |np| 1))
+ (T (SEQ (LET ((|ip| 0) (#0=#:G1514 (- |np| 1))
(|iw| |startpos|))
(LOOP
(COND
@@ -282,7 +281,7 @@
((MINUSP |startpos|) (|error| "index out of bounds"))
((NOT (< |startpos| (LENGTH |t|))) (- (SVREF $ 6) 1))
(T (SEQ (LET ((|r| |startpos|)
- (#0=#:G1514 (- (LENGTH |t|) 1)))
+ (#0=#:G1515 (- (LENGTH |t|) 1)))
(LOOP
(COND
((> |r| #0#) (RETURN NIL))
@@ -300,7 +299,7 @@
((MINUSP |startpos|) (|error| "index out of bounds"))
((NOT (< |startpos| (LENGTH |t|))) (- (SVREF $ 6) 1))
(T (SEQ (LET ((|r| |startpos|)
- (#0=#:G1515 (- (LENGTH |t|) 1)))
+ (#0=#:G1516 (- (LENGTH |t|) 1)))
(LOOP
(COND
((> |r| #0#) (RETURN NIL))
@@ -488,13 +487,13 @@
(DEFUN |ISTRING;concat;L$;28| (|l| $)
(LET ((|t| (MAKE-FULL-CVEC
- (LET ((#0=#:G1472 NIL) (#1=#:G1473 T)
- (#2=#:G1517 |l|))
+ (LET ((#0=#:G1473 NIL) (#1=#:G1474 T)
+ (#2=#:G1518 |l|))
(LOOP
(COND
((ATOM #2#) (RETURN (COND (#1# 0) (T #0#))))
(T (LET ((|s| (CAR #2#)))
- (LET ((#3=#:G1471 (LENGTH |s|)))
+ (LET ((#3=#:G1472 (LENGTH |s|)))
(COND
(#1# (SETQ #0# #3#))
(T (SETQ #0# (+ #0# #3#))))
@@ -502,7 +501,7 @@
(SETQ #2# (CDR #2#))))
(|spadConstant| $ 53)))
(|i| (SVREF $ 6)))
- (SEQ (LET ((#4=#:G1516 |l|))
+ (SEQ (LET ((#4=#:G1517 |l|))
(LOOP
(COND
((ATOM #4#) (RETURN NIL))
@@ -515,10 +514,10 @@
(DEFUN |ISTRING;copyInto!;2$I$;29| (|y| |x| |s| $)
(LET ((|m| (LENGTH |x|)) (|n| (LENGTH |y|)))
(SEQ (SETQ |s| (- |s| (SVREF $ 6)))
- (COND
- ((OR (MINUSP |s|) (< |n| (+ |s| |m|)))
- (EXIT (|error| "index out of range"))))
- (RPLACSTR |y| |s| |m| |x| 0 |m|) (EXIT |y|))))
+ (EXIT (COND
+ ((OR (MINUSP |s|) (< |n| (+ |s| |m|)))
+ (|error| "index out of range"))
+ (T (SEQ (RPLACSTR |y| |s| |m| |x| 0 |m|) (EXIT |y|))))))))
(DEFUN |ISTRING;elt;$IC;30| (|s| |i| $)
(COND
@@ -533,10 +532,10 @@
((SPADCALL |sg| (|getShellEntry| $ 45))
(- (SPADCALL |sg| (|getShellEntry| $ 46)) (SVREF $ 6)))
(T (- (SPADCALL |s| (|getShellEntry| $ 47)) (SVREF $ 6))))))
- (SEQ (COND
- ((OR (MINUSP |l|) (NOT (< |h| (LENGTH |s|))))
- (EXIT (|error| "index out of bound"))))
- (EXIT (SUBSTRING |s| |l| (MAX 0 (+ (- |h| |l|) 1)))))))
+ (COND
+ ((OR (MINUSP |l|) (NOT (< |h| (LENGTH |s|))))
+ (|error| "index out of bound"))
+ (T (SUBSTRING |s| |l| (MAX 0 (+ (- |h| |l|) 1)))))))
(DEFUN |ISTRING;hash;$Si;32| (|s| $)
(DECLARE (IGNORE $))
@@ -550,7 +549,7 @@
(RETURN
(LET ((|n| (SPADCALL |pattern| (|getShellEntry| $ 47))))
(SEQ (LETT |p|
- (LET ((#0=#:G1500
+ (LET ((#0=#:G1501
(|ISTRING;position;C$2I;19| |dontcare|
|pattern|
(LETT |m|
@@ -564,22 +563,18 @@
(EXIT (COND
((EQL |p| (- |m| 1))
(NOT (NULL (STRING= |pattern| |target|))))
- (T (SEQ (COND
- ((SPADCALL |p| |m|
- (|getShellEntry| $ 87))
- (COND
- ((NOT
- (SPADCALL
- (|ISTRING;elt;$Us$;31| |pattern|
- (SPADCALL |m| (- |p| 1)
- (|getShellEntry| $ 24))
- $)
- |target| (|getShellEntry| $ 88)))
- (EXIT NIL)))))
- (LETT |i| |p| |ISTRING;match?;2$CB;34|)
+ ((AND (SPADCALL |p| |m| (|getShellEntry| $ 87))
+ (NOT (SPADCALL
+ (|ISTRING;elt;$Us$;31| |pattern|
+ (SPADCALL |m| (- |p| 1)
+ (|getShellEntry| $ 24))
+ $)
+ |target| (|getShellEntry| $ 88))))
+ NIL)
+ (T (SEQ (LETT |i| |p| |ISTRING;match?;2$CB;34|)
(LETT |q|
(LET
- ((#1=#:G1501
+ ((#1=#:G1502
(|ISTRING;position;C$2I;19|
|dontcare| |pattern| (+ |p| 1)
$)))
@@ -601,7 +596,7 @@
|ISTRING;match?;2$CB;34|)
(SETQ |i|
(LET
- ((#2=#:G1502
+ ((#2=#:G1503
(|ISTRING;position;2$2I;18|
|s| |target| |i| $)))
(|check-subtype|
@@ -621,7 +616,7 @@
(EXIT
(SETQ |q|
(LET
- ((#3=#:G1503
+ ((#3=#:G1504
(|ISTRING;position;C$2I;19|
|dontcare| |pattern|
(+ |q| 1) $)))
@@ -630,22 +625,21 @@
'(|NonNegativeInteger|)
#3#))))))))))))
(COND
- ((SPADCALL |p| |n|
- (|getShellEntry| $ 87))
- (COND
- ((NOT
- (|ISTRING;suffix?;2$B;21|
- (|ISTRING;elt;$Us$;31| |pattern|
- (SPADCALL (+ |p| 1) |n|
- (|getShellEntry| $ 24))
- $)
- |target| $))
- (EXIT NIL)))))
+ ((AND (SPADCALL |p| |n|
+ (|getShellEntry| $ 87))
+ (NOT
+ (|ISTRING;suffix?;2$B;21|
+ (|ISTRING;elt;$Us$;31| |pattern|
+ (SPADCALL (+ |p| 1) |n|
+ (|getShellEntry| $ 24))
+ $)
+ |target| $)))
+ (EXIT NIL)))
(EXIT T))))))))))
-(DEFUN |IndexedString| (#0=#:G1518)
+(DEFUN |IndexedString| (#0=#:G1519)
(DECLARE (SPECIAL |$ConstructorCache|))
- (PROG (#1=#:G1519)
+ (PROG (#1=#:G1520)
(RETURN
(COND
((SETQ #1#
diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp
index ff8f2e2d..356679c0 100644
--- a/src/algebra/strap/LIST.lsp
+++ b/src/algebra/strap/LIST.lsp
@@ -184,7 +184,7 @@
(DEFUN |List;| (|#1|)
(DECLARE (SPECIAL |$ConstructorCache|))
(LET* ((|dv$1| (|devaluate| |#1|)) (|dv$| (LIST '|List| |dv$1|))
- ($ (|newShell| 70))
+ ($ (|newShell| 71))
(|pv$| (|buildPredVector| 0 0
(LIST (OR (AND (|HasCategory| |#1| '(|OrderedSet|))
(|HasCategory| |#1|
@@ -268,14 +268,14 @@
(96 . |concat|) (102 . |removeDuplicates|)
(107 . |setUnion|) (113 . |empty|) (117 . |empty?|)
(122 . |member?|) (128 . |setIntersection|) (134 . |elt|)
- (140 . |concat|) (146 . |setDifference|) (|OutputForm|)
+ (140 . |concat|) (146 . |setDifference|) (|Symbol|)
(|InputForm|) (152 . |convert|) (157 . |convert|)
(|List| 46) (162 . |concat|) (|List| $) (168 . |convert|)
(173 . |convert|) (|Mapping| 6 6 6) (|NonNegativeInteger|)
(|List| 6) (|Equation| 6) (|List| 57) (|Mapping| 10 6)
(|Mapping| 10 6 6) (|UniversalSegment| 7) '"last" '"rest"
- '"first" '"value" (|Mapping| 6 6) (|SingleInteger|)
- (|List| 7) (|Union| 6 '"failed"))
+ '"first" '"value" (|Mapping| 6 6) (|OutputForm|)
+ (|SingleInteger|) (|List| 7) (|Union| 6 '"failed"))
'#(|setUnion| 178 |setIntersection| 184 |setDifference| 190
|rest| 196 |removeDuplicates| 201 |null| 206 |nil| 211
|member?| 215 |first| 221 |empty?| 226 |empty| 231 |elt|
@@ -309,7 +309,7 @@
(|Eltable| 61 $$) (|Aggregate|)
(|Eltable| 7 6) (|Evalable| 6)
(|BasicType|) (|Type|)
- (|InnerEvalable| 6 6) (|CoercibleTo| 45)
+ (|InnerEvalable| 6 6) (|CoercibleTo| 67)
(|ConvertibleTo| 46) (|OpenMath|))
(|makeByteWordVec2| 53
'(0 7 0 8 1 15 14 0 16 3 15 14 0 17 17
diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp
index 0fdf21f2..f7e85f4c 100644
--- a/src/algebra/strap/LSAGG-.lsp
+++ b/src/algebra/strap/LSAGG-.lsp
@@ -384,13 +384,12 @@
(PROG (|l| |q|)
(RETURN
(SEQ (COND
- ((EQL |n| 2)
- (COND
- ((SPADCALL
- (SPADCALL (SPADCALL |p| (|getShellEntry| $ 17))
- (|getShellEntry| $ 18))
- (SPADCALL |p| (|getShellEntry| $ 18)) |f|)
- (SETQ |p| (SPADCALL |p| (|getShellEntry| $ 55)))))))
+ ((AND (EQL |n| 2)
+ (SPADCALL
+ (SPADCALL (SPADCALL |p| (|getShellEntry| $ 17))
+ (|getShellEntry| $ 18))
+ (SPADCALL |p| (|getShellEntry| $ 18)) |f|))
+ (SETQ |p| (SPADCALL |p| (|getShellEntry| $ 55)))))
(EXIT (COND
((< |n| 3) |p|)
(T (SEQ (LETT |l|
@@ -523,18 +522,18 @@
(COND
((NOT (NOT (SPADCALL |x| (|getShellEntry| $ 16))))
(RETURN NIL))
- (T (SEQ (COND
- ((EQL |k| 1000)
- (COND
- ((SPADCALL |x| (|getShellEntry| $ 67))
- (EXIT (|error| "cyclic list"))))))
- (SETQ |y|
- (SPADCALL
- (SPADCALL |x| (|getShellEntry| $ 18))
- |y| (|getShellEntry| $ 14)))
- (EXIT (SETQ |x|
- (SPADCALL |x|
- (|getShellEntry| $ 17)))))))
+ (T (COND
+ ((AND (EQL |k| 1000)
+ (SPADCALL |x| (|getShellEntry| $ 67)))
+ (|error| "cyclic list"))
+ (T (SEQ (SETQ |y|
+ (SPADCALL
+ (SPADCALL |x|
+ (|getShellEntry| $ 18))
+ |y| (|getShellEntry| $ 14)))
+ (EXIT (SETQ |x|
+ (SPADCALL |x|
+ (|getShellEntry| $ 17)))))))))
(SETQ |k| (+ |k| 1))))
(EXIT (SPADCALL |y| (|getShellEntry| $ 55))))))
diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp
index d689f438..71c72c64 100644
--- a/src/algebra/strap/POLYCAT-.lsp
+++ b/src/algebra/strap/POLYCAT-.lsp
@@ -315,16 +315,15 @@
(SPADCALL |p| (|getShellEntry| $ 53))
|POLYCAT-;retractIfCan;SU;10|)
(EXIT (COND
- ((ZEROP (CAR |q|))
- (COND
- ((SPADCALL
- (SPADCALL (CDR |q|)
- (|getShellEntry| $ 72))
- |p| (|getShellEntry| $ 54))
- (PROGN
- (LETT #0# |q|
- |POLYCAT-;retractIfCan;SU;10|)
- (GO #0#))))))))
+ ((AND (ZEROP (CAR |q|))
+ (SPADCALL
+ (SPADCALL (CDR |q|)
+ (|getShellEntry| $ 72))
+ |p| (|getShellEntry| $ 54)))
+ (PROGN
+ (LETT #0# |q|
+ |POLYCAT-;retractIfCan;SU;10|)
+ (GO #0#))))))
(EXIT (CONS 1 "failed"))))
#0# (EXIT #0#)))))
@@ -1191,39 +1190,27 @@
|POLYCAT-;primitivePart;SVarSetS;37|)
$)))))
(COND
- ((|testBitVector| |pv$| 8)
- (COND
- ((|testBitVector| |pv$| 7)
- (|setShellEntry| $ 222
- (CONS (|dispatchFunction|
- |POLYCAT-;patternMatch;SP2Pmr;39|)
- $))))))
+ ((AND (|testBitVector| |pv$| 8) (|testBitVector| |pv$| 7))
+ (|setShellEntry| $ 222
+ (CONS (|dispatchFunction| |POLYCAT-;patternMatch;SP2Pmr;39|)
+ $))))
(COND
- ((|testBitVector| |pv$| 6)
- (COND
- ((|testBitVector| |pv$| 5)
- (|setShellEntry| $ 229
- (CONS (|dispatchFunction|
- |POLYCAT-;patternMatch;SP2Pmr;40|)
- $))))))
+ ((AND (|testBitVector| |pv$| 6) (|testBitVector| |pv$| 5))
+ (|setShellEntry| $ 229
+ (CONS (|dispatchFunction| |POLYCAT-;patternMatch;SP2Pmr;40|)
+ $))))
(COND
- ((|testBitVector| |pv$| 12)
- (COND
- ((|testBitVector| |pv$| 11)
- (|setShellEntry| $ 236
- (CONS (|dispatchFunction| |POLYCAT-;convert;SP;41|) $))))))
+ ((AND (|testBitVector| |pv$| 12) (|testBitVector| |pv$| 11))
+ (|setShellEntry| $ 236
+ (CONS (|dispatchFunction| |POLYCAT-;convert;SP;41|) $))))
(COND
- ((|testBitVector| |pv$| 10)
- (COND
- ((|testBitVector| |pv$| 9)
- (|setShellEntry| $ 243
- (CONS (|dispatchFunction| |POLYCAT-;convert;SP;42|) $))))))
+ ((AND (|testBitVector| |pv$| 10) (|testBitVector| |pv$| 9))
+ (|setShellEntry| $ 243
+ (CONS (|dispatchFunction| |POLYCAT-;convert;SP;42|) $))))
(COND
- ((|testBitVector| |pv$| 14)
- (COND
- ((|testBitVector| |pv$| 13)
- (|setShellEntry| $ 251
- (CONS (|dispatchFunction| |POLYCAT-;convert;SIf;43|) $))))))
+ ((AND (|testBitVector| |pv$| 14) (|testBitVector| |pv$| 13))
+ (|setShellEntry| $ 251
+ (CONS (|dispatchFunction| |POLYCAT-;convert;SIf;43|) $))))
$))
(MAKEPROP '|PolynomialCategory&| '|infovec|
diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp
index b6b60077..39220475 100644
--- a/src/algebra/strap/STAGG-.lsp
+++ b/src/algebra/strap/STAGG-.lsp
@@ -73,17 +73,17 @@
(DEFUN |STAGG-;elt;AIS;5| (|x| |i| $)
(SEQ (SETQ |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 21))))
- (COND
- ((OR (MINUSP |i|)
- (SPADCALL
- (SETQ |x|
- (SPADCALL |x|
- (|check-subtype| (NOT (MINUSP |i|))
- '(|NonNegativeInteger|) |i|)
- (|getShellEntry| $ 25)))
- (|getShellEntry| $ 18)))
- (EXIT (|error| "index out of range"))))
- (EXIT (SPADCALL |x| (|getShellEntry| $ 19)))))
+ (EXIT (COND
+ ((OR (MINUSP |i|)
+ (SPADCALL
+ (SETQ |x|
+ (SPADCALL |x|
+ (|check-subtype| (NOT (MINUSP |i|))
+ '(|NonNegativeInteger|) |i|)
+ (|getShellEntry| $ 25)))
+ (|getShellEntry| $ 18)))
+ (|error| "index out of range"))
+ (T (SPADCALL |x| (|getShellEntry| $ 19)))))))
(DEFUN |STAGG-;elt;AUsA;6| (|x| |i| $)
(PROG (|h|)
@@ -155,17 +155,17 @@
(DEFUN |STAGG-;setelt;AI2S;11| (|x| |i| |s| $)
(SEQ (SETQ |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 21))))
- (COND
- ((OR (MINUSP |i|)
- (SPADCALL
- (SETQ |x|
- (SPADCALL |x|
- (|check-subtype| (NOT (MINUSP |i|))
- '(|NonNegativeInteger|) |i|)
- (|getShellEntry| $ 25)))
- (|getShellEntry| $ 18)))
- (EXIT (|error| "index out of range"))))
- (EXIT (SPADCALL |x| |s| (|getShellEntry| $ 46)))))
+ (EXIT (COND
+ ((OR (MINUSP |i|)
+ (SPADCALL
+ (SETQ |x|
+ (SPADCALL |x|
+ (|check-subtype| (NOT (MINUSP |i|))
+ '(|NonNegativeInteger|) |i|)
+ (|getShellEntry| $ 25)))
+ (|getShellEntry| $ 18)))
+ (|error| "index out of range"))
+ (T (SPADCALL |x| |s| (|getShellEntry| $ 46)))))))
(DEFUN |STAGG-;setelt;AUs2S;12| (|x| |i| |s| $)
(PROG (|h| |y| |z|)
diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp
index dc8a964e..4ebf3c65 100644
--- a/src/algebra/strap/SYMBOL.lsp
+++ b/src/algebra/strap/SYMBOL.lsp
@@ -98,6 +98,8 @@
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
|SYMBOL;scripted?;$B;30|))
+(PUT '|SYMBOL;scripted?;$B;30| '|SPADreplace| '|%pair?|)
+
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
|SYMBOL;name;2$;31|))
@@ -116,7 +118,7 @@
(DEFUN |SYMBOL;writeOMSym| (|dev| |x| $)
(COND
- ((|SYMBOL;scripted?;$B;30| |x| $)
+ ((CONSP |x|)
(|error| "Cannot convert a scripted symbol to OpenMath"))
(T (SPADCALL |dev| |x| (|getShellEntry| $ 27)))))
@@ -258,8 +260,7 @@
(DEFUN |SYMBOL;script;$R$;23| (|sy| |sc| $)
(COND
- ((|SYMBOL;scripted?;$B;30| |sy| $)
- (|error| "Cannot add scripts to a scripted symbol"))
+ ((CONSP |sy|) (|error| "Cannot add scripts to a scripted symbol"))
(T (CONS (|SYMBOL;coerce;$Of;11|
(|SYMBOL;coerce;S$;8|
(STRCONC (|SYMBOL;syprefix| |sc| $)
@@ -271,7 +272,7 @@
(DEFUN |SYMBOL;string;$S;24| (|e| $)
(COND
- ((NOT (|SYMBOL;scripted?;$B;30| |e| $)) (PNAME |e|))
+ ((NOT (CONSP |e|)) (PNAME |e|))
(T (|error| "Cannot form string from non-atomic symbols."))))
(DEFUN |SYMBOL;latex;$S;25| (|e| $)
@@ -279,15 +280,12 @@
(RETURN
(LET ((|s| (PNAME (|SYMBOL;name;2$;31| |e| $))))
(SEQ (COND
- ((< 1 (LENGTH |s|))
- (COND
- ((SPADCALL (SPADCALL |s| 1 (|getShellEntry| $ 106))
- (SPADCALL "\\" (|getShellEntry| $ 43))
- (|getShellEntry| $ 107))
- (SETQ |s|
- (STRCONC "\\mbox{\\it " (STRCONC |s| "}")))))))
- (COND
- ((NOT (|SYMBOL;scripted?;$B;30| |e| $)) (EXIT |s|)))
+ ((AND (< 1 (LENGTH |s|))
+ (SPADCALL (SPADCALL |s| 1 (|getShellEntry| $ 106))
+ (SPADCALL "\\" (|getShellEntry| $ 43))
+ (|getShellEntry| $ 107)))
+ (SETQ |s| (STRCONC "\\mbox{\\it " (STRCONC |s| "}")))))
+ (COND ((NOT (CONSP |e|)) (EXIT |s|)))
(LETT |ss| (|SYMBOL;scripts;$R;32| |e| $)
|SYMBOL;latex;$S;25|)
(LETT |lo| (SVREF |ss| 0) |SYMBOL;latex;$S;25|)
@@ -430,8 +428,7 @@
(SPADCALL (SVREF $ 13) |x| |n| (|getShellEntry| $ 127))
(LETT |xx|
(COND
- ((NOT (|SYMBOL;scripted?;$B;30| |x| $))
- (|SYMBOL;string;$S;24| |x| $))
+ ((NOT (CONSP |x|)) (|SYMBOL;string;$S;24| |x| $))
(T (|SYMBOL;string;$S;24|
(|SYMBOL;name;2$;31| |x| $) $)))
|SYMBOL;new;2$;28|)
@@ -451,8 +448,7 @@
(T (STRCONC |xx|
(|SYMBOL;anyRadix| |n| (SVREF $ 19) $)))))
(COND
- ((NOT (|SYMBOL;scripted?;$B;30| |x| $))
- (EXIT (|SYMBOL;coerce;S$;8| |xx| $))))
+ ((NOT (CONSP |x|)) (EXIT (|SYMBOL;coerce;S$;8| |xx| $))))
(EXIT (|SYMBOL;script;$R$;23| (|SYMBOL;coerce;S$;8| |xx| $)
(|SYMBOL;scripts;$R;32| |x| $) $))))))
@@ -468,11 +464,13 @@
(|getShellEntry| $ 134)))))
(SETQ #0# (CDR #0#)))))))
-(DEFUN |SYMBOL;scripted?;$B;30| (|sy| $) (NOT (ATOM |sy|)))
+(DEFUN |SYMBOL;scripted?;$B;30| (|sy| $)
+ (DECLARE (IGNORE $))
+ (CONSP |sy|))
(DEFUN |SYMBOL;name;2$;31| (|sy| $)
(COND
- ((NOT (|SYMBOL;scripted?;$B;30| |sy| $)) |sy|)
+ ((NOT (CONSP |sy|)) |sy|)
(T (LET ((|str| (|SYMBOL;string;$S;24|
(SPADCALL (|SYMBOL;list;$L;34| |sy| $)
(|getShellEntry| $ 137))
@@ -501,8 +499,7 @@
(PROG (|allscripts|)
(RETURN
(COND
- ((NOT (|SYMBOL;scripted?;$B;30| |sy| $))
- (VECTOR NIL NIL NIL NIL NIL))
+ ((NOT (CONSP |sy|)) (VECTOR NIL NIL NIL NIL NIL))
(T (LET* ((|nscripts| '(0 0 0 0 0))
(|lscripts| (LIST NIL NIL NIL NIL NIL))
(|str| (|SYMBOL;string;$S;24|
@@ -592,7 +589,7 @@
(DEFUN |SYMBOL;list;$L;34| (|sy| $)
(COND
- ((NOT (|SYMBOL;scripted?;$B;30| |sy| $))
+ ((NOT (CONSP |sy|))
(|error| "Cannot convert a symbol to a list if it is not subscripted"))
(T |sy|)))
diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp
index ab3ee05e..2ba68e32 100644
--- a/src/algebra/strap/URAGG-.lsp
+++ b/src/algebra/strap/URAGG-.lsp
@@ -212,13 +212,13 @@
(COND
((NOT (NOT (SPADCALL |x| (|getShellEntry| $ 20))))
(RETURN NIL))
- (T (SEQ (COND
- ((EQL |k| 1000)
- (COND
- ((SPADCALL |x| (|getShellEntry| $ 48))
- (EXIT (|error| "cyclic list"))))))
- (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 14)))
- (EXIT (SETQ |k| (+ |k| 1)))))))
+ (T (COND
+ ((AND (EQL |k| 1000)
+ (SPADCALL |x| (|getShellEntry| $ 48)))
+ (|error| "cyclic list"))
+ (T (SEQ (SETQ |x|
+ (SPADCALL |x| (|getShellEntry| $ 14)))
+ (EXIT (SETQ |k| (+ |k| 1)))))))))
(EXIT |k|))))
(DEFUN |URAGG-;tail;2A;16| (|x| $)
@@ -230,14 +230,13 @@
(COND
((NOT (NOT (SPADCALL |y| (|getShellEntry| $ 20))))
(RETURN NIL))
- (T (SEQ (COND
- ((EQL |k| 1000)
- (COND
- ((SPADCALL |x| (|getShellEntry| $ 48))
- (EXIT (|error| "cyclic list"))))))
- (EXIT (SETQ |y|
- (SPADCALL (SETQ |x| |y|)
- (|getShellEntry| $ 14)))))))
+ (T (COND
+ ((AND (EQL |k| 1000)
+ (SPADCALL |x| (|getShellEntry| $ 48)))
+ (|error| "cyclic list"))
+ (T (SETQ |y|
+ (SPADCALL (SETQ |x| |y|)
+ (|getShellEntry| $ 14)))))))
(SETQ |k| (+ |k| 1))))
(EXIT |x|))))))
@@ -375,27 +374,20 @@
((SPADCALL |x| (|getShellEntry| $ 20)) NIL)
(T (NOT (SPADCALL |y| (|getShellEntry| $ 20))))))
(RETURN NIL))
- (T (SEQ (COND
- ((EQL |k| 1000)
- (COND
- ((SPADCALL |x| (|getShellEntry| $ 48))
- (EXIT (|error| "cyclic list"))))))
- (EXIT (COND
- ((SPADCALL
- (SPADCALL |x|
- (|getShellEntry| $ 8))
- (SPADCALL |y|
- (|getShellEntry| $ 8))
- (|getShellEntry| $ 66))
- (RETURN-FROM |URAGG-;=;2AB;23| NIL))
- (T (SEQ
- (SETQ |x|
- (SPADCALL |x|
- (|getShellEntry| $ 14)))
- (EXIT
- (SETQ |y|
- (SPADCALL |y|
- (|getShellEntry| $ 14)))))))))))
+ (T (COND
+ ((AND (EQL |k| 1000)
+ (SPADCALL |x| (|getShellEntry| $ 48)))
+ (|error| "cyclic list"))
+ ((SPADCALL (SPADCALL |x| (|getShellEntry| $ 8))
+ (SPADCALL |y| (|getShellEntry| $ 8))
+ (|getShellEntry| $ 66))
+ (RETURN-FROM |URAGG-;=;2AB;23| NIL))
+ (T (SEQ (SETQ |x|
+ (SPADCALL |x|
+ (|getShellEntry| $ 14)))
+ (EXIT (SETQ |y|
+ (SPADCALL |y|
+ (|getShellEntry| $ 14)))))))))
(SETQ |k| (+ |k| 1))))
(EXIT (COND
((SPADCALL |x| (|getShellEntry| $ 20))
@@ -411,14 +403,10 @@
(T (COND
((SPADCALL |u| |v| (|getShellEntry| $ 68))
(RETURN-FROM |URAGG-;node?;2AB;24| T))
- (T (SEQ (COND
- ((EQL |k| 1000)
- (COND
- ((SPADCALL |v| (|getShellEntry| $ 48))
- (EXIT (|error| "cyclic list"))))))
- (EXIT (SETQ |v|
- (SPADCALL |v|
- (|getShellEntry| $ 14)))))))))
+ ((AND (EQL |k| 1000)
+ (SPADCALL |v| (|getShellEntry| $ 48)))
+ (|error| "cyclic list"))
+ (T (SETQ |v| (SPADCALL |v| (|getShellEntry| $ 14)))))))
(SETQ |k| (+ |k| 1))))
(EXIT (SPADCALL |u| |v| (|getShellEntry| $ 68)))))
diff --git a/src/algebra/strap/VECTOR.lsp b/src/algebra/strap/VECTOR.lsp
index 30234ee7..68d81c3d 100644
--- a/src/algebra/strap/VECTOR.lsp
+++ b/src/algebra/strap/VECTOR.lsp
@@ -43,7 +43,7 @@
(DEFUN |Vector;| (|#1|)
(DECLARE (SPECIAL |$ConstructorCache|))
(LET* ((|dv$1| (|devaluate| |#1|)) (|dv$| (LIST '|Vector| |dv$1|))
- ($ (|newShell| 36))
+ ($ (|newShell| 37))
(|pv$| (|buildPredVector| 0 0
(LIST (OR (AND (|HasCategory| |#1| '(|OrderedSet|))
(|HasCategory| |#1|
@@ -101,13 +101,13 @@
(LIST '#(NIL NIL NIL NIL NIL (|IndexedVector| 6 (NRTEVAL 1))
(|local| |#1|) (|Integer|) (0 . |One|) (|List| 6)
(4 . |construct|) |VECTOR;vector;L$;1|
- |VECTOR;maxIndex;$I;2| (|OutputForm|) (|InputForm|)
+ |VECTOR;maxIndex;$I;2| (|Symbol|) (|InputForm|)
(9 . |convert|) (14 . |parts|) (19 . |convert|) (|List| $)
(24 . |convert|) (29 . |convert|) (|Mapping| 6 6 6)
(|Boolean|) (|NonNegativeInteger|) (|Equation| 6)
(|List| 24) (|Mapping| 22 6) (|Mapping| 22 6 6)
(|UniversalSegment| 7) (|Void|) (|Mapping| 6 6)
- (|Matrix| 6) (|String|) (|SingleInteger|)
+ (|OutputForm|) (|Matrix| 6) (|String|) (|SingleInteger|)
(|Union| 6 '"failed") (|List| 7))
'#(|vector| 34 |parts| 39 |maxIndex| 44 |convert| 49
|construct| 54)
@@ -135,7 +135,7 @@
(|Eltable| 28 $$) (|Aggregate|)
(|Eltable| 7 6) (|Evalable| 6)
(|BasicType|) (|Type|)
- (|InnerEvalable| 6 6) (|CoercibleTo| 13)
+ (|InnerEvalable| 6 6) (|CoercibleTo| 31)
(|ConvertibleTo| 14))
(|makeByteWordVec2| 20
'(0 7 0 8 1 0 0 9 10 1 14 0 13 15 1 0 9
diff --git a/src/algebra/symbol.spad.pamphlet b/src/algebra/symbol.spad.pamphlet
index 28deb174..67539450 100644
--- a/src/algebra/symbol.spad.pamphlet
+++ b/src/algebra/symbol.spad.pamphlet
@@ -278,7 +278,7 @@ Symbol(): Exports == Implementation where
for k in keys xcount repeat remove!(k, xcount)
scripted? sy ==
- not ATOM(sy)$Lisp
+ %pair?(sy)$Foreign(Builtin)
name sy ==
not scripted? sy => sy
diff --git a/src/algebra/syntax.spad.pamphlet b/src/algebra/syntax.spad.pamphlet
index 0052d6b8..2ab38358 100644
--- a/src/algebra/syntax.spad.pamphlet
+++ b/src/algebra/syntax.spad.pamphlet
@@ -282,7 +282,7 @@ ElaboratedExpression(): Public == Private where
import %peq: (%,%) -> Boolean from Foreign Builtin
import %pair?: % -> Boolean from Foreign Builtin
isAtomic(x: %): Boolean ==
- ATOM(x)$Lisp
+ not %pair? x
type x ==
getMode(x)$Lisp
diff --git a/src/algebra/tex.spad.pamphlet b/src/algebra/tex.spad.pamphlet
index 342107d5..25af05ae 100644
--- a/src/algebra/tex.spad.pamphlet
+++ b/src/algebra/tex.spad.pamphlet
@@ -580,7 +580,7 @@ TexFormat(): public == private where
formatTex(expr,prec) ==
i,len : Integer
intSplitLen : Integer := 20
- ATOM(expr)$Lisp pretend Boolean =>
+ not %pair?(expr)$Foreign(Builtin) pretend Boolean =>
str := stringify expr
len := #str
%integer?(expr)$Foreign(Builtin) =>
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-30 15:03:10 +0000