More character cleanup

11 files changed, 94 insertions, 86 deletions

diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 46d5a589..0d8bd1b5 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -200,7 +200,7 @@ bfColonAppend(x,y) ==
 
 bfBeginsDollar: %Thing -> %Boolean 
 bfBeginsDollar x ==  
-  (PNAME x).0 = char "$"
+  stringChar(PNAME x,0) = char "$"
  
 compFluid id == 
   ["FLUID",id]
@@ -745,7 +745,7 @@ defQuoteId x==
   x is ["QUOTE",:.] and symbol? second x
  
 bfChar? x ==
-  char? x or cons? x and first x in '(char abstractChar)
+  char? x or cons? x and first x in '(char CODE_-CHAR SCHAR)
  
 bfSmintable x==
   integer? x or cons? x and first x in '(SIZE LENGTH QENUM)
diff --git a/src/boot/includer.boot b/src/boot/includer.boot
index 3f976b28..62cc6456 100644
--- a/src/boot/includer.boot
+++ b/src/boot/includer.boot
@@ -259,13 +259,13 @@ shoePrefix?(prefix,whole) ==
   #prefix > #whole => false
   good:=true
   for i in 0..#prefix-1 for j in 0.. while good repeat
-    good:= prefix.i = whole.j
+    good := stringChar(prefix,i) = stringChar(whole,j)
   good => subString(whole,#prefix) 
   good
  
 shoePlainLine?(s) ==
   #s = 0 =>  true
-  s.0 ~= char ")"
+  stringChar(s,0) ~= char ")"
  
 shoeSay?          s  == shoePrefix?('")say",         s)
 shoeEval?         s  == shoePrefix?('")eval",        s)
diff --git a/src/boot/initial-env.lisp b/src/boot/initial-env.lisp
index 5a1041cb..dc767443 100644
--- a/src/boot/initial-env.lisp
+++ b/src/boot/initial-env.lisp
@@ -138,9 +138,6 @@
 (defun HPUT (table key value)
   (setf (gethash key table) value))
  
-(defun QENUM (cvec ind)
-  (char-code (char cvec ind)))
- 
 (defun strpos (what in start dontcare)
   (setq what (string what) in (string in))
   (if dontcare
diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot
index 9745bae6..96dd03f6 100644
--- a/src/boot/scanner.boot
+++ b/src/boot/scanner.boot
@@ -38,6 +38,27 @@ import includer
 namespace BOOTTRAN
 module scanner
 
+shoeSPACE       == QENUM('"    ", 0)
+ 
+shoeESCAPE      == QENUM('"__  ", 0)
+shoeLispESCAPE      := QENUM('"!  ", 0)
+ 
+shoeSTRING_CHAR == QENUM('"_"  ", 0)
+ 
+shoePLUSCOMMENT == QENUM('"+   ", 0)
+ 
+shoeMINUSCOMMENT == QENUM('"-   ", 0)
+ 
+shoeDOT          == QENUM('".   ", 0)
+ 
+shoeEXPONENT1   == QENUM('"E   ", 0)
+ 
+shoeEXPONENT2   == QENUM('"e   ", 0)
+ 
+shoeCLOSEPAREN  == QENUM('")   ", 0)
+ 
+shoeTAB == 9
+ 
 -- converts X to double-float.
 double x ==
   FLOAT(x, 1.0)
@@ -159,7 +180,7 @@ shoeToken () ==
   c:=QENUM($ln,$n)
   linepos:=$linepos
   n:=$n
-  ch:=$ln.$n
+  ch := stringChar($ln,$n)
   b:=
     shoeStartsComment() =>
       shoeComment()
@@ -226,11 +247,11 @@ shoeLispEscape()==
   $n:=$n+1
   $n >= $sz =>
     SoftShoeError([$linepos,:$n],'"lisp escape error")
-    shoeLeafError ($ln.$n)
+    shoeLeafError stringChar($ln,$n)
   a:=shoeReadLispString($ln,$n)
   a = nil =>
     SoftShoeError([$linepos,:$n],'"lisp escape error")
-    shoeLeafError ($ln.$n)
+    shoeLeafError stringChar($ln,$n)
   [exp,n]:=a
   n = nil =>
     $n:= $sz
@@ -300,7 +321,7 @@ shoeKeyTr w==
   shoeLeafKey w
  
 shoePossFloat (w)==
-  $n>=$sz or not shoeDigit $ln.$n => shoeLeafKey w
+  $n>=$sz or not shoeDigit stringChar($ln,$n) => shoeLeafKey w
   w := shoeInteger()
   shoeExponent('"0",w)
  
@@ -338,7 +359,7 @@ shoeS()==
   a := shoeEsc()
   b := 
     a =>
-      str := strconc(str,$ln.$n)
+      str := strconc(str,charString stringChar($ln,$n))
       $n := $n+1
       shoeS()
     shoeS()
@@ -348,7 +369,7 @@ shoeS()==
  
  
 shoeIdEnd(line,n)==
-  while n<#line and shoeIdChar line.n repeat 
+  while n<#line and shoeIdChar stringChar(line,n) repeat 
     n := n+1
   n
  
@@ -388,7 +409,7 @@ shoeInteger() ==
 shoeInteger1(zro) ==
   n := $n
   l := $sz
-  while $n <l and shoeDigit($ln.$n) repeat 
+  while $n <l and shoeDigit stringChar($ln,$n) repeat 
     $n := $n+1
   $n=l or QENUM($ln,$n)~=shoeESCAPE =>
     n = $n and zro => '"0"
@@ -403,7 +424,7 @@ shoeIntValue(s) ==
   ns := #s
   ival := 0
   for i in 0..ns-1 repeat
-    d := shoeOrdToNum s.i
+    d := shoeOrdToNum stringChar(s,i)
     ival := 10*ival + d
   ival
  
@@ -429,7 +450,7 @@ shoeExponent(a,w)==
     $n >= $sz =>
       $n := n
       shoeLeafFloat(a,w,0)
-    shoeDigit($ln.$n) =>
+    shoeDigit stringChar($ln,$n) =>
       e := shoeInteger()
       e := shoeIntValue e
       shoeLeafFloat(a,w,e)
@@ -439,7 +460,7 @@ shoeExponent(a,w)==
       $n >= $sz =>
 	$n := n
 	shoeLeafFloat(a,w,0)
-      shoeDigit($ln.$n) =>
+      shoeDigit stringChar($ln,$n) =>
 	e := shoeInteger()
 	e := shoeIntValue e
 	shoeLeafFloat(a,w,(c1=shoeMINUSCOMMENT => MINUS e; e))
@@ -454,7 +475,7 @@ shoeError()==
   SoftShoeError([$linepos,:n],
     strconc( '"The character whose number is ",
 	    toString QENUM($ln,n),'" is not a Boot character"))
-  shoeLeafError ($ln.n)
+  shoeLeafError stringChar($ln,n)
  
 shoeOrdToNum x== 
   digit? x
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|)
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index 6247a0b3..b3e98204 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -38,7 +38,7 @@ module tokens
 
 ++ converts `x', a 1-length symbol, to a character.
 char x ==
-  CHAR(symbolName x, 0)
+  stringChar(symbolName x, 0)
 
 shoeStartsId x ==
   alphabetic? x or x in [char "$", char "?", char "%"]
@@ -52,6 +52,9 @@ subString(s,f,n == nil) ==
   n = nil => subSequence(s,f)
   subSequence(s,f,f + n)
 
+QENUM(s,i) ==
+  codePoint stringChar(s,i)
+
 ++ Table of Boot keywords and their token name.
 shoeKeyWords == [  _
             ['"and","AND"] , _
@@ -131,28 +134,6 @@ shoeKeyTableCons()==
  
 shoeKeyTable:=shoeKeyTableCons()
  
-shoeSPACE       == QENUM('"    ", 0)
- 
-shoeESCAPE      == QENUM('"__  ", 0)
-shoeLispESCAPE      := QENUM('"!  ", 0)
- 
-shoeSTRING_CHAR == QENUM('"_"  ", 0)
- 
-shoePLUSCOMMENT == QENUM('"+   ", 0)
- 
-shoeMINUSCOMMENT == QENUM('"-   ", 0)
- 
-shoeDOT          == QENUM('".   ", 0)
- 
-shoeEXPONENT1   == QENUM('"E   ", 0)
- 
-shoeEXPONENT2   == QENUM('"e   ", 0)
- 
-shoeCLOSEPAREN  == QENUM('")   ", 0)
- 
---shoeCLOSEANGLE  == QENUM('">   ", 0)
-shoeTAB == 9
- 
 shoeInsert(s,d) ==
   l := #s
   h := QENUM(s,0)
@@ -312,6 +293,7 @@ for i in [ _
   ["setPart",   "SETELT"]  , _
   ["setUnion",   "UNION"]  , _
   ["strconc",  "CONCAT"]  , _
+  ["stringChar", "SCHAR"] , _
   ["string?",  "STRINGP"]  ,_
   ["subSequence", "SUBSEQ"] , _
   ["substitute",  "SUBST"]  , _
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index c8d9452f..0b4a196c 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -706,7 +706,7 @@ BOOTLOOP() ==
     stream:= _*TERMINAL_-IO_*
     PSTTOMC bRgen stream
     BOOTLOOP()
-  a.0 = char "]" => nil
+  stringChar(a,0) = char "]" => nil
   PSTTOMC [a]
   BOOTLOOP()
  
@@ -720,7 +720,7 @@ BOOTPO() ==
     stream:= _*TERMINAL_-IO_*
     PSTOUT bRgen stream
     BOOTPO()
-  a.0 = char "]" => nil
+  stringChar(a,0) = char "]" => nil
   PSTOUT [a]
   BOOTPO()