diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/algebra/strap/CHAR.lsp | 14 | ||||
| -rw-r--r-- | src/algebra/string.spad.pamphlet | 27 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 2 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 9 |
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], |