More char cleanups

1 files changed, 77 insertions, 107 deletions

diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index 06cfc59d..2df8e320 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -7,27 +7,7 @@
 
 (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)
+(DEFCONSTANT |shoeTAB| (CODE-CHAR 9))
 
 (DEFUN |double| (|x|) (FLOAT |x| 1.0))
 
@@ -71,7 +51,7 @@
            (SETQ |$sz| (LENGTH |$ln|))
            (COND
              ((NULL |$n|) T)
-             ((EQL (QENUM |$ln| |$n|) |shoeTAB|)
+             ((CHAR= (SCHAR |$ln| |$n|) |shoeTAB|)
               (SETQ |a| (MAKE-FULL-CVEC (- 7 (REM |$n| 8)) " "))
               (SETF (ELT |$ln| |$n|) (|char| '| |))
               (SETQ |$ln| (CONCAT |a| |$ln|))
@@ -81,7 +61,7 @@
 
 (DEFUN |shoeLineToks| (|s|)
   (PROG (|$linepos| |$floatok| |$sz| |$n| |$ln| |$r| |$f| |toks| |a|
-            |dq| |command| |fst|)
+            |dq| |command|)
     (DECLARE (SPECIAL |$floatok| |$f| |$sz| |$linepos| |$ln| |$r| |$n|))
     (RETURN
       (PROGN
@@ -95,35 +75,32 @@
         (COND
           ((NOT (|shoeNextLine| |s|)) (CONS NIL NIL))
           ((NULL |$n|) (|shoeLineToks| |$r|))
-          (T (SETQ |fst| (QENUM |$ln| 0))
+          ((CHAR= (SCHAR |$ln| 0) (|char| '|)|))
+           (COND
+             ((SETQ |command| (|shoeLine?| |$ln|))
+              (SETQ |dq|
+                    (|dqUnit|
+                        (|shoeConstructToken| |$ln| |$linepos|
+                            (|shoeLeafLine| |command|) 0)))
+              (CONS (LIST |dq|) |$r|))
+             ((SETQ |command| (|shoeLisp?| |$ln|))
+              (|shoeLispToken| |$r| |command|))
+             ((SETQ |command| (|shoePackage?| |$ln|))
+              (SETQ |a| (CONCAT "(IN-PACKAGE " |command| ")"))
+              (SETQ |dq|
+                    (|dqUnit|
+                        (|shoeConstructToken| |$ln| |$linepos|
+                            (|shoeLeafLisp| |a|) 0)))
+              (CONS (LIST |dq|) |$r|))
+             (T (|shoeLineToks| |$r|))))
+          (T (SETQ |toks| NIL)
+             (LOOP
+               (COND
+                 ((NOT (< |$n| |$sz|)) (RETURN NIL))
+                 (T (SETQ |toks| (|dqAppend| |toks| (|shoeToken|))))))
              (COND
-               ((EQL |fst| |shoeCLOSEPAREN|)
-                (COND
-                  ((SETQ |command| (|shoeLine?| |$ln|))
-                   (SETQ |dq|
-                         (|dqUnit|
-                             (|shoeConstructToken| |$ln| |$linepos|
-                                 (|shoeLeafLine| |command|) 0)))
-                   (CONS (LIST |dq|) |$r|))
-                  ((SETQ |command| (|shoeLisp?| |$ln|))
-                   (|shoeLispToken| |$r| |command|))
-                  ((SETQ |command| (|shoePackage?| |$ln|))
-                   (SETQ |a| (CONCAT "(IN-PACKAGE " |command| ")"))
-                   (SETQ |dq|
-                         (|dqUnit|
-                             (|shoeConstructToken| |$ln| |$linepos|
-                                 (|shoeLeafLisp| |a|) 0)))
-                   (CONS (LIST |dq|) |$r|))
-                  (T (|shoeLineToks| |$r|))))
-               (T (SETQ |toks| NIL)
-                  (LOOP
-                    (COND
-                      ((NOT (< |$n| |$sz|)) (RETURN NIL))
-                      (T (SETQ |toks|
-                               (|dqAppend| |toks| (|shoeToken|))))))
-                  (COND
-                    ((NULL |toks|) (|shoeLineToks| |$r|))
-                    (T (CONS (LIST |toks|) |$r|)))))))))))
+               ((NULL |toks|) (|shoeLineToks| |$r|))
+               (T (CONS (LIST |toks|) |$r|)))))))))
 
 (DEFUN |shoeLispToken| (|s| |string|)
   (PROG (|dq| |st| |r| |LETTMP#1| |linepos| |ln|)
@@ -133,7 +110,7 @@
         (SETQ |string|
               (COND
                 ((OR (EQL (LENGTH |string|) 0)
-                     (EQL (QENUM |string| 0) (QENUM ";" 0)))
+                     (CHAR= (SCHAR |string| 0) (|char| '|;|)))
                  "")
                 (T |string|)))
         (SETQ |ln| |$ln|)
@@ -148,42 +125,38 @@
         (CONS (LIST |dq|) |r|)))))
 
 (DEFUN |shoeAccumulateLines| (|s| |string|)
-  (PROG (|a| |command| |fst|)
+  (PROG (|a| |command|)
     (DECLARE (SPECIAL |$ln| |$r| |$n|))
     (RETURN
       (COND
         ((NOT (|shoeNextLine| |s|)) (CONS |s| |string|))
         ((NULL |$n|) (|shoeAccumulateLines| |$r| |string|))
         ((EQL (LENGTH |$ln|) 0) (|shoeAccumulateLines| |$r| |string|))
-        (T (SETQ |fst| (QENUM |$ln| 0))
-           (COND
-             ((EQL |fst| |shoeCLOSEPAREN|)
-              (SETQ |command| (|shoeLisp?| |$ln|))
-              (COND
-                ((AND |command| (PLUSP (LENGTH |command|)))
+        ((CHAR= (SCHAR |$ln| 0) (|char| '|)|))
+         (SETQ |command| (|shoeLisp?| |$ln|))
+         (COND
+           ((AND |command| (PLUSP (LENGTH |command|)))
+            (COND
+              ((CHAR= (SCHAR |command| 0) (|char| '|;|))
+               (|shoeAccumulateLines| |$r| |string|))
+              (T (SETQ |a| (STRPOS ";" |command| 0 NIL))
                  (COND
-                   ((EQL (QENUM |command| 0) (QENUM ";" 0))
-                    (|shoeAccumulateLines| |$r| |string|))
-                   (T (SETQ |a| (STRPOS ";" |command| 0 NIL))
-                      (COND
-                        (|a| (|shoeAccumulateLines| |$r|
-                                 (CONCAT |string|
-                                         (|subString| |command| 0
-                                          (- |a| 1)))))
-                        (T (|shoeAccumulateLines| |$r|
-                               (CONCAT |string| |command|)))))))
-                (T (|shoeAccumulateLines| |$r| |string|))))
-             (T (CONS |s| |string|))))))))
+                   (|a| (|shoeAccumulateLines| |$r|
+                            (CONCAT |string|
+                                    (|subString| |command| 0 (- |a| 1)))))
+                   (T (|shoeAccumulateLines| |$r|
+                          (CONCAT |string| |command|)))))))
+           (T (|shoeAccumulateLines| |$r| |string|))))
+        (T (CONS |s| |string|))))))
 
 (DEFUN |shoeCloser| (|t|) (MEMQ (|shoeKeyWord| |t|) '(CPAREN CBRACK)))
 
 (DEFUN |shoeToken| ()
-  (PROG (|b| |ch| |n| |linepos| |c| |ln|)
-    (DECLARE (SPECIAL |$linepos| |$n| |$ln|))
+  (PROG (|b| |ch| |n| |linepos| |ln|)
+    (DECLARE (SPECIAL |$n| |$linepos| |$ln|))
     (RETURN
       (PROGN
         (SETQ |ln| |$ln|)
-        (SETQ |c| (QENUM |$ln| |$n|))
         (SETQ |linepos| |$linepos|)
         (SETQ |n| |$n|)
         (SETQ |ch| (SCHAR |$ln| |$n|))
@@ -191,14 +164,14 @@
               (COND
                 ((|shoeStartsComment|) (|shoeComment|) NIL)
                 ((|shoeStartsNegComment|) (|shoeNegComment|) NIL)
-                ((EQUAL |c| |shoeLispESCAPE|) (|shoeLispEscape|))
-                ((|shoePunctuation| |c|) (|shoePunct|))
+                ((CHAR= |ch| (|char| '!)) (|shoeLispEscape|))
+                ((|shoePunctuation| (CHAR-CODE |ch|)) (|shoePunct|))
                 ((|shoeStartsId| |ch|) (|shoeWord| NIL))
-                ((EQUAL |c| |shoeSPACE|) (|shoeSpace|) NIL)
-                ((EQUAL |c| |shoeSTRINGCHAR|) (|shoeString|))
-                ((|shoeDigit| |ch|) (|shoeNumber|))
-                ((EQUAL |c| |shoeESCAPE|) (|shoeEscape|))
-                ((EQUAL |c| |shoeTAB|) (SETQ |$n| (+ |$n| 1)) NIL)
+                ((CHAR= |ch| (|char| '| |)) (|shoeSpace|) NIL)
+                ((CHAR= |ch| (|char| '|"|)) (|shoeString|))
+                ((DIGIT-CHAR-P |ch|) (|shoeNumber|))
+                ((CHAR= |ch| (|char| '_)) (|shoeEscape|))
+                ((EQUAL |ch| |shoeTAB|) (SETQ |$n| (+ |$n| 1)) NIL)
                 (T (|shoeError|))))
         (COND
           ((NULL |b|) NIL)
@@ -291,11 +264,11 @@
       (COND
         ((< |$n| |$sz|)
          (COND
-           ((EQL (QENUM |$ln| |$n|) |shoePLUSCOMMENT|)
+           ((CHAR= (SCHAR |$ln| |$n|) (|char| '+))
             (SETQ |www| (+ |$n| 1))
             (COND
               ((NOT (< |www| |$sz|)) NIL)
-              (T (EQL (QENUM |$ln| |www|) |shoePLUSCOMMENT|))))
+              (T (CHAR= (SCHAR |$ln| |www|) (|char| '+)))))
            (T NIL)))
         (T NIL)))))
 
@@ -306,11 +279,11 @@
       (COND
         ((< |$n| |$sz|)
          (COND
-           ((EQL (QENUM |$ln| |$n|) |shoeMINUSCOMMENT|)
+           ((CHAR= (SCHAR |$ln| |$n|) (|char| '-))
             (SETQ |www| (+ |$n| 1))
             (COND
               ((NOT (< |www| |$sz|)) NIL)
-              (T (EQL (QENUM |$ln| |www|) |shoeMINUSCOMMENT|))))
+              (T (CHAR= (SCHAR |$ln| |www|) (|char| '-)))))
            (T NIL)))
         (T NIL)))))
 
@@ -351,7 +324,7 @@
 (DEFUN |shoePossFloat| (|w|)
   (DECLARE (SPECIAL |$ln| |$sz| |$n|))
   (COND
-    ((OR (NOT (< |$n| |$sz|)) (NOT (|shoeDigit| (SCHAR |$ln| |$n|))))
+    ((OR (NOT (< |$n| |$sz|)) (NOT (DIGIT-CHAR-P (SCHAR |$ln| |$n|))))
      (|shoeLeafKey| |w|))
     (T (SETQ |w| (|shoeInteger|)) (|shoeExponent| "0" |w|))))
 
@@ -412,8 +385,6 @@
         (T (SETQ |n| (+ |n| 1)))))
     |n|))
 
-(DEFUN |shoeDigit| (|x|) (DIGIT-CHAR-P |x|))
-
 (DEFUN |shoeW| (|b|)
   (PROG (|bb| |a| |str| |endid| |l| |n1|)
     (DECLARE (SPECIAL |$ln| |$sz| |$n|))
@@ -425,7 +396,7 @@
         (SETQ |endid| (|shoeIdEnd| |$ln| |$n|))
         (COND
           ((OR (EQUAL |endid| |l|)
-               (NOT (EQL (QENUM |$ln| |endid|) |shoeESCAPE|)))
+               (NOT (CHAR= (SCHAR |$ln| |endid|) (|char| '_))))
            (SETQ |$n| |endid|)
            (LIST |b| (|subString| |$ln| |n1| (- |endid| |n1|))))
           (T (SETQ |str| (|subString| |$ln| |n1| (- |endid| |n1|)))
@@ -458,12 +429,12 @@
         (SETQ |l| |$sz|)
         (LOOP
           (COND
-            ((NOT (AND (< |$n| |l|) (|shoeDigit| (SCHAR |$ln| |$n|))))
+            ((NOT (AND (< |$n| |l|) (DIGIT-CHAR-P (SCHAR |$ln| |$n|))))
              (RETURN NIL))
             (T (SETQ |$n| (+ |$n| 1)))))
         (COND
           ((OR (EQUAL |$n| |l|)
-               (NOT (EQL (QENUM |$ln| |$n|) |shoeESCAPE|)))
+               (NOT (CHAR= (SCHAR |$ln| |$n|) (|char| '_))))
            (COND
              ((AND (EQUAL |n| |$n|) |zro|) "0")
              (T (|subString| |$ln| |n| (- |$n| |n|)))))
@@ -495,10 +466,11 @@
         (SETQ |a| (|shoeInteger|))
         (COND
           ((NOT (< |$n| |$sz|)) (|shoeLeafInteger| |a|))
-          ((AND |$floatok| (EQL (QENUM |$ln| |$n|) |shoeDOT|))
+          ((AND |$floatok| (CHAR= (SCHAR |$ln| |$n|) (|char| '|.|)))
            (SETQ |n| |$n|) (SETQ |$n| (+ |$n| 1))
            (COND
-             ((AND (< |$n| |$sz|) (EQL (QENUM |$ln| |$n|) |shoeDOT|))
+             ((AND (< |$n| |$sz|)
+                   (CHAR= (SCHAR |$ln| |$n|) (|char| '|.|)))
               (SETQ |$n| |n|) (|shoeLeafInteger| |a|))
              (T (SETQ |w| (|shoeInteger1| T)) (|shoeExponent| |a| |w|))))
           (T (|shoeLeafInteger| |a|)))))))
@@ -509,33 +481,31 @@
     (RETURN
       (COND
         ((NOT (< |$n| |$sz|)) (|shoeLeafFloat| |a| |w| 0))
-        (T (SETQ |n| |$n|) (SETQ |c| (QENUM |$ln| |$n|))
+        (T (SETQ |n| |$n|) (SETQ |c| (SCHAR |$ln| |$n|))
            (COND
-             ((OR (EQUAL |c| |shoeEXPONENT1|)
-                  (EQUAL |c| |shoeEXPONENT2|))
+             ((OR (CHAR= |c| (|char| 'E)) (CHAR= |c| (|char| '|e|)))
               (SETQ |$n| (+ |$n| 1))
               (COND
                 ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|)
                  (|shoeLeafFloat| |a| |w| 0))
-                ((|shoeDigit| (SCHAR |$ln| |$n|))
+                ((DIGIT-CHAR-P (SCHAR |$ln| |$n|))
                  (SETQ |e| (|shoeInteger|))
                  (SETQ |e| (|shoeIntValue| |e|))
                  (|shoeLeafFloat| |a| |w| |e|))
-                (T (SETQ |c1| (QENUM |$ln| |$n|))
+                (T (SETQ |c1| (SCHAR |$ln| |$n|))
                    (COND
-                     ((OR (EQUAL |c1| |shoePLUSCOMMENT|)
-                          (EQUAL |c1| |shoeMINUSCOMMENT|))
+                     ((OR (CHAR= |c1| (|char| '+))
+                          (CHAR= |c1| (|char| '-)))
                       (SETQ |$n| (+ |$n| 1))
                       (COND
                         ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|)
                          (|shoeLeafFloat| |a| |w| 0))
-                        ((|shoeDigit| (SCHAR |$ln| |$n|))
+                        ((DIGIT-CHAR-P (SCHAR |$ln| |$n|))
                          (SETQ |e| (|shoeInteger|))
                          (SETQ |e| (|shoeIntValue| |e|))
                          (|shoeLeafFloat| |a| |w|
                              (COND
-                               ((EQUAL |c1| |shoeMINUSCOMMENT|)
-                                (- |e|))
+                               ((CHAR= |c1| (|char| '-)) (- |e|))
                                (T |e|))))
                         (T (SETQ |$n| |n|) (|shoeLeafFloat| |a| |w| 0))))))))
              (T (|shoeLeafFloat| |a| |w| 0))))))))
@@ -549,7 +519,7 @@
         (SETQ |$n| (+ |$n| 1))
         (|SoftShoeError| (CONS |$linepos| |n|)
             (CONCAT "The character whose number is "
-                    (WRITE-TO-STRING (QENUM |$ln| |n|))
+                    (WRITE-TO-STRING (CHAR-CODE (SCHAR |$ln| |n|)))
                     " is not a Boot character"))
         (|shoeLeafError| (SCHAR |$ln| |n|))))))
 
@@ -566,7 +536,7 @@
   (PROG (|eql| |ls| |s| |s1| |done| |ll| |u| |h|)
     (RETURN
       (PROGN
-        (SETQ |h| (QENUM |l| |i|))
+        (SETQ |h| (CHAR-CODE (SCHAR |l| |i|)))
         (SETQ |u| (ELT |d| |h|))
         (SETQ |ll| (LENGTH |l|))
         (SETQ |done| NIL)
@@ -589,8 +559,8 @@
                                      (RETURN NIL))
                                     (T
                                      (SETQ |eql|
-                                      (EQL (QENUM |s| |k|)
-                                       (QENUM |l| (+ |k| |i|))))))
+                                      (CHAR= (SCHAR |s| |k|)
+                                       (SCHAR |l| (+ |k| |i|))))))
                                   (SETQ |k| (+ |k| 1))))
                               (COND (|eql| (SETQ |s1| |s|) T) (T NIL))))))))
             (SETQ |j| (+ |j| 1))))