* 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.

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*))