diff options
Diffstat (limited to 'src/boot/strap')
-rw-r--r-- | src/boot/strap/ast.clisp | 9 | ||||
-rw-r--r-- | src/boot/strap/includer.clisp | 7 | ||||
-rw-r--r-- | src/boot/strap/scanner.clisp | 45 | ||||
-rw-r--r-- | src/boot/strap/tokens.clisp | 29 | ||||
-rw-r--r-- | src/boot/strap/translator.clisp | 4 |
5 files changed, 51 insertions, 43 deletions
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 6053c6b8..6a947261 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -228,7 +228,8 @@ (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Boolean|) |bfBeginsDollar|)) -(DEFUN |bfBeginsDollar| (|x|) (CHAR= (ELT (PNAME |x|) 0) (|char| '$))) +(DEFUN |bfBeginsDollar| (|x|) + (CHAR= (SCHAR (PNAME |x|) 0) (|char| '$))) (DEFUN |compFluid| (|id|) (LIST 'FLUID |id|)) @@ -1206,7 +1207,7 @@ (DEFUN |bfChar?| (|x|) (OR (CHARACTERP |x|) - (AND (CONSP |x|) (MEMQ (CAR |x|) '(|char| |abstractChar|))))) + (AND (CONSP |x|) (MEMQ (CAR |x|) '(|char| CODE-CHAR SCHAR))))) (DEFUN |bfSmintable| (|x|) (OR (INTEGERP |x|) @@ -1215,7 +1216,8 @@ (DEFUN |bfString?| (|x|) (OR (STRINGP |x|) (AND (CONSP |x|) - (MEMQ (CAR |x|) '(|charString| |symbolName| |toString|))))) + (MEMQ (CAR |x|) + '(|charString| |symbolName| |toString| |subString|))))) (DEFUN |bfQ| (|l| |r|) (COND @@ -1233,6 +1235,7 @@ ((EQL |l| 0) (LIST 'PLUSP |r|)) ((EQL |r| 0) (LIST 'MINUSP |l|)) ((OR (|bfChar?| |l|) (|bfChar?| |r|)) (LIST 'CHAR< |l| |r|)) + ((OR (|bfString?| |l|) (|bfString?| |r|)) (LIST 'STRING< |l| |r|)) (T (LIST '< |l| |r|)))) (DEFUN |bfLambda| (|vars| |body|) diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp index 0956df6b..323a23a9 100644 --- a/src/boot/strap/includer.clisp +++ b/src/boot/strap/includer.clisp @@ -96,7 +96,7 @@ ((< (LENGTH |a|) |sz|) (|shoePackageStartsAt| |lines| |sz| |name| (CDR |stream|))) - ((AND (EQUAL (|subString| |a| 0 |sz|) |name|) + ((AND (STRING= (|subString| |a| 0 |sz|) |name|) (< |sz| (LENGTH |a|)) (NOT (|shoeIdChar| (ELT |a| |sz|)))) (LIST |lines| |stream|)) @@ -242,7 +242,8 @@ (COND ((OR (> |i| |bfVar#1|) (NOT |good|)) (RETURN NIL)) (T (SETQ |good| - (EQUAL (ELT |prefix| |i|) (ELT |whole| |j|))))) + (CHAR= (SCHAR |prefix| |i|) + (SCHAR |whole| |j|))))) (SETQ |i| (+ |i| 1)) (SETQ |j| (+ |j| 1)))) (COND @@ -252,7 +253,7 @@ (DEFUN |shoePlainLine?| (|s|) (COND ((EQL (LENGTH |s|) 0) T) - (T (NOT (CHAR= (ELT |s| 0) (|char| '|)|)))))) + (T (NOT (CHAR= (SCHAR |s| 0) (|char| '|)|)))))) (DEFUN |shoeSay?| (|s|) (|shoePrefix?| ")say" |s|)) diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp index 15ae2e96..06cfc59d 100644 --- a/src/boot/strap/scanner.clisp +++ b/src/boot/strap/scanner.clisp @@ -7,6 +7,28 @@ (PROVIDE "scanner") +(DEFCONSTANT |shoeSPACE| (QENUM " " 0)) + +(DEFCONSTANT |shoeESCAPE| (QENUM "_ " 0)) + +(DEFPARAMETER |shoeLispESCAPE| (QENUM "! " 0)) + +(DEFCONSTANT |shoeSTRINGCHAR| (QENUM "\" " 0)) + +(DEFCONSTANT |shoePLUSCOMMENT| (QENUM "+ " 0)) + +(DEFCONSTANT |shoeMINUSCOMMENT| (QENUM "- " 0)) + +(DEFCONSTANT |shoeDOT| (QENUM ". " 0)) + +(DEFCONSTANT |shoeEXPONENT1| (QENUM "E " 0)) + +(DEFCONSTANT |shoeEXPONENT2| (QENUM "e " 0)) + +(DEFCONSTANT |shoeCLOSEPAREN| (QENUM ") " 0)) + +(DEFCONSTANT |shoeTAB| 9) + (DEFUN |double| (|x|) (FLOAT |x| 1.0)) (DEFUN |dqUnit| (|s|) @@ -164,7 +186,7 @@ (SETQ |c| (QENUM |$ln| |$n|)) (SETQ |linepos| |$linepos|) (SETQ |n| |$n|) - (SETQ |ch| (ELT |$ln| |$n|)) + (SETQ |ch| (SCHAR |$ln| |$n|)) (SETQ |b| (COND ((|shoeStartsComment|) (|shoeComment|) NIL) @@ -223,13 +245,13 @@ (COND ((NOT (< |$n| |$sz|)) (|SoftShoeError| (CONS |$linepos| |$n|) "lisp escape error") - (|shoeLeafError| (ELT |$ln| |$n|))) + (|shoeLeafError| (SCHAR |$ln| |$n|))) (T (SETQ |a| (|shoeReadLispString| |$ln| |$n|)) (COND ((NULL |a|) (|SoftShoeError| (CONS |$linepos| |$n|) "lisp escape error") - (|shoeLeafError| (ELT |$ln| |$n|))) + (|shoeLeafError| (SCHAR |$ln| |$n|))) (T (SETQ |exp| (CAR |a|)) (SETQ |n| (CADR |a|)) (COND ((NULL |n|) (SETQ |$n| |$sz|) @@ -329,7 +351,7 @@ (DEFUN |shoePossFloat| (|w|) (DECLARE (SPECIAL |$ln| |$sz| |$n|)) (COND - ((OR (NOT (< |$n| |$sz|)) (NOT (|shoeDigit| (ELT |$ln| |$n|)))) + ((OR (NOT (< |$n| |$sz|)) (NOT (|shoeDigit| (SCHAR |$ln| |$n|)))) (|shoeLeafKey| |w|)) (T (SETQ |w| (|shoeInteger|)) (|shoeExponent| "0" |w|)))) @@ -374,7 +396,8 @@ (SETQ |b| (COND (|a| (SETQ |str| - (CONCAT |str| (ELT |$ln| |$n|))) + (CONCAT |str| + (STRING (SCHAR |$ln| |$n|)))) (SETQ |$n| (+ |$n| 1)) (|shoeS|)) (T (|shoeS|)))) (CONCAT |str| |b|)))))))) @@ -384,7 +407,7 @@ (LOOP (COND ((NOT (AND (< |n| (LENGTH |line|)) - (|shoeIdChar| (ELT |line| |n|)))) + (|shoeIdChar| (SCHAR |line| |n|)))) (RETURN NIL)) (T (SETQ |n| (+ |n| 1))))) |n|)) @@ -435,7 +458,7 @@ (SETQ |l| |$sz|) (LOOP (COND - ((NOT (AND (< |$n| |l|) (|shoeDigit| (ELT |$ln| |$n|)))) + ((NOT (AND (< |$n| |l|) (|shoeDigit| (SCHAR |$ln| |$n|)))) (RETURN NIL)) (T (SETQ |$n| (+ |$n| 1))))) (COND @@ -459,7 +482,7 @@ (COND ((> |i| |bfVar#1|) (RETURN NIL)) (T (PROGN - (SETQ |d| (|shoeOrdToNum| (ELT |s| |i|))) + (SETQ |d| (|shoeOrdToNum| (SCHAR |s| |i|))) (SETQ |ival| (+ (* 10 |ival|) |d|))))) (SETQ |i| (+ |i| 1)))) |ival|)))) @@ -494,7 +517,7 @@ (COND ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|) (|shoeLeafFloat| |a| |w| 0)) - ((|shoeDigit| (ELT |$ln| |$n|)) + ((|shoeDigit| (SCHAR |$ln| |$n|)) (SETQ |e| (|shoeInteger|)) (SETQ |e| (|shoeIntValue| |e|)) (|shoeLeafFloat| |a| |w| |e|)) @@ -506,7 +529,7 @@ (COND ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|) (|shoeLeafFloat| |a| |w| 0)) - ((|shoeDigit| (ELT |$ln| |$n|)) + ((|shoeDigit| (SCHAR |$ln| |$n|)) (SETQ |e| (|shoeInteger|)) (SETQ |e| (|shoeIntValue| |e|)) (|shoeLeafFloat| |a| |w| @@ -528,7 +551,7 @@ (CONCAT "The character whose number is " (WRITE-TO-STRING (QENUM |$ln| |n|)) " is not a Boot character")) - (|shoeLeafError| (ELT |$ln| |n|)))))) + (|shoeLeafError| (SCHAR |$ln| |n|)))))) (DEFUN |shoeOrdToNum| (|x|) (DIGIT-CHAR-P |x|)) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 01f54c47..b3c11228 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -5,7 +5,7 @@ (PROVIDE "tokens") -(DEFUN |char| (|x|) (CHAR (SYMBOL-NAME |x|) 0)) +(DEFUN |char| (|x|) (SCHAR (SYMBOL-NAME |x|) 0)) (DEFUN |shoeStartsId| (|x|) (OR (ALPHA-CHAR-P |x|) @@ -20,6 +20,8 @@ ((NULL |n|) (SUBSEQ |s| |f|)) (T (SUBSEQ |s| |f| (+ |f| |n|))))) +(DEFUN QENUM (|s| |i|) (CHAR-CODE (SCHAR |s| |i|))) + (DEFCONSTANT |shoeKeyWords| (LIST (LIST "and" 'AND) (LIST "by" 'BY) (LIST "case" 'CASE) (LIST "catch" 'CATCH) (LIST "cross" 'CROSS) @@ -64,28 +66,6 @@ (DEFPARAMETER |shoeKeyTable| (|shoeKeyTableCons|)) -(DEFCONSTANT |shoeSPACE| (QENUM " " 0)) - -(DEFCONSTANT |shoeESCAPE| (QENUM "_ " 0)) - -(DEFPARAMETER |shoeLispESCAPE| (QENUM "! " 0)) - -(DEFCONSTANT |shoeSTRINGCHAR| (QENUM "\" " 0)) - -(DEFCONSTANT |shoePLUSCOMMENT| (QENUM "+ " 0)) - -(DEFCONSTANT |shoeMINUSCOMMENT| (QENUM "- " 0)) - -(DEFCONSTANT |shoeDOT| (QENUM ". " 0)) - -(DEFCONSTANT |shoeEXPONENT1| (QENUM "E " 0)) - -(DEFCONSTANT |shoeEXPONENT2| (QENUM "e " 0)) - -(DEFCONSTANT |shoeCLOSEPAREN| (QENUM ") " 0)) - -(DEFCONSTANT |shoeTAB| 9) - (DEFUN |shoeInsert| (|s| |d|) (PROG (|v| |k| |n| |u| |h| |l|) (RETURN @@ -252,7 +232,8 @@ (LIST '|setDifference| 'SETDIFFERENCE) (LIST '|setIntersection| 'INTERSECTION) (LIST '|setPart| 'SETELT) (LIST '|setUnion| 'UNION) - (LIST '|strconc| 'CONCAT) (LIST '|string?| 'STRINGP) + (LIST '|strconc| 'CONCAT) (LIST '|stringChar| 'SCHAR) + (LIST '|string?| 'STRINGP) (LIST '|subSequence| 'SUBSEQ) (LIST '|substitute| 'SUBST) (LIST '|substitute!| 'NSUBST) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index e37043e5..5800bc33 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -1230,7 +1230,7 @@ (COND (|b| (SETQ |stream| *TERMINAL-IO*) (PSTTOMC (|bRgen| |stream|)) (BOOTLOOP)) - ((CHAR= (ELT |a| 0) (|char| '])) NIL) + ((CHAR= (SCHAR |a| 0) (|char| '])) NIL) (T (PSTTOMC (LIST |a|)) (BOOTLOOP))))))))) (DEFUN BOOTPO () @@ -1245,7 +1245,7 @@ (COND (|b| (SETQ |stream| *TERMINAL-IO*) (PSTOUT (|bRgen| |stream|)) (BOOTPO)) - ((CHAR= (ELT |a| 0) (|char| '])) NIL) + ((CHAR= (SCHAR |a| 0) (|char| '])) NIL) (T (PSTOUT (LIST |a|)) (BOOTPO))))))))) (DEFUN PSTOUT (|string|) |