aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/algebra/strap/CHAR.lsp14
-rw-r--r--src/algebra/string.spad.pamphlet27
-rw-r--r--src/interp/g-opt.boot2
-rw-r--r--src/interp/g-util.boot9
4 files changed, 32 insertions, 20 deletions
diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp
index 95bc03af..ad61a999 100644
--- a/src/algebra/strap/CHAR.lsp
+++ b/src/algebra/strap/CHAR.lsp
@@ -4,27 +4,27 @@
(DECLAIM (FTYPE (FUNCTION (|%Char| |%Char| |%Shell|) |%Boolean|)
|CHAR;=;2$B;1|))
-(PUT '|CHAR;=;2$B;1| '|SPADreplace| 'CHAR=)
+(PUT '|CHAR;=;2$B;1| '|SPADreplace| '|%ceq|)
(DECLAIM (FTYPE (FUNCTION (|%Char| |%Char| |%Shell|) |%Boolean|)
|CHAR;<;2$B;2|))
-(PUT '|CHAR;<;2$B;2| '|SPADreplace| 'CHAR<)
+(PUT '|CHAR;<;2$B;2| '|SPADreplace| '|%clt|)
(DECLAIM (FTYPE (FUNCTION (|%Char| |%Char| |%Shell|) |%Boolean|)
|CHAR;>;2$B;3|))
-(PUT '|CHAR;>;2$B;3| '|SPADreplace| 'CHAR>)
+(PUT '|CHAR;>;2$B;3| '|SPADreplace| '|%cgt|)
(DECLAIM (FTYPE (FUNCTION (|%Char| |%Char| |%Shell|) |%Boolean|)
|CHAR;<=;2$B;4|))
-(PUT '|CHAR;<=;2$B;4| '|SPADreplace| 'CHAR<=)
+(PUT '|CHAR;<=;2$B;4| '|SPADreplace| '|%cle|)
(DECLAIM (FTYPE (FUNCTION (|%Char| |%Char| |%Shell|) |%Boolean|)
|CHAR;>=;2$B;5|))
-(PUT '|CHAR;>=;2$B;5| '|SPADreplace| 'CHAR>=)
+(PUT '|CHAR;>=;2$B;5| '|SPADreplace| '|%cge|)
(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 0))
|CHAR;size;Nni;6|))
@@ -40,12 +40,12 @@
(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 0) |%Shell|) |%Char|)
|CHAR;char;Nni$;9|))
-(PUT '|CHAR;char;Nni$;9| '|SPADreplace| 'CODE-CHAR)
+(PUT '|CHAR;char;Nni$;9| '|SPADreplace| '|%i2c|)
(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) (|%IntegerSection| 0))
|CHAR;ord;$Nni;10|))
-(PUT '|CHAR;ord;$Nni;10| '|SPADreplace| 'CHAR-CODE)
+(PUT '|CHAR;ord;$Nni;10| '|SPADreplace| '|%c2i|)
(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;random;$;11|))
diff --git a/src/algebra/string.spad.pamphlet b/src/algebra/string.spad.pamphlet
index 6e1d39a9..ebec0fa2 100644
--- a/src/algebra/string.spad.pamphlet
+++ b/src/algebra/string.spad.pamphlet
@@ -75,21 +75,24 @@ Character: OrderedFinite() with
CC ==> CharacterClass()
NNI ==> NonNegativeInteger
import CC
-
- --cl: Record(dig:CC,hex:CC,upp:CC,low:CC,alpha:CC,alnum:CC) :=
- -- [ digit(), hexDigit(),
- -- upperCase(), lowerCase(), alphabetic(), alphanumeric() ]
-
- a = b == CHAR_=(a,b)$Lisp
- a < b == CHAR_<(a,b)$Lisp
- a > b == CHAR_>(a,b)$Lisp
- a <= b == CHAR_<_=(a,b)$Lisp
- a >= b == CHAR_>_=(a,b)$Lisp
+ import %ceq: (%,%) -> Boolean from Foreign Builtin
+ import %clt: (%,%) -> Boolean from Foreign Builtin
+ import %cle: (%,%) -> Boolean from Foreign Builtin
+ import %cgt: (%,%) -> Boolean from Foreign Builtin
+ import %cge: (%,%) -> Boolean from Foreign Builtin
+ import %c2i: % -> NNI from Foreign Builtin
+ import %i2c: NNI -> % from Foreign Builtin
+
+ a = b == %ceq(a,b)
+ a < b == %clt(a,b)
+ a > b == %cgt(a,b)
+ a <= b == %cle(a,b)
+ a >= b == %cge(a,b)
size() == 256
index n == char((n - 1)::NNI)
lookup c == (1 + ord c)::PositiveInteger
- char(n: NNI) == CODE_-CHAR(n)$Lisp
- ord c == CHAR_-CODE(c)$Lisp
+ char(n: NNI) == %i2c n
+ ord c == %c2i c
random() == char(random(size())$NNI)
space == CHAR(" ", 0$Lisp)$Lisp
quote == CHAR("_" ", 0$Lisp)$Lisp
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 4d8387f0..eccf8e73 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -407,7 +407,7 @@ $VMsideEffectFreeOperators ==
%imul %iadd %isub %igcd %ilcm %ipow %imin %imax %ieven? %iodd? %iinc
%feq %flt %fle %fgt %fge %fmul %fadd %fsub %fexp %fmin %fmax %float?
%fpow %nil %pair? %lconcat %llength %lfirst %lsecond %lthird
- %hash %ismall? %string?)
+ %hash %ismall? %string? %ceq %clt %cle %cgt %cge %c2i %i2c)
++ List of simple VM operators
$simpleVMoperators ==
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 9fa9777d..a3674a01 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -249,6 +249,15 @@ for x in [
['%and, :'AND],
['%or, :'OR],
+ -- character binary operations
+ ['%ceq, :'CHAR_=],
+ ['%clt, :'CHAR_<],
+ ['%cle, :'CHAR_<_=],
+ ['%cgt, :'CHAR_>],
+ ['%cge, :'CHAR_>_=],
+ ['%c2i, :'CHAR_-CODE],
+ ['%i2c, :'CODE_-CHAR],
+
-- unary integer operations.
['%iabs, :'ABS],
['%ieven?, :'EVENP],