From 25671a46921cd1e72d296ed5cbcdc72de78f569d Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Wed, 29 Dec 2010 17:51:01 +0000
Subject: 	* interp/g-opt.boot ($VMsideEffectFreeOperators): Include
 %strlength. 	* interp/g-util.boot: Expand it. 	*
 algebra/string.spad.pamphlet (String): Remove use of QCSIZE.

---
 src/algebra/strap/ISTRING.lsp | 23 ++++++++++++++---------
 src/algebra/strap/OUTFORM.lsp |  4 +---
 src/algebra/strap/SYMBOL.lsp  | 12 ++++++------
 3 files changed, 21 insertions(+), 18 deletions(-)

(limited to 'src/algebra/strap')

diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index 4b5f1be6..b6f386f0 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -12,10 +12,13 @@
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
                 |ISTRING;empty?;$B;3|)) 
 
+(PUT '|ISTRING;empty?;$B;3| '|SPADreplace|
+     '(XLAM (|s|) (|%ieq| (|%strlength| |s|) 0))) 
+
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0))
                 |ISTRING;#;$Nni;4|)) 
 
-(PUT '|ISTRING;#;$Nni;4| '|SPADreplace| 'QCSIZE) 
+(PUT '|ISTRING;#;$Nni;4| '|SPADreplace| '|%strlength|) 
 
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
                 |ISTRING;=;2$B;5|)) 
@@ -134,9 +137,11 @@
 
 (DEFUN |ISTRING;empty;$;2| ($) (MAKE-FULL-CVEC 0)) 
 
-(DEFUN |ISTRING;empty?;$B;3| (|s| $) (ZEROP (QCSIZE |s|))) 
+(DEFUN |ISTRING;empty?;$B;3| (|s| $)
+  (DECLARE (IGNORE $))
+  (ZEROP (LENGTH |s|))) 
 
-(DEFUN |ISTRING;#;$Nni;4| (|s| $) (DECLARE (IGNORE $)) (QCSIZE |s|)) 
+(DEFUN |ISTRING;#;$Nni;4| (|s| $) (DECLARE (IGNORE $)) (LENGTH |s|)) 
 
 (DEFUN |ISTRING;=;2$B;5| (|s| |t| $)
   (DECLARE (IGNORE $))
@@ -234,7 +239,7 @@
                  (EXIT |c|)))))) 
 
 (DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| $)
