From b06db52e69e3a7b7f4bd90ac129ea369be45284a Mon Sep 17 00:00:00 2001 From: dos-reis Date: Fri, 31 Dec 2010 15:20:08 +0000 Subject: * interp/g-opt.boot ($VMsideEffectFreeOperators): Include %cup and %cdown. * interp/g-util.boot: Expand them. * interp/vmlisp.lisp (QESET): Remove. * algebra/string.spad.pamphlet (String): Don't use QESET. --- src/algebra/strap/CHAR.lsp | 4 ++-- src/algebra/strap/ISTRING.lsp | 8 ++++---- src/algebra/string.spad.pamphlet | 21 +++++++++++---------- 3 files changed, 17 insertions(+), 16 deletions(-) (limited to 'src/algebra') diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp index a36914df..76abf4fe 100644 --- a/src/algebra/strap/CHAR.lsp +++ b/src/algebra/strap/CHAR.lsp @@ -135,12 +135,12 @@ (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Char|) |CHAR;upperCase;2$;32|)) -(PUT '|CHAR;upperCase;2$;32| '|SPADreplace| 'CHAR-UPCASE) +(PUT '|CHAR;upperCase;2$;32| '|SPADreplace| '|%cup|) (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Char|) |CHAR;lowerCase;2$;33|)) -(PUT '|CHAR;lowerCase;2$;33| '|SPADreplace| 'CHAR-DOWNCASE) +(PUT '|CHAR;lowerCase;2$;33| '|SPADreplace| '|%cdown|) (DEFUN |CHAR;=;2$B;1| (|a| |b| $) (DECLARE (IGNORE $)) diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp index 1b686d19..36f22984 100644 --- a/src/algebra/strap/ISTRING.lsp +++ b/src/algebra/strap/ISTRING.lsp @@ -214,21 +214,21 @@ (LOOP (COND ((> |i| #1#) (RETURN NIL)) - (T (SEQ (QESET |r| |k| (CHAR |s| |i|)) + (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 (QESET |r| |k| (CHAR |t| |i|)) + (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 (QESET |r| |k| (CHAR |s| |i|)) + (T (SEQ (SETF (CHAR |r| |k|) (CHAR |s| |i|)) (EXIT (SETQ |k| (+ |k| 1)))))) (SETQ |i| (+ |i| 1)))) (EXIT |r|)))))) @@ -238,7 +238,7 @@ ((OR (< |i| (|getShellEntry| $ 6)) (< (SPADCALL |s| (|getShellEntry| $ 47)) |i|)) (|error| "index out of range")) - (T (SEQ (QESET |s| (- |i| (|getShellEntry| $ 6)) |c|) + (T (SEQ (SETF (CHAR |s| (- |i| (|getShellEntry| $ 6))) |c|) (EXIT |c|)))))) (DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| $) diff --git a/src/algebra/string.spad.pamphlet b/src/algebra/string.spad.pamphlet index e25719f6..b336d9a6 100644 --- a/src/algebra/string.spad.pamphlet +++ b/src/algebra/string.spad.pamphlet @@ -94,6 +94,8 @@ Character: OrderedFinite() with import %cle: (%,%) -> Boolean from Foreign Builtin import %cgt: (%,%) -> Boolean from Foreign Builtin import %cge: (%,%) -> Boolean from Foreign Builtin + import %cup: % -> % from Foreign Builtin + import %cdown: % -> % from Foreign Builtin import %c2i: % -> NNI from Foreign Builtin import %i2c: NNI -> % from Foreign Builtin import %ccst: String -> % from Foreign Builtin @@ -136,10 +138,10 @@ Character: OrderedFinite() with %s2c s upperCase c == - CHAR_-UPCASE(c)$Lisp : % + %cup c lowerCase c == - CHAR_-DOWNCASE(c)$Lisp : % + %cdown c @ @@ -268,9 +270,9 @@ CharacterClass: Join(SetCategory, ConvertibleTo String, ++ Authors: Stephen Watt, Michael Monagan, Manuel Bronstein 1986 .. 1991 -- The following Lisp dependencies are divided into two groups -- Those that are required --- QESET MAKE-FULL-CVEC EQ QSLESSP QSGREATERP +-- MAKE-FULL-CVEC -- Those that can are included for efficiency only --- COPY SUBSTRING STRPOS RPLACSTR DOWNCASE UPCASE CGREATERP +-- SUBSTRING STRPOS RPLACSTR ++ Description: ++ This domain implements low-level strings @@ -283,8 +285,6 @@ IndexedString(mn:Integer): Export == Implementation where Export == StringAggregate() Implementation == add - -- These assume Character's Rep is Small I - Qsetelt ==> QESET$Lisp import %strlength: % -> N from Foreign Builtin import %streq: (%,%) -> Boolean from Foreign Builtin import %strlt: (%,%) -> Boolean from Foreign Builtin @@ -292,6 +292,7 @@ IndexedString(mn:Integer): Export == Implementation where import %schar: (%,I) -> Character from Foreign Builtin import %strconc: (%,%) -> % from Foreign Builtin import %strcopy: % -> % from Foreign Builtin + import %strstc: (%,Integer,Character) -> Void from Foreign Builtin import %hash : % -> SingleInteger from Foreign Builtin c: Character @@ -323,19 +324,19 @@ IndexedString(mn:Integer): Export == Implementation where r := new((m-(h-l+1)+n)::N, space$C) k: NonNegativeInteger := 0 for i in 0..l-1 repeat - Qsetelt(r, k, %schar(s, i)) + %strstc(r, k, %schar(s, i)) k := k + 1 for i in 0..n-1 repeat - Qsetelt(r, k, %schar(t, i)) + %strstc(r, k, %schar(t, i)) k := k + 1 for i in h+1..m-1 repeat - Qsetelt(r, k, %schar(s, i)) + %strstc(r, k, %schar(s, i)) k := k + 1 r setelt(s:%, i:I, c:C) == i < mn or i > maxIndex(s) => error "index out of range" - Qsetelt(s, i - mn, c) + %strstc(s, i - mn, c) c substring?(part, whole, startpos) == -- cgit v1.2.3