More character cleanup

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|)