diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 19 | ||||
| -rw-r--r-- | src/boot/includer.boot | 2 | ||||
| -rw-r--r-- | src/boot/translator.boot | 8 | ||||
| -rw-r--r-- | src/boot/utility.boot | 13 | ||||
| -rw-r--r-- | src/interp/lexing.boot | 76 | ||||
| -rw-r--r-- | src/lisp/core.lisp.in | 2 |
6 files changed, 72 insertions, 48 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 7a530006..9d3b39d2 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,4 +1,21 @@ -2012-05-28 Gabriel Dos Reis <gdr@cse.tamu.edu> +2012-05-28 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/lexing.boot: Use makeToken directly. + (tokenInstall): Remove. + (getSpadIntegerToken): Lose parameter. Adjust callers. + (getNumberToken): Likewise. + (getArgumentDesignator): Likewise. + (getToken): Likewise. + (getSpadString): Likewise. + (getSpecial): Likewise. + (getGliph): Likewise. + (getIdentifier): Likewise. + * lisp/core.lisp.in ($stdio): New. + * boot/includer.boot: Use it. + * boot/translator.boot: Likewise. + * boot/utility.boot (stringPrefix?): New. + +2012-05-28 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/io.boot (findChar): Do not define here. * interp/match.boot (charPosition): Likewise. diff --git a/src/boot/includer.boot b/src/boot/includer.boot index 9b09f02b..d6b98584 100644 --- a/src/boot/includer.boot +++ b/src/boot/includer.boot @@ -79,7 +79,7 @@ shoeReadLispString(s,n) == -- write LINE to standard terminal I/O. shoeConsole line == - writeLine(line, _*TERMINAL_-IO_*) + writeLine(line,$stdio) shoeSpaces n == makeString(n,char ".") diff --git a/src/boot/translator.boot b/src/boot/translator.boot index 79228477..2302582d 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -691,12 +691,12 @@ PSTTOMC string== shoePCompileTrees shoeTransformString string BOOTLOOP() == - a := readLine _*STANDARD_-INPUT_* + a := readLine $stdin #a=0=> writeLine '"Boot Loop; to exit type ] " BOOTLOOP() shoePrefix? ('")console",a) => - stream:= _*TERMINAL_-IO_* + stream := $stdio PSTTOMC bRgen stream BOOTLOOP() stringChar(a,0) = char "]" => nil @@ -704,12 +704,12 @@ BOOTLOOP() == BOOTLOOP() BOOTPO() == - a := readLine _*STANDARD_-INPUT_* + a := readLine $stdin #a=0=> writeLine '"Boot Loop; to exit type ] " BOOTPO() shoePrefix? ('")console",a) => - stream:= _*TERMINAL_-IO_* + stream := $stdio PSTOUT bRgen stream BOOTPO() stringChar(a,0) = char "]" => nil diff --git a/src/boot/utility.boot b/src/boot/utility.boot index 6dfdb668..ec51df12 100644 --- a/src/boot/utility.boot +++ b/src/boot/utility.boot @@ -49,7 +49,8 @@ module utility (objectMember?, symbolMember?, stringMember?, setDifference, setUnion, setIntersection, symbolAssoc, applySubst, applySubst!, applySubstNQ, objectAssoc, remove, removeSymbol, atomic?, every?, any?, take, takeWhile, drop, - copyTree, finishLine, stringSuffix?, findChar, charPosition) where + copyTree, finishLine, stringPrefix?, stringSuffix?, + findChar, charPosition) where substitute: (%Thing,%Thing,%Thing) -> %Thing substitute!: (%Thing,%Thing,%Thing) -> %Thing append: (%List %Thing,%List %Thing) -> %List %Thing @@ -75,6 +76,7 @@ module utility (objectMember?, symbolMember?, stringMember?, -- firstNonblankPosition: (%String,%Short) -> %Maybe %Short firstBlankPosition: (%String,%Short) -> %Maybe %Short stringSuffix?: (%String,%String) -> %Maybe %Short + stringPrefix?: (%String,%String) -> %Maybe %Short %defaultReadAndLoadSettings() @@ -371,6 +373,15 @@ stringSuffix?(suf,str) == and/[stringChar(suf,i) = stringChar(str,j) for i in 0..n1-1 for j in n..] => n nil +++ If the string `s1' is a prefix of `s2', return its length which is +++ also the one-past-the-last index into of the last character in `s2'; +++ otherise return nil. +stringPrefix?(s1,s2) == + n1 := #s1 + n1 > #s2 => nil + and/[s1.i = s2.i for i in 0..(n1-1)] => n1 + nil + --% I/O ++ Add a newline character and flush the output stream. diff --git a/src/interp/lexing.boot b/src/interp/lexing.boot index 5adc0678..426e1fbc 100644 --- a/src/interp/lexing.boot +++ b/src/interp/lexing.boot @@ -180,12 +180,6 @@ $nextToken := makeToken() ++ Number of token in the buffer (0, 1, 2) $validTokens := 0 -tokenInstall(sym,typ,tok,nonblank == true) == - tokenSymbol(tok) := sym - tokenType(tok) := typ - tokenNonblank?(tok) := nonblank - tok - ++ Subroutine of getSpadIntegerToken. ++ Read a the characters of a decimal integer and returns its value. getDecimalNumberToken buf == @@ -217,16 +211,16 @@ radixSuffix? c == ++ format, where the radix is implicitly taken to be 10. Or the spelling ++ can explicitly specify a radix. That radix can be anything ++ in the range 2..36 -getSpadIntegerToken tok == +getSpadIntegerToken() == buf := MAKE_-ADJUSTABLE_-STRING 0 val := getDecimalNumberToken buf advanceChar!() if radixSuffix? currentChar() then val := getIntegerInRadix(buf,val) advanceChar!() - tokenInstall(val,'NUMBER,tok,#buf) + makeToken(val,'NUMBER,#buf) -getNumberToken tok == +getNumberToken() == buf := nil repeat buf := [currentChar(),:buf] @@ -234,30 +228,30 @@ getNumberToken tok == leave nil advanceChar!() sz := #buf -- keep track of digit count - tokenInstall(readIntegerIfCan listToString reverse! buf,'NUMBER,tok,sz) + makeToken(readIntegerIfCan listToString reverse! buf,'NUMBER,sz) -getArgumentDesignator tok == +getArgumentDesignator() == advanceChar!() - getNumberToken tok - tokenInstall(makeSymbol strconc('"#",formatToString('"~D",tokenSymbol tok)), - 'ARGUMENT_-DESIGNATOR,tok,$nonblank) + tok := getNumberToken() + makeToken(makeSymbol strconc('"#",formatToString('"~D",tokenSymbol tok)), + 'ARGUMENT_-DESIGNATOR,$nonblank) -getToken tok == +getToken() == not skipBlankChars() => nil tt := tokenLookaheadType currentChar() - tt is 'EOF => tokenInstall(nil,'_*EOF,tok,$nonblank) + tt is 'EOF => makeToken(nil,'_*EOF,$nonblank) tt is 'ESCAPE => advanceChar!() - getIdentifier(tok,true) - tt is 'ARGUMENT_-DESIGNATOR => getArgumentDesignator tok - tt is 'ID => getIdentifier(tok,false) - tt is 'NUM => getSpadIntegerToken tok - tt is 'STRING => getSpadString tok - tt is 'SPECIAL_-CHAR => getSpecial tok - getGliph(tok,tt) - -tryGetToken tok == - getToken tok => + getIdentifier(true) + tt is 'ARGUMENT_-DESIGNATOR => getArgumentDesignator() + tt is 'ID => getIdentifier(false) + tt is 'NUM => getSpadIntegerToken() + tt is 'STRING => getSpadString() + tt is 'SPECIAL_-CHAR => getSpecial() + getGliph(tt) + +tryGetToken() == + tok := getToken() => $validTokens := $validTokens + 1 tok nil @@ -265,13 +259,13 @@ tryGetToken tok == ++ Returns the current token or gets a new one if necessary currentToken() == $validTokens > 0 => $currentToken - tryGetToken $currentToken + $currentToken := tryGetToken() ++ Returns the token after the current token, or nil if there is none after nextToken() == currentToken() $validTokens > 1 => $nextToken - tryGetToken $nextToken + $nextToken := tryGetToken() matchToken(tok,typ,sym == nil) == tok ~= nil and symbolEq?(tokenType tok,typ) and @@ -290,11 +284,11 @@ matchNextToken(typ,sym == nil) == ++ Makes the next token be the current token. advanceToken() == - $validTokens = 0 => tryGetToken $currentToken + $validTokens = 0 => $currentToken := tryGetToken() $validTokens = 1 => $validTokens := $validTokens - 1 $priorToken := copyToken $currentToken - tryGetToken $currentToken + $currentToken := tryGetToken() $validTokens = 2 => $priorToken := copyToken $currentToken $currentToken := copyToken $nextToken @@ -312,9 +306,9 @@ currentSymbol() == tokenStackClear!() == $validTokens := 0 - tokenInstall(nil,nil,$currentToken,nil) - tokenInstall(nil,nil,$nextToken,nil) - tokenInstall(nil,nil,$priorToken,nil) + $currentToken := makeToken(nil,nil,nil) + $nextToken := makeToken(nil,nil,nil) + $priorToken := makeToken(nil,nil,nil) ++ Predicts the kind of token to follow, based on the given initial character tokenLookaheadType c == @@ -338,7 +332,7 @@ skipBlankChars() == advanceChar!() = nil => return false return true -getSpadString tok == +getSpadString() == buf := nil currentChar() ~= char "_"" => nil advanceChar!() @@ -349,17 +343,17 @@ getSpadString tok == sayBrightly '"close quote inserted" leave nil advanceChar!() - tokenInstall(listToString reverse! buf,'SPADSTRING,tok) + makeToken(listToString reverse! buf,'SPADSTRING) ++ Take a special character off the input stream. We let the type name ++ of each special character be the atom whose print name is the ++ character itself -getSpecial tok == +getSpecial() == c := currentChar() advanceChar!() - tokenInstall(c,'SPECIAL_-CHAR,tok) + makeToken(c,'SPECIAL_-CHAR) -getGliph(tok,gliphs) == +getGliph(gliphs) == buf := [currentChar()] advanceChar!() repeat @@ -368,7 +362,7 @@ getGliph(tok,gliphs) == gliphs := rest gliphs advanceChar!() s := makeSymbol listToString reverse! buf - return tokenInstall(s,'GLIPH,tok,$nonblank) + return makeToken(s,'GLIPH,$nonblank) Keywords == [ "or", "and", "isnt", "is", "where", "forall", "exist", "try", "assume", @@ -377,7 +371,7 @@ Keywords == [ "if", "iterate", "break", "from", "exit", "leave", "return", "not", "repeat", "until", "while", "for", "import", "inline" ] -getIdentifier(tok,esc?) == +getIdentifier(esc?) == buf := [currentChar()] advanceChar!() repeat @@ -396,7 +390,7 @@ getIdentifier(tok,esc?) == tt := not esc? and symbolMember?(s,Keywords) => 'KEYWORD 'IDENTIFIER - tokenInstall(s,tt,tok,$nonblank) + makeToken(s,tt,$nonblank) escapeKeywords: (%String,%Symbol) -> %String escapeKeywords(nm,id) == diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in index 4931c386..d869cbf4 100644 --- a/src/lisp/core.lisp.in +++ b/src/lisp/core.lisp.in @@ -99,6 +99,7 @@ ;; IO "$stdin" "$stdout" + "$stdio" "$InputStream" "$OutputStream" "$ErrorStream" @@ -531,6 +532,7 @@ (defparameter |$stdout| *standard-output*) (defparameter |$stdin| *standard-input*) +(defparameter |$stdio| *terminal-io*) (defparameter |$InputStream| (make-synonym-stream '*standard-input*)) (defparameter |$OutputStream| (make-synonym-stream '*standard-output*)) |