diff options
author | dos-reis <gdr@axiomatics.org> | 2009-06-01 06:10:07 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2009-06-01 06:10:07 +0000 |
commit | 78dd44d657fa65a8029d996aaf7ac05d2133f509 (patch) | |
tree | d5e4072febd7a48afbc1d2c48c2be4f4a3539638 /src/algebra/strap/CHAR.lsp | |
parent | 803d7a62fb91bb4083a0aaaaa20749574292e967 (diff) | |
download | open-axiom-78dd44d657fa65a8029d996aaf7ac05d2133f509.tar.gz |
* interp/compiler.boot (compGreaterThan): New. Compile
greater-than expressions.
* interp/parse.boot (parseGreaterThan): Remove.
* algebra/data.spad.pamphlet (Byte): Implement all comparison
functions.
* algebra/integer.spad.pamphlet (Integer): Likewise.
* algebra/sf.spad.pamphlet (DoubleFloat): Likewise.
* algebra/si.spad.pamphlet (SingleInteger): Likewise.
* algebra/string.spad.pamphlet (Character): Likewise.
Diffstat (limited to 'src/algebra/strap/CHAR.lsp')
-rw-r--r-- | src/algebra/strap/CHAR.lsp | 222 |
1 files changed, 126 insertions, 96 deletions
diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp index 6e24716c..7bd2bfbe 100644 --- a/src/algebra/strap/CHAR.lsp +++ b/src/algebra/strap/CHAR.lsp @@ -11,79 +11,94 @@ (PUT '|CHAR;<;2$B;2| '|SPADreplace| 'CHAR<) +(DECLAIM (FTYPE (FUNCTION (|%Char| |%Char| |%Shell|) |%Boolean|) + |CHAR;>;2$B;3|)) + +(PUT '|CHAR;>;2$B;3| '|SPADreplace| 'CHAR>) + +(DECLAIM (FTYPE (FUNCTION (|%Char| |%Char| |%Shell|) |%Boolean|) + |CHAR;<=;2$B;4|)) + +(PUT '|CHAR;<=;2$B;4| '|SPADreplace| 'CHAR<=) + +(DECLAIM (FTYPE (FUNCTION (|%Char| |%Char| |%Shell|) |%Boolean|) + |CHAR;>=;2$B;5|)) + +(PUT '|CHAR;>=;2$B;5| '|SPADreplace| 'CHAR>=) + (DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 0)) - |CHAR;size;Nni;3|)) + |CHAR;size;Nni;6|)) -(PUT '|CHAR;size;Nni;3| '|SPADreplace| '(XLAM NIL 256)) +(PUT '|CHAR;size;Nni;6| '|SPADreplace| '(XLAM NIL 256)) (DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 1) |%Shell|) |%Char|) - |CHAR;index;Pi$;4|)) + |CHAR;index;Pi$;7|)) (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) (|%IntegerSection| 1)) - |CHAR;lookup;$Pi;5|)) + |CHAR;lookup;$Pi;8|)) (DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 0) |%Shell|) |%Char|) - |CHAR;char;Nni$;6|)) + |CHAR;char;Nni$;9|)) -(PUT '|CHAR;char;Nni$;6| '|SPADreplace| 'CODE-CHAR) +(PUT '|CHAR;char;Nni$;9| '|SPADreplace| 'CODE-CHAR) (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) (|%IntegerSection| 0)) - |CHAR;ord;$Nni;7|)) + |CHAR;ord;$Nni;10|)) -(PUT '|CHAR;ord;$Nni;7| '|SPADreplace| 'CHAR-CODE) +(PUT '|CHAR;ord;$Nni;10| '|SPADreplace| 'CHAR-CODE) -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;random;$;8|)) +(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;random;$;11|)) -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;space;$;9|)) +(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;space;$;12|)) -(PUT '|CHAR;space;$;9| '|SPADreplace| '(XLAM NIL (CHAR " " 0))) +(PUT '|CHAR;space;$;12| '|SPADreplace| '(XLAM NIL (CHAR " " 0))) -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;quote;$;10|)) +(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;quote;$;13|)) -(PUT '|CHAR;quote;$;10| '|SPADreplace| '(XLAM NIL (CHAR "\" " 0))) +(PUT '|CHAR;quote;$;13| '|SPADreplace| '(XLAM NIL (CHAR "\" " 0))) -(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;escape;$;11|)) +(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;escape;$;14|)) -(PUT '|CHAR;escape;$;11| '|SPADreplace| '(XLAM NIL (CHAR "_ " 0))) +(PUT '|CHAR;escape;$;14| '|SPADreplace| '(XLAM NIL (CHAR "_ " 0))) (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Thing|) - |CHAR;coerce;$Of;12|)) + |CHAR;coerce;$Of;15|)) -(PUT '|CHAR;coerce;$Of;12| '|SPADreplace| '(XLAM (|c|) |c|)) +(PUT '|CHAR;coerce;$Of;15| '|SPADreplace| '(XLAM (|c|) |c|)) (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|) - |CHAR;digit?;$B;13|)) + |CHAR;digit?;$B;16|)) (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|) - |CHAR;hexDigit?;$B;14|)) + |CHAR;hexDigit?;$B;17|)) (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|) - |CHAR;upperCase?;$B;15|)) + |CHAR;upperCase?;$B;18|)) (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|) - |CHAR;lowerCase?;$B;16|)) + |CHAR;lowerCase?;$B;19|)) (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|) - |CHAR;alphabetic?;$B;17|)) + |CHAR;alphabetic?;$B;20|)) (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|) - |CHAR;alphanumeric?;$B;18|)) + |CHAR;alphanumeric?;$B;21|)) (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%String|) - |CHAR;latex;$S;19|)) + |CHAR;latex;$S;22|)) (DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%Char|) - |CHAR;char;S$;20|)) + |CHAR;char;S$;23|)) (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Char|) - |CHAR;upperCase;2$;21|)) + |CHAR;upperCase;2$;24|)) -(PUT '|CHAR;upperCase;2$;21| '|SPADreplace| 'CHAR-UPCASE) +(PUT '|CHAR;upperCase;2$;24| '|SPADreplace| 'CHAR-UPCASE) (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Char|) - |CHAR;lowerCase;2$;22|)) + |CHAR;lowerCase;2$;25|)) -(PUT '|CHAR;lowerCase;2$;22| '|SPADreplace| 'CHAR-DOWNCASE) +(PUT '|CHAR;lowerCase;2$;25| '|SPADreplace| 'CHAR-DOWNCASE) (DEFUN |CHAR;=;2$B;1| (|a| |b| $) (DECLARE (IGNORE $)) @@ -93,78 +108,92 @@ (DECLARE (IGNORE $)) (CHAR< |a| |b|)) -(DEFUN |CHAR;size;Nni;3| ($) (DECLARE (IGNORE $)) 256) +(DEFUN |CHAR;>;2$B;3| (|a| |b| $) + (DECLARE (IGNORE $)) + (CHAR> |a| |b|)) + +(DEFUN |CHAR;<=;2$B;4| (|a| |b| $) + (DECLARE (IGNORE $)) + (CHAR<= |a| |b|)) + +(DEFUN |CHAR;>=;2$B;5| (|a| |b| $) + (DECLARE (IGNORE $)) + (CHAR>= |a| |b|)) + +(DEFUN |CHAR;size;Nni;6| ($) (DECLARE (IGNORE $)) 256) -(DEFUN |CHAR;index;Pi$;4| (|n| $) - (PROG (#0=#:G1402) +(DEFUN |CHAR;index;Pi$;7| (|n| $) + (PROG (#0=#:G1405) (RETURN (CODE-CHAR - (PROG1 (LETT #0# (- |n| 1) |CHAR;index;Pi$;4|) + (PROG1 (LETT #0# (- |n| 1) |CHAR;index;Pi$;7|) (|check-subtype| (NOT (< #0# 0)) '(|NonNegativeInteger|) #0#)))))) -(DEFUN |CHAR;lookup;$Pi;5| (|c| $) - (PROG (#0=#:G1404) +(DEFUN |CHAR;lookup;$Pi;8| (|c| $) + (PROG (#0=#:G1407) (RETURN - (PROG1 (LETT #0# (+ 1 (CHAR-CODE |c|)) |CHAR;lookup;$Pi;5|) + (PROG1 (LETT #0# (+ 1 (CHAR-CODE |c|)) |CHAR;lookup;$Pi;8|) (|check-subtype| (< 0 #0#) '(|PositiveInteger|) #0#))))) -(DEFUN |CHAR;char;Nni$;6| (|n| $) +(DEFUN |CHAR;char;Nni$;9| (|n| $) (DECLARE (IGNORE $)) (CODE-CHAR |n|)) -(DEFUN |CHAR;ord;$Nni;7| (|c| $) (DECLARE (IGNORE $)) (CHAR-CODE |c|)) +(DEFUN |CHAR;ord;$Nni;10| (|c| $) + (DECLARE (IGNORE $)) + (CHAR-CODE |c|)) -(DEFUN |CHAR;random;$;8| ($) (CODE-CHAR (RANDOM 256))) +(DEFUN |CHAR;random;$;11| ($) (CODE-CHAR (RANDOM 256))) -(DEFUN |CHAR;space;$;9| ($) (DECLARE (IGNORE $)) (CHAR " " 0)) +(DEFUN |CHAR;space;$;12| ($) (DECLARE (IGNORE $)) (CHAR " " 0)) -(DEFUN |CHAR;quote;$;10| ($) (DECLARE (IGNORE $)) (CHAR "\" " 0)) +(DEFUN |CHAR;quote;$;13| ($) (DECLARE (IGNORE $)) (CHAR "\" " 0)) -(DEFUN |CHAR;escape;$;11| ($) (DECLARE (IGNORE $)) (CHAR "_ " 0)) +(DEFUN |CHAR;escape;$;14| ($) (DECLARE (IGNORE $)) (CHAR "_ " 0)) -(DEFUN |CHAR;coerce;$Of;12| (|c| $) (DECLARE (IGNORE $)) |c|) +(DEFUN |CHAR;coerce;$Of;15| (|c| $) (DECLARE (IGNORE $)) |c|) -(DEFUN |CHAR;digit?;$B;13| (|c| $) - (SPADCALL |c| (|spadConstant| $ 29) (|getShellEntry| $ 31))) +(DEFUN |CHAR;digit?;$B;16| (|c| $) + (SPADCALL |c| (|spadConstant| $ 32) (|getShellEntry| $ 34))) -(DEFUN |CHAR;hexDigit?;$B;14| (|c| $) - (SPADCALL |c| (|spadConstant| $ 33) (|getShellEntry| $ 31))) +(DEFUN |CHAR;hexDigit?;$B;17| (|c| $) + (SPADCALL |c| (|spadConstant| $ 36) (|getShellEntry| $ 34))) -(DEFUN |CHAR;upperCase?;$B;15| (|c| $) - (SPADCALL |c| (|spadConstant| $ 35) (|getShellEntry| $ 31))) +(DEFUN |CHAR;upperCase?;$B;18| (|c| $) + (SPADCALL |c| (|spadConstant| $ 38) (|getShellEntry| $ 34))) -(DEFUN |CHAR;lowerCase?;$B;16| (|c| $) - (SPADCALL |c| (|spadConstant| $ 37) (|getShellEntry| $ 31))) +(DEFUN |CHAR;lowerCase?;$B;19| (|c| $) + (SPADCALL |c| (|spadConstant| $ 40) (|getShellEntry| $ 34))) -(DEFUN |CHAR;alphabetic?;$B;17| (|c| $) - (SPADCALL |c| (|spadConstant| $ 39) (|getShellEntry| $ 31))) +(DEFUN |CHAR;alphabetic?;$B;20| (|c| $) + (SPADCALL |c| (|spadConstant| $ 42) (|getShellEntry| $ 34))) -(DEFUN |CHAR;alphanumeric?;$B;18| (|c| $) - (SPADCALL |c| (|spadConstant| $ 41) (|getShellEntry| $ 31))) +(DEFUN |CHAR;alphanumeric?;$B;21| (|c| $) + (SPADCALL |c| (|spadConstant| $ 44) (|getShellEntry| $ 34))) -(DEFUN |CHAR;latex;$S;19| (|c| $) +(DEFUN |CHAR;latex;$S;22| (|c| $) (STRCONC "\\mbox{`" (STRCONC (MAKE-FULL-CVEC 1 |c|) "'}"))) -(DEFUN |CHAR;char;S$;20| (|s| $) +(DEFUN |CHAR;char;S$;23| (|s| $) (COND ((EQL (QCSIZE |s|) 1) - (SPADCALL |s| (SPADCALL |s| (|getShellEntry| $ 49)) - (|getShellEntry| $ 50))) + (SPADCALL |s| (SPADCALL |s| (|getShellEntry| $ 52)) + (|getShellEntry| $ 53))) ('T (|userError| "String is not a single character")))) -(DEFUN |CHAR;upperCase;2$;21| (|c| $) +(DEFUN |CHAR;upperCase;2$;24| (|c| $) (DECLARE (IGNORE $)) (CHAR-UPCASE |c|)) -(DEFUN |CHAR;lowerCase;2$;22| (|c| $) +(DEFUN |CHAR;lowerCase;2$;25| (|c| $) (DECLARE (IGNORE $)) (CHAR-DOWNCASE |c|)) (DEFUN |Character| () (PROG () (RETURN - (PROG (#0=#:G1425) + (PROG (#0=#:G1428) (RETURN (COND ((LETT #0# (HGET |$ConstructorCache| '|Character|) @@ -184,7 +213,7 @@ (RETURN (PROGN (LETT |dv$| '(|Character|) . #0=(|Character|)) - (LETT $ (|newShell| 55) . #0#) + (LETT $ (|newShell| 58) . #0#) (|setShellEntry| $ 0 |dv$|) (|setShellEntry| $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) @@ -194,23 +223,24 @@ (MAKEPROP '|Character| '|infovec| (LIST '#(NIL NIL NIL NIL NIL NIL (|Boolean|) |CHAR;=;2$B;1| - |CHAR;<;2$B;2| (|NonNegativeInteger|) |CHAR;size;Nni;3| + |CHAR;<;2$B;2| |CHAR;>;2$B;3| |CHAR;<=;2$B;4| + |CHAR;>=;2$B;5| (|NonNegativeInteger|) |CHAR;size;Nni;6| (|PositiveInteger|) (0 . |One|) (4 . |One|) (|Integer|) - (8 . -) |CHAR;char;Nni$;6| |CHAR;index;Pi$;4| - |CHAR;ord;$Nni;7| (14 . +) |CHAR;lookup;$Pi;5| - (20 . |random|) |CHAR;random;$;8| |CHAR;space;$;9| - |CHAR;quote;$;10| |CHAR;escape;$;11| (|OutputForm|) - |CHAR;coerce;$Of;12| (|CharacterClass|) (25 . |digit|) - (|Character|) (29 . |member?|) |CHAR;digit?;$B;13| - (35 . |hexDigit|) |CHAR;hexDigit?;$B;14| - (39 . |upperCase|) |CHAR;upperCase?;$B;15| - (43 . |lowerCase|) |CHAR;lowerCase?;$B;16| - (47 . |alphabetic|) |CHAR;alphabetic?;$B;17| - (51 . |alphanumeric|) |CHAR;alphanumeric?;$B;18| - (|String|) (55 . |new|) (61 . |concat|) |CHAR;latex;$S;19| + (8 . -) |CHAR;char;Nni$;9| |CHAR;index;Pi$;7| + |CHAR;ord;$Nni;10| (14 . +) |CHAR;lookup;$Pi;8| + (20 . |random|) |CHAR;random;$;11| |CHAR;space;$;12| + |CHAR;quote;$;13| |CHAR;escape;$;14| (|OutputForm|) + |CHAR;coerce;$Of;15| (|CharacterClass|) (25 . |digit|) + (|Character|) (29 . |member?|) |CHAR;digit?;$B;16| + (35 . |hexDigit|) |CHAR;hexDigit?;$B;17| + (39 . |upperCase|) |CHAR;upperCase?;$B;18| + (43 . |lowerCase|) |CHAR;lowerCase?;$B;19| + (47 . |alphabetic|) |CHAR;alphabetic?;$B;20| + (51 . |alphanumeric|) |CHAR;alphanumeric?;$B;21| + (|String|) (55 . |new|) (61 . |concat|) |CHAR;latex;$S;22| (67 . |#|) (72 . |one?|) (77 . |minIndex|) (82 . |elt|) - |CHAR;char;S$;20| |CHAR;upperCase;2$;21| - |CHAR;lowerCase;2$;22| (|SingleInteger|)) + |CHAR;char;S$;23| |CHAR;upperCase;2$;24| + |CHAR;lowerCase;2$;25| (|SingleInteger|)) '#(~= 88 |upperCase?| 94 |upperCase| 99 |space| 104 |size| 108 |random| 112 |quote| 116 |ord| 120 |min| 125 |max| 135 |lowerCase?| 145 |lowerCase| 150 |lookup| 155 |latex| 160 @@ -224,24 +254,24 @@ |BasicType&| NIL) (CONS '#((|OrderedFinite|) (|OrderedSet|) (|Finite|) (|SetCategory|) (|BasicType|) - (|CoercibleTo| 26)) - (|makeByteWordVec2| 54 - '(0 11 0 12 0 9 0 13 2 14 0 0 0 15 2 9 - 0 0 0 19 1 9 0 0 21 0 28 0 29 2 28 6 - 30 0 31 0 28 0 33 0 28 0 35 0 28 0 37 - 0 28 0 39 0 28 0 41 2 43 0 9 30 44 2 - 43 0 0 0 45 1 43 9 0 47 1 9 6 0 48 1 - 43 14 0 49 2 43 30 0 14 50 2 0 6 0 0 - 1 1 0 6 0 36 1 0 0 0 52 0 0 0 23 0 0 - 9 10 0 0 0 22 0 0 0 24 1 0 9 0 18 0 0 - 0 1 2 0 0 0 0 1 0 0 0 1 2 0 0 0 0 1 1 - 0 6 0 38 1 0 0 0 53 1 0 11 0 20 1 0 - 43 0 46 1 0 0 11 17 1 0 6 0 34 1 0 54 - 0 1 0 0 0 25 1 0 6 0 32 1 0 26 0 27 1 - 0 0 43 51 1 0 0 9 16 2 0 6 0 0 1 1 0 - 6 0 42 1 0 6 0 40 2 0 6 0 0 1 2 0 6 0 - 0 1 2 0 6 0 0 7 2 0 6 0 0 1 2 0 6 0 0 - 8))))) + (|CoercibleTo| 29)) + (|makeByteWordVec2| 57 + '(0 14 0 15 0 12 0 16 2 17 0 0 0 18 2 + 12 0 0 0 22 1 12 0 0 24 0 31 0 32 2 + 31 6 33 0 34 0 31 0 36 0 31 0 38 0 31 + 0 40 0 31 0 42 0 31 0 44 2 46 0 12 33 + 47 2 46 0 0 0 48 1 46 12 0 50 1 12 6 + 0 51 1 46 17 0 52 2 46 33 0 17 53 2 0 + 6 0 0 1 1 0 6 0 39 1 0 0 0 55 0 0 0 + 26 0 0 12 13 0 0 0 25 0 0 0 27 1 0 12 + 0 21 0 0 0 1 2 0 0 0 0 1 0 0 0 1 2 0 + 0 0 0 1 1 0 6 0 41 1 0 0 0 56 1 0 14 + 0 23 1 0 46 0 49 1 0 0 14 20 1 0 6 0 + 37 1 0 57 0 1 0 0 0 28 1 0 6 0 35 1 0 + 29 0 30 1 0 0 46 54 1 0 0 12 19 2 0 6 + 0 0 1 1 0 6 0 45 1 0 6 0 43 2 0 6 0 0 + 11 2 0 6 0 0 9 2 0 6 0 0 7 2 0 6 0 0 + 10 2 0 6 0 0 8))))) '|lookupComplete|)) (MAKEPROP '|Character| 'NILADIC T) |