aboutsummaryrefslogtreecommitdiff
path: root/src/algebra/strap
diff options
context:
space:
mode:
Diffstat (limited to 'src/algebra/strap')
-rw-r--r--src/algebra/strap/ILIST.lsp21
-rw-r--r--src/algebra/strap/ISTRING.lsp18
-rw-r--r--src/algebra/strap/LIST.lsp6
-rw-r--r--src/algebra/strap/OUTFORM.lsp6
-rw-r--r--src/algebra/strap/SYMBOL.lsp19
5 files changed, 31 insertions, 39 deletions
diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp
index 872490b2..addea91c 100644
--- a/src/algebra/strap/ILIST.lsp
+++ b/src/algebra/strap/ILIST.lsp
@@ -151,26 +151,22 @@
(DEFUN |ILIST;setfirst!;$2S;10| (|x| |s| $)
(COND
- ((SPADCALL |x| (|getShellEntry| $ 17))
- (|error| "Cannot update an empty list"))
+ ((NULL |x|) (|error| "Cannot update an empty list"))
('T (QCAR (RPLACA |x| |s|)))))
(DEFUN |ILIST;setelt;$first2S;11| (|x| T2 |s| $)
(COND
- ((SPADCALL |x| (|getShellEntry| $ 17))
- (|error| "Cannot update an empty list"))
+ ((NULL |x|) (|error| "Cannot update an empty list"))
('T (QCAR (RPLACA |x| |s|)))))
(DEFUN |ILIST;setrest!;3$;12| (|x| |y| $)
(COND
- ((SPADCALL |x| (|getShellEntry| $ 17))
- (|error| "Cannot update an empty list"))
+ ((NULL |x|) (|error| "Cannot update an empty list"))
('T (QCDR (RPLACD |x| |y|)))))
(DEFUN |ILIST;setelt;$rest2$;13| (|x| T3 |y| $)
(COND
- ((SPADCALL |x| (|getShellEntry| $ 17))
- (|error| "Cannot update an empty list"))
+ ((NULL |x|) (|error| "Cannot update an empty list"))
('T (QCDR (RPLACD |x| |y|)))))
(DEFUN |ILIST;construct;L$;14| (|l| $) (DECLARE (IGNORE $)) |l|)
@@ -235,8 +231,7 @@
NIL (GO G190) G191 (EXIT NIL))
(LETT |y| (NREVERSE |y|) |ILIST;coerce;$Of;21|)
(EXIT (COND
- ((SPADCALL |s| (|getShellEntry| $ 17))
- (SPADCALL |y| (|getShellEntry| $ 40)))
+ ((NULL |s|) (SPADCALL |y| (|getShellEntry| $ 40)))
('T
(SEQ (LETT |z|
(SPADCALL
@@ -475,10 +470,8 @@
(SEQ (COND
((EQL |n| 2)
(COND
- ((SPADCALL
- (SPADCALL (SPADCALL |p| (|getShellEntry| $ 18))
- (|getShellEntry| $ 13))
- (SPADCALL |p| (|getShellEntry| $ 13)) |f|)
+ ((SPADCALL (|SPADfirst| (CDR |p|)) (|SPADfirst| |p|)
+ |f|)
(LETT |p| (NREVERSE |p|) |ILIST;mergeSort|)))))
(EXIT (COND
((< |n| 3) |p|)
diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index d3c63504..d9dea6b1 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -702,8 +702,7 @@
(|getShellEntry| $ 6))))
|ISTRING;elt;$Us$;31|)
(COND
- ((OR (< |l| 0)
- (NULL (< |h| (SPADCALL |s| (|getShellEntry| $ 13)))))
+ ((OR (< |l| 0) (NULL (< |h| (QCSIZE |s|))))
(EXIT (|error| "index out of bound"))))
(EXIT (SUBSTRING |s| |l| (MAX 0 (+ (- |h| |l|) 1))))))))
@@ -768,10 +767,11 @@
(COND
((NULL
(SPADCALL
- (SPADCALL |pattern|
+ (|ISTRING;elt;$Us$;31|
+ |pattern|
(SPADCALL |m| (- |p| 1)
(|getShellEntry| $ 20))
- (|getShellEntry| $ 21))
+ $)
|target|
(|getShellEntry| $ 72)))
(EXIT 'NIL)))))
@@ -842,13 +842,13 @@
(|getShellEntry| $ 71))
(COND
((NULL
- (SPADCALL
- (SPADCALL |pattern|
+ (|ISTRING;suffix?;2$B;21|
+ (|ISTRING;elt;$Us$;31|
+ |pattern|
(SPADCALL (+ |p| 1) |n|
(|getShellEntry| $ 20))
- (|getShellEntry| $ 21))
- |target|
- (|getShellEntry| $ 51)))
+ $)
+ |target| $))
(EXIT 'NIL)))))
(EXIT 'T)))))))
#3# (EXIT #3#)))))
diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp
index c97fecf3..43656399 100644
--- a/src/algebra/strap/LIST.lsp
+++ b/src/algebra/strap/LIST.lsp
@@ -164,7 +164,7 @@
(EXIT |lu|)))))
(DEFUN |LIST;convert;$If;13| (|x| $)
- (PROG (#0=#:G1447 |a| #1=#:G1448)
+ (PROG (#0=#:G1442 |a| #1=#:G1443)
(RETURN
(SEQ (SPADCALL
(CONS (SPADCALL
@@ -191,10 +191,10 @@
(GO G190) G191 (EXIT (NREVERSE0 #0#)))))
(|getShellEntry| $ 44))))))
-(DEFUN |List| (#0=#:G1449)
+(DEFUN |List| (#0=#:G1444)
(PROG ()
(RETURN
- (PROG (#1=#:G1450)
+ (PROG (#1=#:G1445)
(RETURN
(COND
((LETT #1#
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index d89865c0..027e0a17 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -668,7 +668,7 @@
(DEFUN |OUTFORM;prefix;$L$;76| (|a| |l| $)
(COND
- ((NULL (SPADCALL |a| (|getShellEntry| $ 98))) (CONS |a| |l|))
+ ((NULL (|OUTFORM;infix?;$B;74| |a| $)) (CONS |a| |l|))
('T
(|OUTFORM;hconcat;3$;48| |a|
(|OUTFORM;paren;2$;40| (|OUTFORM;commaSeparate;L$;33| |l| $)
@@ -681,7 +681,7 @@
((SPADCALL (SPADCALL |l| (|getShellEntry| $ 69))
(|getShellEntry| $ 68))
(SPADCALL |l| (|getShellEntry| $ 70)))
- ((SPADCALL |a| (|getShellEntry| $ 98)) (CONS |a| |l|))
+ ((|OUTFORM;infix?;$B;74| |a| $) (CONS |a| |l|))
('T
(|OUTFORM;hconcat;L$;49|
(LIST (SPADCALL |l| (|getShellEntry| $ 70)) |a|
@@ -691,7 +691,7 @@
(DEFUN |OUTFORM;infix;4$;78| (|a| |b| |c| $)
(COND
- ((SPADCALL |a| (|getShellEntry| $ 98))
+ ((|OUTFORM;infix?;$B;74| |a| $)
(|OUTFORM;bless| (LIST |a| |b| |c|) $))
('T (|OUTFORM;hconcat;L$;49| (LIST |b| |a| |c|) $))))
diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp
index cbbd5a3b..8c1044f6 100644
--- a/src/algebra/strap/SYMBOL.lsp
+++ b/src/algebra/strap/SYMBOL.lsp
@@ -115,7 +115,7 @@
(DEFUN |SYMBOL;writeOMSym| (|dev| |x| $)
(COND
- ((SPADCALL |x| (|getShellEntry| $ 22))
+ ((|SYMBOL;scripted?;$B;30| |x| $)
(|error| "Cannot convert a scripted symbol to OpenMath"))
('T (SPADCALL |dev| |x| (|getShellEntry| $ 26)))))
@@ -293,7 +293,7 @@
(DEFUN |SYMBOL;script;$R$;23| (|sy| |sc| $)
(COND
- ((SPADCALL |sy| (|getShellEntry| $ 22))
+ ((|SYMBOL;scripted?;$B;30| |sy| $)
(|error| "Cannot add scripts to a scripted symbol"))
('T
(CONS (|SYMBOL;coerce;$Of;11|
@@ -307,7 +307,7 @@
(DEFUN |SYMBOL;string;$S;24| (|e| $)
(COND
- ((NULL (SPADCALL |e| (|getShellEntry| $ 22))) (PNAME |e|))
+ ((NULL (|SYMBOL;scripted?;$B;30| |e| $)) (PNAME |e|))
('T (|error| "Cannot form string from non-atomic symbols."))))
(DEFUN |SYMBOL;latex;$S;25| (|e| $)
@@ -323,8 +323,7 @@
(|getShellEntry| $ 86))
(LETT |s| (STRCONC "\\mbox{\\it " (STRCONC |s| "}"))
|SYMBOL;latex;$S;25|)))))
- (COND
- ((NULL (SPADCALL |e| (|getShellEntry| $ 22))) (EXIT |s|)))
+ (COND ((NULL (|SYMBOL;scripted?;$B;30| |e| $)) (EXIT |s|)))
(LETT |ss| (|SYMBOL;scripts;$R;32| |e| $)
|SYMBOL;latex;$S;25|)
(LETT |lo| (QVELT |ss| 0) |SYMBOL;latex;$S;25|)
@@ -511,7 +510,7 @@
(|getShellEntry| $ 98))
(LETT |xx|
(COND
- ((NULL (SPADCALL |x| (|getShellEntry| $ 22)))
+ ((NULL (|SYMBOL;scripted?;$B;30| |x| $))
(|SYMBOL;string;$S;24| |x| $))
('T
(|SYMBOL;string;$S;24| (|SYMBOL;name;2$;31| |x| $)
@@ -538,7 +537,7 @@
(|getShellEntry| $ 18) $))))
|SYMBOL;new;2$;28|)
(COND
- ((NULL (SPADCALL |x| (|getShellEntry| $ 22)))
+ ((NULL (|SYMBOL;scripted?;$B;30| |x| $))
(EXIT (|SYMBOL;coerce;S$;8| |xx| $))))
(EXIT (|SYMBOL;script;$R$;23| (|SYMBOL;coerce;S$;8| |xx| $)
(|SYMBOL;scripts;$R;32| |x| $) $))))))
@@ -572,7 +571,7 @@
(PROG (|str| |i| #0=#:G1551 #1=#:G1531 #2=#:G1529)
(RETURN
(SEQ (EXIT (COND
- ((NULL (SPADCALL |sy| (|getShellEntry| $ 22))) |sy|)
+ ((NULL (|SYMBOL;scripted?;$B;30| |sy| $)) |sy|)
('T
(SEQ (LETT |str|
(|SYMBOL;string;$S;24|
@@ -626,7 +625,7 @@
#1=#:G1552 |i| #2=#:G1553 |a| #3=#:G1554 |allscripts|)
(RETURN
(SEQ (COND
- ((NULL (SPADCALL |sy| (|getShellEntry| $ 22)))
+ ((NULL (|SYMBOL;scripted?;$B;30| |sy| $))
(VECTOR NIL NIL NIL NIL NIL))
('T
(SEQ (LETT |nscripts| (LIST 0 0 0 0 0)
@@ -764,7 +763,7 @@
(DEFUN |SYMBOL;list;$L;34| (|sy| $)
(COND
- ((NULL (SPADCALL |sy| (|getShellEntry| $ 22)))
+ ((NULL (|SYMBOL;scripted?;$B;30| |sy| $))
(|error| "Cannot convert a symbol to a list if it is not subscripted"))
('T |sy|)))
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-04 02:24:10 +0000