From ddb282d424a2f17cbfb1370988fec88a1401d45e Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sun, 9 Oct 2011 01:06:31 +0000
Subject: 	* interp/lexing.boot: New tokenizer functions. 	*
 interp/parsing.lisp: Use them. 	* interp/metalex.lisp: Likewise. 
 (GET-SPECIAL-TOKEN): Remove. 	* interp/bootlex.lisp: Likewise.  Remove old
 tokenizers,

---
 src/interp/lexing.boot | 76 +++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 75 insertions(+), 1 deletion(-)

(limited to 'src/interp/lexing.boot')

diff --git a/src/interp/lexing.boot b/src/interp/lexing.boot
index a9a161c0..992239e3 100644
--- a/src/interp/lexing.boot
+++ b/src/interp/lexing.boot
@@ -244,7 +244,60 @@ tokenStackClear!() ==
   tokenInstall(nil,nil,$nextToken,nil)
   tokenInstall(nil,nil,$priorToken,nil)
 
---%
+++ Predicts the kind of token to follow, based on the given initial character
+tokenLookaheadType c ==
+  c = nil => 'EOF
+  c = char "__" => 'ESCAPE
+  c = char "#" and digit? nextChar() => 'ARGUMENT_-DESIGNATOR
+  digit? c => 'NUM
+  c = char "%" or c = char "?" or c = char "?" or alphabetic? c => 'ID
+  c = char "_"" => 'STRING
+  c = char " " or c = charByName "Tab" or c = charByName "Return" => 'WHITE
+  p := property(makeSymbol charString c,'GLIPH) => p
+  'SPECIAL_-CHAR
+
+skipBlankChars() ==
+  $nonblank := true
+  repeat
+    c := currentChar()
+    c = nil => return false
+    tokenLookaheadType c = 'WHITE =>
+      $nonblank := false
+      advanceChar!() = nil => return false
+    return true
+
+getSpadString tok ==
+  buf := nil
+  currentChar() ~= char "_"" => nil
+  advanceChar!()
+  repeat
+    currentChar() = char "_"" => leave nil
+    buf := [(currentChar() = char "__" => advanceChar!(); currentChar()),:buf]
+    advanceChar!() = nil =>
+      sayBrightly '"close quote inserted"
+      leave nil
+  advanceChar!()
+  tokenInstall(listToString reverse! buf,'SPADSTRING,tok)
+
+++ 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 ==
+  c := currentChar()
+  advanceChar!()
+  tokenInstall(c,'SPECIAL_-CHAR,tok)
+
+getGliph(tok,gliphs) ==
+  buf := [currentChar()]
+  advanceChar!()
+  repeat
+    gliphs := symbolAssoc(makeSymbol charString currentChar(),gliphs) =>
+      buf := [currentChar(),:buf]
+      gliphs := rest gliphs
+      advanceChar!()
+    s := makeSymbol listToString reverse! buf
+    return tokenInstall(property(s,'RENAMETOK) or s,'GLIPH,tok,$nonblank)
+
 Keywords == [
  "or", "and", "isnt", "is", "when", "where", "forall", "exist", "try",
   "has", "with", "add", "case", "in", "by", "pretend", "mod", "finally",
@@ -252,6 +305,27 @@ Keywords == [
     "if", "iterate", "break", "from", "exit", "leave", "return",
      "not", "repeat", "until", "while", "for", "import", "inline" ]
 
+getIdentifier(tok,esc?) ==
+  buf := [currentChar()]
+  advanceChar!()
+  repeat 
+    c := currentChar()
+    c = char "__" =>
+      advanceChar!() = nil => leave nil
+      buf := [currentChar(),:buf]
+      esc? := true
+      advanceChar!() = nil => leave nil
+    alphabetic? c or digit? c
+      or scalarMember?(c,[char "%",char "'",char "?",char "!"]) =>
+        buf := [c,:buf]
+        advanceChar!() = nil => leave nil
+    leave nil
+  s := makeSymbol listToString reverse! buf
+  tt :=
+    not esc? and symbolMember?(s,Keywords) => 'KEYWORD
+    'IDENTIFIER
+  tokenInstall(s,tt,tok,$nonblank)
+
 escapeKeywords(nm,id) ==
   symbolMember?(id,Keywords) => strconc('"__",nm)
   nm
-- 
cgit v1.2.3