-  (LET ((|np| (QCSIZE |part|)) (|nw| (QCSIZE |whole|)))
+  (LET ((|np| (LENGTH |part|)) (|nw| (LENGTH |whole|)))
     (SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6)))
          (EXIT (COND
                  ((MINUSP |startpos|) (|error| "index out of bounds"))
@@ -262,7 +267,7 @@
            (EXIT (COND
                    ((MINUSP |startpos|)
                     (|error| "index out of bounds"))
-                   ((NOT (< |startpos| (QCSIZE |t|)))
+                   ((NOT (< |startpos| (LENGTH |t|)))
                     (- (|getShellEntry| $ 6) 1))
                    (T (SEQ (LETT |r| (STRPOS |s| |t| |startpos| NIL)
                                  |ISTRING;position;2$2I;18|)
@@ -275,10 +280,10 @@
   (SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6)))
        (EXIT (COND
                ((MINUSP |startpos|) (|error| "index out of bounds"))
-               ((NOT (< |startpos| (QCSIZE |t|)))
+               ((NOT (< |startpos| (LENGTH |t|)))
                 (- (|getShellEntry| $ 6) 1))
                (T (SEQ (LET ((|r| |startpos|)
-                             (#0=#:G1514 (- (QCSIZE |t|) 1)))
+                             (#0=#:G1514 (- (LENGTH |t|) 1)))
                          (LOOP
                            (COND
                              ((> |r| #0#) (RETURN NIL))
@@ -294,10 +299,10 @@
   (SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6)))
        (EXIT (COND
                ((MINUSP |startpos|) (|error| "index out of bounds"))
-               ((NOT (< |startpos| (QCSIZE |t|)))
+               ((NOT (< |startpos| (LENGTH |t|)))
                 (- (|getShellEntry| $ 6) 1))
                (T (SEQ (LET ((|r| |startpos|)
-                             (#0=#:G1515 (- (QCSIZE |t|) 1)))
+                             (#0=#:G1515 (- (LENGTH |t|) 1)))
                          (LOOP
                            (COND
                              ((> |r| #0#) (RETURN NIL))
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index dcbbd6a0..2f459f95 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -542,9 +542,7 @@
   (|mathprint| |x|)) 
 
 (DEFUN |OUTFORM;message;S$;7| (|s| $)
-  (COND
-    ((SPADCALL |s| (|getShellEntry| $ 12)) (|OUTFORM;empty;$;73| $))
-    (T |s|))) 
+  (COND ((ZEROP (LENGTH |s|)) (|OUTFORM;empty;$;73| $)) (T |s|))) 
 
 (DEFUN |OUTFORM;messagePrint;SV;8| (|s| $)
   (|mathprint| (|OUTFORM;message;S$;7| |s| $))) 
diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp
index 45a9c215..1ab934bc 100644
--- a/src/algebra/strap/SYMBOL.lsp
+++ b/src/algebra/strap/SYMBOL.lsp
@@ -278,7 +278,7 @@
     (RETURN
       (LET ((|s| (PNAME (SPADCALL |e| (|getShellEntry| $ 100)))))
         (SEQ (COND
-               ((< 1 (QCSIZE |s|))
+               ((< 1 (LENGTH |s|))
                 (COND
                   ((SPADCALL (SPADCALL |s| 1 (|getShellEntry| $ 106))
                        (SPADCALL "\\" (|getShellEntry| $ 43))
@@ -390,7 +390,7 @@
             (NIL (RETURN NIL))
             (T (SEQ (LETT |qr|
                           (MULTIPLE-VALUE-CALL #'CONS
-                              (TRUNCATE |n| (QCSIZE |s|)))
+                              (TRUNCATE |n| (LENGTH |s|)))
                           |SYMBOL;anyRadix|)
                     (SETQ |n| (CAR |qr|))
                     (SETQ |ns|
@@ -489,7 +489,7 @@
                                $)
                            |SYMBOL;name;2$;31|)
                      (LET ((|i| (+ (|getShellEntry| $ 41) 1))
-                           (#0=#:G1526 (QCSIZE |str|)))
+                           (#0=#:G1526 (LENGTH |str|)))
                        (LOOP
                          (COND
                            ((> |i| #0#) (RETURN NIL))
@@ -501,7 +501,7 @@
                                  (RETURN-FROM |SYMBOL;name;2$;31|
                                    (|SYMBOL;coerce;S$;8|
                                     (SPADCALL |str|
-                                     (SPADCALL |i| (QCSIZE |str|)
+                                     (SPADCALL |i| (LENGTH |str|)
                                       (|getShellEntry| $ 141))
                                      (|getShellEntry| $ 142))
                                     $))))))
@@ -524,7 +524,7 @@
                                    (|getShellEntry| $ 137))
                                $)
                            |SYMBOL;scripts;$R;32|)
-                     (LETT |nstr| (QCSIZE |str|)
+                     (LETT |nstr| (LENGTH |str|)
                            |SYMBOL;scripts;$R;32|)
                      (LETT |m|
                            (SPADCALL |nscripts|
@@ -652,7 +652,7 @@
     (|setShellEntry| $ 20 "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
     (|setShellEntry| $ 21 "abcdefghijklmnopqrstuvwxyz")
     (|setShellEntry| $ 38 "*")
-    (|setShellEntry| $ 41 (QCSIZE (|getShellEntry| $ 38)))
+    (|setShellEntry| $ 41 (LENGTH (|getShellEntry| $ 38)))
     (|setShellEntry| $ 45
         (SPADCALL (SPADCALL "0" (|getShellEntry| $ 43))
             (|getShellEntry| $ 44)))
-- 
cgit v1.2.3