aboutsummaryrefslogtreecommitdiff
path: root/src/algebra
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2010-12-31 15:20:08 +0000
committerdos-reis <gdr@axiomatics.org>2010-12-31 15:20:08 +0000
commitb06db52e69e3a7b7f4bd90ac129ea369be45284a (patch)
tree84b61490c6ac337af1a9dba684725264d8bc6252 /src/algebra
parent76862a96d4ba24beffa94cfbfbb1c2c8dbd1dd26 (diff)
downloadopen-axiom-b06db52e69e3a7b7f4bd90ac129ea369be45284a.tar.gz
* 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.
Diffstat (limited to 'src/algebra')
-rw-r--r--src/algebra/strap/CHAR.lsp4
-rw-r--r--src/algebra/strap/ISTRING.lsp8
-rw-r--r--src/algebra/string.spad.pamphlet21
3 files changed, 17 insertions, 16 deletions
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) ==