aboutsummaryrefslogtreecommitdiff
path: root/src/algebra
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2010-12-31 09:08:44 +0000
committerdos-reis <gdr@axiomatics.org>2010-12-31 09:08:44 +0000
commit76862a96d4ba24beffa94cfbfbb1c2c8dbd1dd26 (patch)
tree4e200ace4c0bffe0e95e118acbd2bbdab71bd5f6 /src/algebra
parentb1fb4cb58a886484e213bd1235f6de75713950c9 (diff)
downloadopen-axiom-76862a96d4ba24beffa94cfbfbb1c2c8dbd1dd26.tar.gz
* interp/g-opt.boot ($VMsideEffectFreeOperators): Include new
builtin functions %strlt, %streq, %strcopy, and %strconc. * interp/g-util.boot: Expand them. * algebra/string.spad.pamphlet (String): Remove uses of Lisp-level functions CHAR, EQUAL, CHAR=, ans SXHASH.
Diffstat (limited to 'src/algebra')
-rw-r--r--src/algebra/strap/CHAR.lsp6
-rw-r--r--src/algebra/strap/ISTRING.lsp22
-rw-r--r--src/algebra/string.spad.pamphlet36
3 files changed, 39 insertions, 25 deletions
diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp
index bfbc88e1..a36914df 100644
--- a/src/algebra/strap/CHAR.lsp
+++ b/src/algebra/strap/CHAR.lsp
@@ -122,6 +122,11 @@
(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%String|)
|CHAR;latex;$S;30|))
+(PUT '|CHAR;latex;$S;30| '|SPADreplace|
+ '(XLAM (|c|)
+ (|%strconc| "\\mbox{`"
+ (|%strconc| (MAKE-FULL-CVEC 1 |c|) "'}"))))
+
(DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%Char|)
|CHAR;char;S$;31|))
@@ -227,6 +232,7 @@
(SPADCALL |c| (|spadConstant| $ 52) (|getShellEntry| $ 42)))
(DEFUN |CHAR;latex;$S;30| (|c| $)
+ (DECLARE (IGNORE $))
(STRCONC "\\mbox{`" (STRCONC (MAKE-FULL-CVEC 1 |c|) "'}")))
(DEFUN |CHAR;char;S$;31| (|s| $)
diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index 60503702..1b686d19 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -23,23 +23,22 @@
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
|ISTRING;=;2$B;5|))
-(PUT '|ISTRING;=;2$B;5| '|SPADreplace| 'EQUAL)
+(PUT '|ISTRING;=;2$B;5| '|SPADreplace| '|%streq|)
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
|ISTRING;<;2$B;6|))
-(PUT '|ISTRING;<;2$B;6| '|SPADreplace|
- '(XLAM (|s| |t|) (CGREATERP |t| |s|)))
+(PUT '|ISTRING;<;2$B;6| '|SPADreplace| '|%strlt|)
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|ISTRING;concat;3$;7|))
-(PUT '|ISTRING;concat;3$;7| '|SPADreplace| 'STRCONC)
+(PUT '|ISTRING;concat;3$;7| '|SPADreplace| '|%strconc|)
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
|ISTRING;copy;2$;8|))
-(PUT '|ISTRING;copy;2$;8| '|SPADreplace| 'COPY-SEQ)
+(PUT '|ISTRING;copy;2$;8| '|SPADreplace| '|%strcopy|)
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|)
|%Thing|)
@@ -60,6 +59,9 @@
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%String|)
|ISTRING;latex;$S;14|))
+(PUT '|ISTRING;latex;$S;14| '|SPADreplace|
+ '(XLAM (|s|) (|%strconc| "\\mbox{``" (|%strconc| |s| "''}"))))
+
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
|%Thing|)
|ISTRING;replace;$Us2$;15|))
@@ -121,7 +123,7 @@
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Short|)
|ISTRING;hash;$Si;32|))
-(PUT '|ISTRING;hash;$Si;32| '|SPADreplace| 'SXHASH)
+(PUT '|ISTRING;hash;$Si;32| '|SPADreplace| '|%hash|)
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Char| |%Shell|)
(|%IntegerSection| 0))
@@ -145,11 +147,11 @@
(DEFUN |ISTRING;=;2$B;5| (|s| |t| $)
(DECLARE (IGNORE $))
- (EQUAL |s| |t|))
+ (NOT (NULL (STRING= |s| |t|))))
(DEFUN |ISTRING;<;2$B;6| (|s| |t| $)
(DECLARE (IGNORE $))
- (CGREATERP |t| |s|))
+ (NOT (NULL (STRING< |s| |t|))))
(DEFUN |ISTRING;concat;3$;7| (|s| |t| $)
(DECLARE (IGNORE $))
@@ -180,6 +182,7 @@
(SPADCALL (ELT $ 40) |s| (|getShellEntry| $ 37)))
(DEFUN |ISTRING;latex;$S;14| (|s| $)
+ (DECLARE (IGNORE $))
(STRCONC "\\mbox{``" (STRCONC |s| "''}")))
(DEFUN |ISTRING;replace;$Us2$;15| (|s| |sg| |t| $)
@@ -572,7 +575,8 @@
'(|NonNegativeInteger|) #0#))
|ISTRING;match?;2$CB;34|)
(EXIT (COND
- ((EQL |p| (- |m| 1)) (EQUAL |pattern| |target|))
+ ((EQL |p| (- |m| 1))
+ (NOT (NULL (STRING= |pattern| |target|))))
(T (SEQ (COND
((SPADCALL |p| |m|
(|getShellEntry| $ 87))
diff --git a/src/algebra/string.spad.pamphlet b/src/algebra/string.spad.pamphlet
index 4c8ce1c5..e25719f6 100644
--- a/src/algebra/string.spad.pamphlet
+++ b/src/algebra/string.spad.pamphlet
@@ -270,7 +270,7 @@ CharacterClass: Join(SetCategory, ConvertibleTo String,
-- Those that are required
-- QESET MAKE-FULL-CVEC EQ QSLESSP QSGREATERP
-- Those that can are included for efficiency only
--- COPY STRCONC SUBSTRING STRPOS RPLACSTR DOWNCASE UPCASE CGREATERP
+-- COPY SUBSTRING STRPOS RPLACSTR DOWNCASE UPCASE CGREATERP
++ Description:
++ This domain implements low-level strings
@@ -284,11 +284,15 @@ IndexedString(mn:Integer): Export == Implementation where
Export == StringAggregate()
Implementation == add
-- These assume Character's Rep is Small I
- Qelt ==> CHAR$Lisp
- Qequal ==> EQUAL$Lisp
Qsetelt ==> QESET$Lisp
- Cheq ==> CHAR_=$Lisp
import %strlength: % -> N from Foreign Builtin
+ import %streq: (%,%) -> Boolean from Foreign Builtin
+ import %strlt: (%,%) -> Boolean from Foreign Builtin
+ import %ceq: (Character, Character) -> Boolean from Foreign Builtin
+ import %schar: (%,I) -> Character from Foreign Builtin
+ import %strconc: (%,%) -> % from Foreign Builtin
+ import %strcopy: % -> % from Foreign Builtin
+ import %hash : % -> SingleInteger from Foreign Builtin
c: Character
cc: CharacterClass
@@ -298,10 +302,10 @@ IndexedString(mn:Integer): Export == Implementation where
empty() == MAKE_-FULL_-CVEC(0@I)$Lisp
empty?(s) == %strlength s = 0
#s == %strlength s
- s = t == Qequal(s, t)
- s < t == CGREATERP(t,s)$Lisp
- concat(s:%,t:%) == STRCONC(s,t)$Lisp
- copy s == COPY_-SEQ(s)$Lisp
+ s = t == %streq(s,t)
+ s < t == %strlt(s,t)
+ concat(s:%,t:%) == %strconc(s,t)
+ copy s == %strcopy s
insert(s:%, t:%, i:I) == concat(concat(s(mn..i-1), t), s(i..))
coerce(s:%):OutputForm == outputForm(s pretend String)
minIndex s == mn
@@ -319,13 +323,13 @@ 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, Qelt(s, i))
+ Qsetelt(r, k, %schar(s, i))
k := k + 1
for i in 0..n-1 repeat
- Qsetelt(r, k, Qelt(t, i))
+ Qsetelt(r, k, %schar(t, i))
k := k + 1
for i in h+1..m-1 repeat
- Qsetelt(r, k, Qelt(s, i))
+ Qsetelt(r, k, %schar(s, i))
k := k + 1
r
@@ -340,7 +344,7 @@ IndexedString(mn:Integer): Export == Implementation where
(startpos := startpos - mn) < 0 => error "index out of bounds"
np > nw - startpos => false
for ip in 0..np-1 for iw in startpos.. repeat
- not Cheq(Qelt(part, ip), Qelt(whole, iw)) => return false
+ not %ceq(%schar(part, ip), %schar(whole, iw)) => return false
true
position(s:%, t:%, startpos:I) ==
@@ -353,13 +357,13 @@ IndexedString(mn:Integer): Export == Implementation where
(startpos := startpos - mn) < 0 => error "index out of bounds"
startpos >= %strlength t => mn - 1
for r in startpos..%strlength t - 1 repeat
- if Cheq(Qelt(t, r), c) then return r + mn
+ if %ceq(%schar(t, r), c) then return r + mn
mn - 1
position(cc: CharacterClass, t: %, startpos: I) ==
(startpos := startpos - mn) < 0 => error "index out of bounds"
startpos >= %strlength t => mn - 1
for r in startpos..%strlength t - 1 repeat
- if member?(Qelt(t,r), cc) then return r + mn
+ if member?(%schar(t,r), cc) then return r + mn
mn - 1
suffix?(s, t) ==
@@ -432,7 +436,7 @@ IndexedString(mn:Integer): Export == Implementation where
elt(s:%, i:I) ==
i < mn or i > maxIndex(s) => error "index out of range"
- Qelt(s, i - mn)
+ %schar(s, i - mn)
elt(s:%, sg:U) ==
l := lo(sg) - mn
@@ -441,7 +445,7 @@ IndexedString(mn:Integer): Export == Implementation where
SUBSTRING(s, l, max(0, h-l+1))$Lisp
hash s ==
- SXHASH(s)$Foreign(Builtin)
+ %hash s
match(pattern,target,wildcard) == stringMatch(pattern,target,CHARACTER(wildcard)$Lisp)$Lisp
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-30 14:46:56 +0000