From 68441ed372470b7d3eb3d24178b61dc16bc6978e Mon Sep 17 00:00:00 2001 From: dos-reis Date: Wed, 29 Dec 2010 22:47:45 +0000 Subject: More char cleanups --- src/boot/scanner.boot | 101 +++++++++--------------- src/boot/strap/scanner.clisp | 184 ++++++++++++++++++------------------------- src/boot/strap/tokens.clisp | 6 +- src/boot/tokens.boot | 7 +- 4 files changed, 117 insertions(+), 181 deletions(-) (limited to 'src/boot') diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot index 96dd03f6..3b521975 100644 --- a/src/boot/scanner.boot +++ b/src/boot/scanner.boot @@ -38,26 +38,7 @@ 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 +shoeTAB == abstractChar 9 -- converts X to double-float. double x == @@ -107,7 +88,7 @@ shoeNextLine(s)== $n:=STRPOSL('" ",$ln,0,true) $sz :=# $ln $n = nil => true - QENUM($ln,$n)=shoeTAB => + stringChar($ln,$n) = shoeTAB => a:=MAKE_-FULL_-CVEC (7-REM($n,8) ,'" ") $ln.$n := char " " $ln := strconc(a,$ln) @@ -125,8 +106,7 @@ shoeLineToks(s)== $linepos:local:=s not shoeNextLine s => [nil,:nil] $n = nil => shoeLineToks $r - fst:=QENUM($ln,0) - EQL(fst,shoeCLOSEPAREN)=> + stringChar($ln,0) = char ")" => command:=shoeLine? $ln=> dq:=dqUnit shoeConstructToken ($ln,$linepos,shoeLeafLine command,0) @@ -145,7 +125,7 @@ shoeLineToks(s)== shoeLispToken(s,string)== string:= - # string=0 or QENUM(string,0) = QENUM('";",0) => '"" + #string = 0 or stringChar(string,0) = char ";" => '"" string ln:=$ln linepos:=$linepos @@ -157,11 +137,10 @@ shoeAccumulateLines(s,string)== not shoeNextLine s => [s,:string] $n = nil => shoeAccumulateLines($r,string) # $ln=0 => shoeAccumulateLines($r,string) - fst:=QENUM($ln,0) - EQL(fst,shoeCLOSEPAREN)=> + stringChar($ln,0) = char ")" => command:=shoeLisp? $ln command and #command>0 => - EQL(QENUM(command,0),QENUM('";",0))=> + stringChar(command,0) = char ";" => shoeAccumulateLines($r,string) a:=STRPOS('";",command,0,nil) a=> @@ -176,10 +155,9 @@ shoeCloser t == shoeKeyWord t in '(CPAREN CBRACK) shoeToken () == - ln:=$ln - c:=QENUM($ln,$n) - linepos:=$linepos - n:=$n + ln := $ln + linepos := $linepos + n := $n ch := stringChar($ln,$n) b:= shoeStartsComment() => @@ -188,16 +166,16 @@ shoeToken () == shoeStartsNegComment() => shoeNegComment() [] - c=shoeLispESCAPE => shoeLispEscape() - shoePunctuation c => shoePunct() + ch = char "!" => shoeLispEscape() + shoePunctuation codePoint ch => shoePunct() shoeStartsId ch => shoeWord(false) - c=shoeSPACE => + ch = char " " => shoeSpace() [] - c = shoeSTRING_CHAR => shoeString() - shoeDigit ch => shoeNumber() - c=shoeESCAPE => shoeEscape() - c=shoeTAB => + ch = char "_"" => shoeString() + digit? ch => shoeNumber() + ch = char "__" => shoeEscape() + ch = shoeTAB => $n:=$n+1 [] shoeError() @@ -282,19 +260,19 @@ shoeEsc()== shoeStartsComment()== $n < $sz => - QENUM($ln,$n) = shoePLUSCOMMENT => + stringChar($ln,$n) = char "+" => www:=$n+1 www >= $sz => false - QENUM($ln,www) = shoePLUSCOMMENT + stringChar($ln,www) = char "+" false false shoeStartsNegComment()== $n < $sz => - QENUM($ln,$n) = shoeMINUSCOMMENT => + stringChar($ln,$n) = char "-" => www:=$n+1 www >= $sz => false - QENUM($ln,www) = shoeMINUSCOMMENT + stringChar($ln,www) = char "-" false false @@ -321,7 +299,7 @@ shoeKeyTr w== shoeLeafKey w shoePossFloat (w)== - $n>=$sz or not shoeDigit stringChar($ln,$n) => shoeLeafKey w + $n>=$sz or not digit? stringChar($ln,$n) => shoeLeafKey w w := shoeInteger() shoeExponent('"0",w) @@ -365,24 +343,17 @@ shoeS()== shoeS() strconc(str,b) - - - shoeIdEnd(line,n)== while n<#line and shoeIdChar stringChar(line,n) repeat n := n+1 n - -shoeDigit x== - digit? x - shoeW(b)== n1 := $n $n := $n+1 l := $sz endid := shoeIdEnd($ln,$n) - endid=l or QENUM($ln,endid) ~= shoeESCAPE => + endid=l or stringChar($ln,endid) ~= char "__" => $n := endid [b,subString($ln,n1,endid-n1)] str := subString($ln,n1,endid-n1) @@ -409,9 +380,9 @@ shoeInteger() == shoeInteger1(zro) == n := $n l := $sz - while $n + $n=l or stringChar($ln,$n) ~= char "__" => n = $n and zro => '"0" subString($ln,n,$n-n) str := subString($ln,n,$n-n) @@ -431,10 +402,10 @@ shoeIntValue(s) == shoeNumber() == a := shoeInteger() $n >= $sz => shoeLeafInteger a - $floatok and QENUM($ln,$n) = shoeDOT => + $floatok and stringChar($ln,$n) = char "." => n := $n $n := $n+1 - $n < $sz and QENUM($ln,$n)=shoeDOT => + $n < $sz and stringChar($ln,$n) = char "." => $n := n shoeLeafInteger a w := shoeInteger1(true) @@ -444,26 +415,26 @@ shoeNumber() == shoeExponent(a,w)== $n >= $sz => shoeLeafFloat(a,w,0) n := $n - c := QENUM($ln,$n) - c = shoeEXPONENT1 or c = shoeEXPONENT2 => + c := stringChar($ln,$n) + c = char "E" or c = char "e" => $n := $n+1 $n >= $sz => $n := n shoeLeafFloat(a,w,0) - shoeDigit stringChar($ln,$n) => + digit? stringChar($ln,$n) => e := shoeInteger() e := shoeIntValue e shoeLeafFloat(a,w,e) - c1 := QENUM($ln,$n) - c1 = shoePLUSCOMMENT or c1 = shoeMINUSCOMMENT => + c1 := stringChar($ln,$n) + c1 = char "+" or c1 = char "-" => $n := $n+1 $n >= $sz => $n := n shoeLeafFloat(a,w,0) - shoeDigit stringChar($ln,$n) => + digit? stringChar($ln,$n) => e := shoeInteger() e := shoeIntValue e - shoeLeafFloat(a,w,(c1=shoeMINUSCOMMENT => MINUS e; e)) + shoeLeafFloat(a,w,(c1 = char "-" => MINUS e; e)) $n := n shoeLeafFloat(a,w,0) -- FIXME: Missing alternative. @@ -474,7 +445,7 @@ shoeError()== $n:=$n+1 SoftShoeError([$linepos,:n], strconc( '"The character whose number is ", - toString QENUM($ln,n),'" is not a Boot character")) + toString codePoint stringChar($ln,n),'" is not a Boot character")) shoeLeafError stringChar($ln,n) shoeOrdToNum x== @@ -490,7 +461,7 @@ shoeMatch(l,i) == shoeSubStringMatch(l,shoeDict,i) shoeSubStringMatch (l,d,i)== - h := QENUM(l, i) + h := codePoint stringChar(l, i) u := d.h ll := #l done := false @@ -502,7 +473,7 @@ shoeSubStringMatch (l,d,i)== ls+i > ll => false eql := true for k in 1..ls-1 while eql repeat - eql := QENUM(s,k) = QENUM(l,k+i) + eql := stringChar(s,k) = stringChar(l,k+i) eql => s1:=s true 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)))) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index b3c11228..f1421813 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -20,8 +20,6 @@ ((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) @@ -71,7 +69,7 @@ (RETURN (PROGN (SETQ |l| (LENGTH |s|)) - (SETQ |h| (QENUM |s| 0)) + (SETQ |h| (CHAR-CODE (SCHAR |s| 0))) (SETQ |u| (ELT |d| |h|)) (SETQ |n| (LENGTH |u|)) (SETQ |k| 0) @@ -145,7 +143,7 @@ (RETURN NIL)) (T (COND ((NOT (|shoeStartsId| (ELT |k| 0))) - (BVEC-SETELT |a| (QENUM |k| 0) 1))))) + (BVEC-SETELT |a| (CHAR-CODE (SCHAR |k| 0)) 1))))) (SETQ |bfVar#6| (CDR |bfVar#6|)))) |a|)))) diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index b3e98204..d3c03de4 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -52,9 +52,6 @@ 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"] , _ @@ -136,7 +133,7 @@ shoeKeyTable:=shoeKeyTableCons() shoeInsert(s,d) == l := #s - h := QENUM(s,0) + h := codePoint stringChar(s,0) u := d.h n := #u k:=0 @@ -173,7 +170,7 @@ shoePunCons()== for i in 0..255 repeat BVEC_-SETELT(a,i,0) for k in listing repeat if not shoeStartsId k.0 - then BVEC_-SETELT(a,QENUM(k,0),1) + then BVEC_-SETELT(a,codePoint stringChar(k,0),1) a shoePun:=shoePunCons() -- cgit v1.2.3