aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/boot/ast.boot21
-rw-r--r--src/boot/includer.boot18
-rw-r--r--src/boot/parser.boot86
-rw-r--r--src/boot/scanner.boot47
-rw-r--r--src/boot/strap/ast.clisp25
-rw-r--r--src/boot/strap/includer.clisp2
-rw-r--r--src/boot/strap/scanner.clisp2
-rw-r--r--src/boot/strap/tokens.clisp3
-rw-r--r--src/boot/strap/translator.clisp14
-rw-r--r--src/boot/tokens.boot68
-rw-r--r--src/boot/translator.boot38
11 files changed, 175 insertions, 149 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index bd4402e0..c8f52c79 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -289,7 +289,7 @@ bfSTEP(id,fst,step,lst)==
lst = nil => []
integer? inc =>
pred :=
- MINUSP inc => "<"
+ inc < 0 => "<"
">"
[[pred,id,final]]
[['COND,[['MINUSP,inc],
@@ -640,7 +640,8 @@ bfISReverse(x,a) ==
bfIS1(lhs,rhs) ==
rhs = nil => ['NULL,lhs]
- string? rhs => bfAND [['STRINGP,lhs],["STRING=",lhs,rhs]]
+ bfString? rhs => bfAND [['STRINGP,lhs],["STRING=",lhs,rhs]]
+ bfChar? rhs => bfAND [['CHARACTERP,lhs],["CHAR=",lhs,rhs]]
integer? rhs => ['EQL,lhs,rhs]
atom rhs => ['PROGN,bfLetForm(rhs,lhs),'T]
rhs is ['QUOTE,a] =>
@@ -743,21 +744,29 @@ bfAND l ==
defQuoteId x==
x is ["QUOTE",:.] and symbol? second x
-bfSmintable x==
- integer? x or cons? x and first x in '(SIZE LENGTH char QENUM)
+bfChar? x ==
+ char? x or cons? x and first x in '(char abstractChar)
+bfSmintable x==
+ integer? x or cons? x and first x in '(SIZE LENGTH QENUM)
+
+bfString? x ==
+ string? x or cons? x and first x in '(charString symbolName toString)
+
bfQ(l,r)==
+ bfChar? l or bfChar? r => ["CHAR=",l,r]
bfSmintable l or bfSmintable r => ["EQL",l,r]
defQuoteId l or defQuoteId r => ["EQ",l,r]
l = nil => ["NULL",r]
r = nil => ["NULL",l]
l = true or r = true => ["EQ",l,r]
- string? l or string? r => ["STRING=",l,r]
+ bfString? l or bfString? r => ["STRING=",l,r]
["EQUAL",l,r]
bfLessp(l,r)==
l = 0 => ["PLUSP",r]
r = 0 => ["MINUSP", l]
+ bfChar? l or bfChar? r => ["CHAR<",l,r]
["<",l,r]
bfLambda(vars,body) ==
@@ -913,7 +922,7 @@ isDynamicVariable x ==
MEMQ(x,$constantIdentifiers) => false
CONSTANTP x => false
BOUNDP x or $activeNamespace = nil => true
- y := FIND_-SYMBOL(STRING x,$activeNamespace) => not CONSTANTP y
+ y := FIND_-SYMBOL(symbolName x,$activeNamespace) => not CONSTANTP y
true
false
diff --git a/src/boot/includer.boot b/src/boot/includer.boot
index 21498198..0e316b6f 100644
--- a/src/boot/includer.boot
+++ b/src/boot/includer.boot
@@ -70,7 +70,7 @@ module includer
++ or a character, as string. Otherwise, returns nil.
PNAME x ==
symbol? x => symbolName x
- char? x => STRING x
+ char? x => charString x
nil
-- close STREAM.
@@ -90,7 +90,7 @@ shoeReadLispString(s,n) ==
-- read a line from stream
shoeReadLine stream ==
- READ_-LINE(stream, nil, nil)
+ readLine(stream, nil, nil)
-- write LINE to standard terminal I/O.
shoeConsole line ==
@@ -171,9 +171,9 @@ $bStreamNil:=["nullstream"]
bStreamNull x==
x = nil or x is ["nullstream",:.] => true
while x is ["nonnullstream",:.] repeat
- st:=apply(second x,CDDR x)
- x.first := first st
- x.rest := rest st
+ st:=apply(second x,CDDR x)
+ x.first := first st
+ x.rest := rest st
x is ["nullstream",:.]
bMap(f,x) ==
@@ -188,8 +188,8 @@ bMap1(:z)==
shoeFileMap(f, fn)==
a:=shoeInputFile fn
a = nil =>
- shoeConsole strconc(fn,'" NOT FOUND")
- $bStreamNil
+ shoeConsole strconc(fn,'" NOT FOUND")
+ $bStreamNil
shoeConsole strconc('"READING ",fn)
shoeInclude bAddLineNumber(bMap(f,bRgen a),bIgen 0)
@@ -380,8 +380,8 @@ shoeElse1(keep,b,s)==
keep1 and b1=> shoeThen([true,:keep],[STTOMC command,:b],t)
shoeThen([false,:keep],[false,:b],t)
command :=shoeEndIf? string =>
- rest b = nil => shoeInclude t
- shoeThen(rest keep,rest b,t)
+ rest b = nil => shoeInclude t
+ shoeThen(rest keep,rest b,t)
keep1 and b1 => bAppend(shoeSimpleLine h,shoeElse(keep,b,t))
shoeElse(keep,b,t)
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index 14cbd4a0..ff0d0cc4 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -372,17 +372,17 @@ bpName() ==
++ QUOTE S-Expression
++ STRING
bpConstTok() ==
- shoeTokType $stok in '(INTEGER FLOAT) =>
- bpPush $ttok
- bpNext()
- $stok is ["LISP",:.] => bpPush %Lisp $ttok and bpNext()
- $stok is ["LISPEXP",:.] => bpPush $ttok and bpNext()
- $stok is ["LINE",:.] => bpPush ["+LINE", $ttok] and bpNext()
- bpEqPeek "QUOTE" =>
- bpNext()
- (bpSexp() or bpTrap()) and
- bpPush bfSymbol bpPop1()
- bpString()
+ shoeTokType $stok in '(INTEGER FLOAT) =>
+ bpPush $ttok
+ bpNext()
+ $stok is ["LISP",:.] => bpPush %Lisp $ttok and bpNext()
+ $stok is ["LISPEXP",:.] => bpPush $ttok and bpNext()
+ $stok is ["LINE",:.] => bpPush ["+LINE", $ttok] and bpNext()
+ bpEqPeek "QUOTE" =>
+ bpNext()
+ (bpSexp() or bpTrap()) and
+ bpPush bfSymbol bpPop1()
+ bpString()
++ Subroutine of bpExportItem. Parses tails of ExportItem.
@@ -515,18 +515,18 @@ bpAddTokens n==
[shoeTokConstruct("KEY","BACKTAB",shoeTokPosn $stok),:bpAddTokens(n+1)]
bpExceptions()==
- bpEqPeek "DOT" or bpEqPeek "QUOTE" or
- bpEqPeek "OPAREN" or bpEqPeek "CPAREN" or
- bpEqPeek "SETTAB" or bpEqPeek "BACKTAB"
- or bpEqPeek "BACKSET"
+ bpEqPeek "DOT" or bpEqPeek "QUOTE" or
+ bpEqPeek "OPAREN" or bpEqPeek "CPAREN" or
+ bpEqPeek "SETTAB" or bpEqPeek "BACKTAB"
+ or bpEqPeek "BACKSET"
bpSexpKey()==
- $stok is ["KEY",:.] and not bpExceptions()=>
- a := $ttok has SHOEINF
- a = nil => bpPush $ttok and bpNext()
- bpPush a and bpNext()
- false
+ $stok is ["KEY",:.] and not bpExceptions()=>
+ a := $ttok has SHOEINF
+ a = nil => bpPush $ttok and bpNext()
+ bpPush a and bpNext()
+ false
bpAnyId()==
bpEqKey "MINUS" and ($stok is ["INTEGER",:.] or bpTrap()) and
@@ -597,9 +597,9 @@ bpTyping() ==
++ Tagged:
++ Name : Typing
bpTagged()==
- bpApplication() and
- (bpEqKey "COLON" and (bpTyping() or bpTrap()) and
- bpPush bfTagged(bpPop2(),bpPop1()) or true)
+ bpApplication() and
+ (bpEqKey "COLON" and (bpTyping() or bpTrap()) and
+ bpPush bfTagged(bpPop2(),bpPop1()) or true)
bpExpt()== bpRightAssoc('(POWER),function bpTagged)
@@ -754,9 +754,9 @@ bpReturn()==
bpLogical()== bpLeftAssoc('(OR),function bpReturn)
bpExpression()==
- bpEqKey "COLON" and (bpLogical() and
- bpPush bfApplication ("COLON",bpPop1())
- or bpTrap()) or bpLogical()
+ bpEqKey "COLON" and (bpLogical() and
+ bpPush bfApplication ("COLON",bpPop1())
+ or bpTrap()) or bpLogical()
bpStatement()==
bpConditional function bpWhere or bpLoop()
@@ -764,13 +764,13 @@ bpStatement()==
or bpTry()
bpLoop()==
- bpIterators() and
- (bpCompMissing "REPEAT" and
- (bpWhere() or bpTrap()) and
- bpPush bfLp(bpPop2(),bpPop1()))
- or
- bpEqKey "REPEAT" and (bpLogical() or bpTrap()) and
- bpPush bfLoop1 bpPop1 ()
+ bpIterators() and
+ (bpCompMissing "REPEAT" and
+ (bpWhere() or bpTrap()) and
+ bpPush bfLp(bpPop2(),bpPop1()))
+ or
+ bpEqKey "REPEAT" and (bpLogical() or bpTrap()) and
+ bpPush bfLoop1 bpPop1 ()
bpSuchThat()==bpAndOr("BAR",function bpWhere,function bfSuchthat)
@@ -841,16 +841,16 @@ bpExit()==
bpDefinition()==
a:=bpState()
bpExit() =>
- bpEqPeek "DEF" =>
- bpRestore a
- bpDef()
- bpEqPeek "TDEF" =>
- bpRestore a
- bpTypeAliasDefition()
- bpEqPeek "MDEF" =>
- bpRestore a
- bpMdef()
- true
+ bpEqPeek "DEF" =>
+ bpRestore a
+ bpDef()
+ bpEqPeek "TDEF" =>
+ bpRestore a
+ bpTypeAliasDefition()
+ bpEqPeek "MDEF" =>
+ bpRestore a
+ bpMdef()
+ true
bpRestore a
false
diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot
index 46325a56..62e44f22 100644
--- a/src/boot/scanner.boot
+++ b/src/boot/scanner.boot
@@ -88,7 +88,7 @@ shoeNextLine(s)==
$n = nil => true
QENUM($ln,$n)=shoeTAB =>
a:=MAKE_-FULL_-CVEC (7-REM($n,8) ,'" ")
- $ln.$n:='" ".0
+ $ln.$n := char " "
$ln := strconc(a,$ln)
s1:=[[$ln,:rest $f],:$r]
shoeNextLine s1
@@ -124,7 +124,7 @@ shoeLineToks(s)==
shoeLispToken(s,string)==
string:=
- # string=0 or EQL(QENUM(string,0),QENUM('";",0))=> '""
+ # string=0 or QENUM(string,0) = QENUM('";",0) => '""
string
ln:=$ln
linepos:=$linepos
@@ -161,26 +161,25 @@ shoeToken () ==
n:=$n
ch:=$ln.$n
b:=
- shoeStartsComment() =>
- shoeComment()
- []
- shoeStartsNegComment() =>
- shoeNegComment()
- []
- c=shoeLispESCAPE =>
- shoeLispEscape()
- shoePunctuation c => shoePunct ()
- shoeStartsId ch => shoeWord (false)
- c=shoeSPACE =>
- shoeSpace ()
- []
- c = shoeSTRING_CHAR => shoeString ()
- shoeDigit ch => shoeNumber ()
- c=shoeESCAPE => shoeEscape()
- c=shoeTAB =>
- $n:=$n+1
- []
- shoeError ()
+ shoeStartsComment() =>
+ shoeComment()
+ []
+ shoeStartsNegComment() =>
+ shoeNegComment()
+ []
+ c=shoeLispESCAPE => shoeLispEscape()
+ shoePunctuation c => shoePunct()
+ shoeStartsId ch => shoeWord(false)
+ c=shoeSPACE =>
+ shoeSpace()
+ []
+ c = shoeSTRING_CHAR => shoeString()
+ shoeDigit ch => shoeNumber()
+ c=shoeESCAPE => shoeEscape()
+ c=shoeTAB =>
+ $n:=$n+1
+ []
+ shoeError()
b = nil => nil
dqUnit shoeConstructToken(ln,linepos,b,n)
@@ -404,8 +403,8 @@ shoeIntValue(s) ==
ns := #s
ival := 0
for i in 0..ns-1 repeat
- d := shoeOrdToNum s.i
- ival := 10*ival + d
+ d := shoeOrdToNum s.i
+ ival := 10*ival + d
ival
shoeNumber() ==
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index e491f548..6053c6b8 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -228,7 +228,7 @@
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Boolean|) |bfBeginsDollar|))
-(DEFUN |bfBeginsDollar| (|x|) (EQL (ELT (PNAME |x|) 0) (|char| '$)))
+(DEFUN |bfBeginsDollar| (|x|) (CHAR= (ELT (PNAME |x|) 0) (|char| '$)))
(DEFUN |compFluid| (|id|) (LIST 'FLUID |id|))
@@ -959,9 +959,12 @@
(RETURN
(COND
((NULL |rhs|) (LIST 'NULL |lhs|))
- ((STRINGP |rhs|)
+ ((|bfString?| |rhs|)
(|bfAND| (LIST (LIST 'STRINGP |lhs|)
(LIST 'STRING= |lhs| |rhs|))))
+ ((|bfChar?| |rhs|)
+ (|bfAND| (LIST (LIST 'CHARACTERP |lhs|)
+ (LIST 'CHAR= |lhs| |rhs|))))
((INTEGERP |rhs|) (LIST 'EQL |lhs| |rhs|))
((ATOM |rhs|) (LIST 'PROGN (|bfLetForm| |rhs| |lhs|) 'T))
((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'QUOTE)
@@ -1201,24 +1204,35 @@
(DEFUN |defQuoteId| (|x|)
(AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE) (SYMBOLP (CADR |x|))))
+(DEFUN |bfChar?| (|x|)
+ (OR (CHARACTERP |x|)
+ (AND (CONSP |x|) (MEMQ (CAR |x|) '(|char| |abstractChar|)))))
+
(DEFUN |bfSmintable| (|x|)
(OR (INTEGERP |x|)
- (AND (CONSP |x|) (MEMQ (CAR |x|) '(SIZE LENGTH |char| QENUM)))))
+ (AND (CONSP |x|) (MEMQ (CAR |x|) '(SIZE LENGTH QENUM)))))
+
+(DEFUN |bfString?| (|x|)
+ (OR (STRINGP |x|)
+ (AND (CONSP |x|)
+ (MEMQ (CAR |x|) '(|charString| |symbolName| |toString|)))))
(DEFUN |bfQ| (|l| |r|)
(COND
+ ((OR (|bfChar?| |l|) (|bfChar?| |r|)) (LIST 'CHAR= |l| |r|))
((OR (|bfSmintable| |l|) (|bfSmintable| |r|)) (LIST 'EQL |l| |r|))
((OR (|defQuoteId| |l|) (|defQuoteId| |r|)) (LIST 'EQ |l| |r|))
((NULL |l|) (LIST 'NULL |r|))
((NULL |r|) (LIST 'NULL |l|))
((OR (EQ |l| T) (EQ |r| T)) (LIST 'EQ |l| |r|))
- ((OR (STRINGP |l|) (STRINGP |r|)) (LIST 'STRING= |l| |r|))
+ ((OR (|bfString?| |l|) (|bfString?| |r|)) (LIST 'STRING= |l| |r|))
(T (LIST 'EQUAL |l| |r|))))
(DEFUN |bfLessp| (|l| |r|)
(COND
((EQL |l| 0) (LIST 'PLUSP |r|))
((EQL |r| 0) (LIST 'MINUSP |l|))
+ ((OR (|bfChar?| |l|) (|bfChar?| |r|)) (LIST 'CHAR< |l| |r|))
(T (LIST '< |l| |r|))))
(DEFUN |bfLambda| (|vars| |body|)
@@ -1570,7 +1584,8 @@
((MEMQ |x| |$constantIdentifiers|) NIL)
((CONSTANTP |x|) NIL)
((OR (BOUNDP |x|) (NULL |$activeNamespace|)) T)
- ((SETQ |y| (FIND-SYMBOL (STRING |x|) |$activeNamespace|))
+ ((SETQ |y|
+ (FIND-SYMBOL (SYMBOL-NAME |x|) |$activeNamespace|))
(NOT (CONSTANTP |y|)))
(T T)))
(T NIL)))))
diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp
index 99c6a5fb..06904a5b 100644
--- a/src/boot/strap/includer.clisp
+++ b/src/boot/strap/includer.clisp
@@ -252,7 +252,7 @@
(DEFUN |shoePlainLine?| (|s|)
(COND
((EQL (LENGTH |s|) 0) T)
- (T (NOT (EQL (ELT |s| 0) (|char| '|)|))))))
+ (T (NOT (CHAR= (ELT |s| 0) (|char| '|)|))))))
(DEFUN |shoeSay?| (|s|) (|shoePrefix?| ")say" |s|))
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index 0fe763ad..1319d3c9 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -51,7 +51,7 @@
((NULL |$n|) T)
((EQL (QENUM |$ln| |$n|) |shoeTAB|)
(SETQ |a| (MAKE-FULL-CVEC (- 7 (REM |$n| 8)) " "))
- (SETF (ELT |$ln| |$n|) (ELT " " 0))
+ (SETF (ELT |$ln| |$n|) (|char| '| |))
(SETQ |$ln| (CONCAT |a| |$ln|))
(SETQ |s1| (CONS (CONS |$ln| (CDR |$f|)) |$r|))
(|shoeNextLine| |s1|))
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 58a9b3d7..45c988f4 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -213,12 +213,13 @@
(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
(LET ((|bfVar#9|
- (LIST (LIST '|abs| 'ABS)
+ (LIST (LIST '|abs| 'ABS) (LIST '|abstractChar| 'CODE-CHAR)
(LIST '|alphabetic?| 'ALPHA-CHAR-P)
(LIST '|alphanumeric?| 'ALPHANUMERICP)
(LIST '|and| 'AND) (LIST '|append| 'APPEND)
(LIST '|apply| 'APPLY) (LIST '|atom| 'ATOM)
(LIST '|canonicalFilename| 'PROBE-FILE)
+ (LIST '|charString| 'STRING)
(LIST '|char?| 'CHARACTERP)
(LIST '|codePoint| 'CHAR-CODE) (LIST '|cons?| 'CONSP)
(LIST '|copy| 'COPY) (LIST '|croak| 'CROAK)
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index c941265d..51bfd7d4 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -604,7 +604,7 @@
(PROGN
(SETQ |$currentModuleName| |m|)
(SETQ |$foreignsDefsForCLisp| NIL)
- (CONS (LIST 'PROVIDE (STRING |m|))
+ (CONS (LIST 'PROVIDE (SYMBOL-NAME |m|))
(LET ((|bfVar#11| NIL) (|bfVar#10| |ds|)
(|d| NIL))
(LOOP
@@ -625,8 +625,8 @@
(COND
((NOT (STRING= (|getOptionValue| '|import|)
"skip"))
- (|bootImport| (STRING |m|))))
- (LIST (LIST 'IMPORT-MODULE (STRING |m|))))))
+ (|bootImport| (SYMBOL-NAME |m|))))
+ (LIST (LIST 'IMPORT-MODULE (SYMBOL-NAME |m|))))))
(|%ImportSignature|
(LET ((|x| (CADR |b|)) (|sig| (CADDR |b|)))
(|genImportDeclaration| |x| |sig|)))
@@ -702,8 +702,8 @@
(|%Namespace|
(LET ((|n| (CADR |b|)))
(PROGN
- (SETQ |$activeNamespace| (STRING |n|))
- (LIST (LIST 'IN-PACKAGE (STRING |n|))))))
+ (SETQ |$activeNamespace| (SYMBOL-NAME |n|))
+ (LIST (LIST 'IN-PACKAGE (SYMBOL-NAME |n|))))))
(|%Lisp| (LET ((|s| (CADR |b|)))
(|shoeReadLispString| |s| 0)))
(T (LIST (|translateToplevelExpression| |b|)))))))))
@@ -1230,7 +1230,7 @@
(COND
(|b| (SETQ |stream| *TERMINAL-IO*)
(PSTTOMC (|bRgen| |stream|)) (BOOTLOOP))
- ((EQUAL (ELT |a| 0) (ELT "]" 0)) NIL)
+ ((CHAR= (ELT |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))
- ((EQUAL (ELT |a| 0) (ELT "]" 0)) NIL)
+ ((CHAR= (ELT |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 c931953a..08b5854c 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -148,46 +148,46 @@ shoeCLOSEPAREN == QENUM('") ", 0)
shoeTAB == 9
shoeInsert(s,d) ==
- l := #s
- h := QENUM(s,0)
- u := d.h
- n := #u
- k:=0
- while l <= #u.k repeat
- k:=k+1
- v := newVector(n+1)
- for i in 0..k-1 repeat
- v.i := u.i
- v.k := s
- for i in k..n-1 repeat
- v.(i+1) := u.i
- d.h := v
- s
+ l := #s
+ h := QENUM(s,0)
+ u := d.h
+ n := #u
+ k:=0
+ while l <= #u.k repeat
+ k:=k+1
+ v := newVector(n+1)
+ for i in 0..k-1 repeat
+ v.i := u.i
+ v.k := s
+ for i in k..n-1 repeat
+ v.(i+1) := u.i
+ d.h := v
+ s
shoeDictCons()==
- l := HKEYS shoeKeyTable
- d :=
- a := newVector 256
- b := newVector 1
- b.0 := newString 0
- for i in 0..255 repeat
- a.i := b
- a
- for s in l repeat
- shoeInsert(s,d)
- d
+ l := HKEYS shoeKeyTable
+ d :=
+ a := newVector 256
+ b := newVector 1
+ b.0 := newString 0
+ for i in 0..255 repeat
+ a.i := b
+ a
+ for s in l repeat
+ shoeInsert(s,d)
+ d
shoeDict:=shoeDictCons()
shoePunCons()==
- listing := HKEYS shoeKeyTable
- a := MAKE_-BVEC 256
- 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)
- a
+ listing := HKEYS shoeKeyTable
+ a := MAKE_-BVEC 256
+ 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)
+ a
shoePun:=shoePunCons()
@@ -254,6 +254,7 @@ for i in [ _
for i in [ _
["abs", "ABS"], _
+ ["abstractChar", "CODE-CHAR"], _
["alphabetic?", "ALPHA-CHAR-P"], _
["alphanumeric?", "ALPHANUMERICP"], _
["and", "AND"] , _
@@ -261,6 +262,7 @@ for i in [ _
["apply", "APPLY"] , _
["atom", "ATOM"] , _
["canonicalFilename", "PROBE-FILE"], _
+ ["charString", "STRING"] , _
["char?", "CHARACTERP"] , _
["codePoint", "CHAR-CODE"], _
["cons?", "CONSP"] , _
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 5d2e0a71..085e6755 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -416,13 +416,13 @@ translateToplevel(b,export?) ==
%Module(m,ds) =>
$currentModuleName := m
$foreignsDefsForCLisp := nil
- [["PROVIDE", STRING m],
+ [["PROVIDE", symbolName m],
:[first translateToplevel(d,true) for d in ds]]
%Import(m) =>
if getOptionValue "import" ~= '"skip" then
- bootImport STRING m
- [["IMPORT-MODULE", STRING m]]
+ bootImport symbolName m
+ [["IMPORT-MODULE", symbolName m]]
%ImportSignature(x, sig) =>
genImportDeclaration(x, sig)
@@ -450,8 +450,8 @@ translateToplevel(b,export?) ==
%Structure(t,alts) => [bfCreateDef alt for alt in alts]
%Namespace n =>
- $activeNamespace := STRING n
- [["IN-PACKAGE",STRING n]]
+ $activeNamespace := symbolName n
+ [["IN-PACKAGE",symbolName n]]
%Lisp s => shoeReadLispString(s,0)
@@ -697,30 +697,30 @@ PSTTOMC string==
shoePCompileTrees shoeTransformString string
BOOTLOOP() ==
- a:=READ_-LINE()
+ a := readLine()
#a=0=>
- writeLine '"Boot Loop; to exit type ] "
- BOOTLOOP()
+ writeLine '"Boot Loop; to exit type ] "
+ BOOTLOOP()
b:=shoePrefix? ('")console",a)
b =>
- stream:= _*TERMINAL_-IO_*
- PSTTOMC bRgen stream
- BOOTLOOP()
- a.0='"]".0 => nil
+ stream:= _*TERMINAL_-IO_*
+ PSTTOMC bRgen stream
+ BOOTLOOP()
+ a.0 = char "]" => nil
PSTTOMC [a]
BOOTLOOP()
BOOTPO() ==
- a:=READ_-LINE()
+ a := readLine()
#a=0=>
- writeLine '"Boot Loop; to exit type ] "
- BOOTPO()
+ writeLine '"Boot Loop; to exit type ] "
+ BOOTPO()
b:=shoePrefix? ('")console",a)
b =>
- stream:= _*TERMINAL_-IO_*
- PSTOUT bRgen stream
- BOOTPO()
- a.0='"]".0 => nil
+ stream:= _*TERMINAL_-IO_*
+ PSTOUT bRgen stream
+ BOOTPO()
+ a.0 = char "]" => nil
PSTOUT [a]
BOOTPO()