diff options
Diffstat (limited to 'src/boot')
| -rw-r--r-- | src/boot/ast.boot | 21 | ||||
| -rw-r--r-- | src/boot/includer.boot | 18 | ||||
| -rw-r--r-- | src/boot/parser.boot | 86 | ||||
| -rw-r--r-- | src/boot/scanner.boot | 47 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 25 | ||||
| -rw-r--r-- | src/boot/strap/includer.clisp | 2 | ||||
| -rw-r--r-- | src/boot/strap/scanner.clisp | 2 | ||||
| -rw-r--r-- | src/boot/strap/tokens.clisp | 3 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 14 | ||||
| -rw-r--r-- | src/boot/tokens.boot | 68 | ||||
| -rw-r--r-- | src/boot/translator.boot | 38 |
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() |