diff options
author | dos-reis <gdr@axiomatics.org> | 2010-12-29 17:51:01 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2010-12-29 17:51:01 +0000 |
commit | 25671a46921cd1e72d296ed5cbcdc72de78f569d (patch) | |
tree | 64b93ee7e988e1faf37bf34e6322da80d14c31ff /src/algebra/strap/ISTRING.lsp | |
parent | d6e1db9b19a58fd6298e3d37eb6ec25f34ff191a (diff) | |
download | open-axiom-25671a46921cd1e72d296ed5cbcdc72de78f569d.tar.gz |
* interp/g-opt.boot ($VMsideEffectFreeOperators): Include %strlength.
* interp/g-util.boot: Expand it.
* algebra/string.spad.pamphlet (String): Remove use of QCSIZE.
Diffstat (limited to 'src/algebra/strap/ISTRING.lsp')
-rw-r--r-- | src/algebra/strap/ISTRING.lsp | 23 |
1 files changed, 14 insertions, 9 deletions
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)) |