Symbol table

1 files changed, 52 insertions, 23 deletions

diff --git a/ppc.fun b/ppc.fun
index c3b7412..b3428c2 100644
--- a/ppc.fun
+++ b/ppc.fun
@@ -3,25 +3,42 @@ struct
 
   structure T = T
 
-  type mLayers = (string * T.S.pos) list
+  val symtab = T.initSymtab ()
+
+  fun ?? id = T.ST.getStr symtab id
+  val ? = fn z =>
+    let
+      fun f (out, id) = Printf out `(??id) %
+    in
+      bind A1 f
+    end z
+
+  val Ptk = fn z =>
+  let
+    fun f (out, tk) = Printf out T.Ptk symtab tk %
+  in
+    bind A1 f
+  end z
+
+  type mLayers = (int * T.S.pos) list
   datatype tkPos = TkPos of T.S.pos * mLayers
 
   type macroBody = (T.token * tkPos) list
   datatype macro =
     ObjMacro of macroBody |
-    FuncMacro of string list * macroBody
+    FuncMacro of int list * macroBody
 
   datatype layer = Stream of T.S.t | Tokens of (T.token * tkPos) list
 
   type t = {
     buffer: layer list,
 
-    macros: (string, bool * T.S.pos * macro) Tree.t,
+    macros: (int, bool * T.S.pos * macro) Tree.t,
     debugMode: bool,
     incDirs: string list
   }
 
-  val macroCompare = fn s1 => fn s2 => String.compare (s1, s2)
+  val macroCompare = fn m1 => fn m2 => Int.compare (m1, m2)
   val insertMacro = Tree.insert macroCompare
   val macrosLookup = fn z => Tree.lookup2 macroCompare z
 
@@ -42,7 +59,7 @@ struct
   val PlayersU = fn z =>
   let
     fun PlayersU (out, ((macroName, pos) :: layers)) =
-      Printf out F `"\tfrom " `macroName `" at " T.S.Ppos pos `"\n"
+      Printf out F `"\tfrom " ?macroName `" at " T.S.Ppos pos `"\n"
         A1 PlayersU layers %
       | PlayersU (_, []) = ()
   in
@@ -63,7 +80,7 @@ struct
   let
     fun Pcl (out, cl) =
       case cl of
-        Ctk tk => Printf out T.Ptk tk %
+        Ctk tk => Printf out Ptk tk %
       | Cid => Printf out `"identifier" %
       | Cconst => Printf out `"constant" %
       | Cunop => Printf out `"unary operator" %
@@ -96,7 +113,7 @@ struct
     { buffer = [Stream $ T.S.create fname], macros = Tree.empty, debugMode,
         incDirs }
 
-  fun printLayer out (macro, pos) = Printf out `macro `" " T.S.Ppos pos %
+  fun printLayer out (macro, pos) = Printf out ?macro `" " T.S.Ppos pos %
 
   fun printLayers _ [] = ()
     | printLayers out [layer] = printLayer out layer
@@ -184,7 +201,7 @@ struct
       Printf out F R off A0 Ppos %
     else
       ();
-    Printf out I col' `":" T.Ptk tk `" ";
+    Printf out I col' `":" Ptk tk `" ";
     (off, layers', (fname', line'))
   end
 
@@ -195,7 +212,7 @@ struct
       fun Players (out, x, y) = ignore $ PlayersCompact (out, x, y)
     in
       Printf out F `"expanding (" A2 Players NONE (rev mLayers)
-        `") macro " `id %
+        `") macro " ?id %
     end
   in
     bind A2 printMacroHeader
@@ -257,7 +274,7 @@ struct
   )
     | getTokenNoexpand (P as { buffer = Stream head :: _, ... }: t) =
   let
-    val (tk, pos, head) = T.getToken head
+    val (tk, pos, head) = T.getToken symtab head
   in
     (tk, pos2tkPos pos, updatePpc P u#buffer (updateH head) %)
   end
@@ -430,7 +447,7 @@ struct
 
   fun parseDefineMacroArgs ppc =
   let
-    datatype arg = Arg of string * tkPos | LastArg of string * tkPos
+    datatype arg = Arg of int * tkPos | LastArg of int * tkPos
 
     fun parseArg ppc =
     let
@@ -475,8 +492,8 @@ struct
     fun printParams out =
     let
       fun printParams' [] = ()
-        | printParams' [p] = Printf out `p %
-        | printParams' (p :: ps) = (Printf out `p `", "; printParams' ps)
+        | printParams' [p] = Printf out ?p %
+        | printParams' (p :: ps) = (Printf out ?p `", "; printParams' ps)
     in
       Printf out `"(";
       printParams' params;
@@ -495,10 +512,10 @@ struct
     val macroName =
       case macroName of T.Id id => id | _ => raise Unreachable
 
-    val () = dprintf ppc PDP T.S.Ppos pos `": #define " `macroName %
+    val () = dprintf ppc PDP T.S.Ppos pos `": #define " ?macroName %
 
     val parser =
-      if isFuncMacroDefine (size macroName) pos ppc then
+      if isFuncMacroDefine (size $ ??macroName) pos ppc then
         parseDefineFuncMacro
       else
         parseDefineObjMacro
@@ -529,7 +546,7 @@ struct
     case prevVal of
       SOME (_, pos', macro') =>
         if not $ eqMacro (macro, macro') then (
-            warning (pos2tkPos pos) `macroName `" macro redefinition" %;
+            warning (pos2tkPos pos) ?macroName `" macro redefinition" %;
             printf F `"See " T.S.Ppos pos' %
         ) else
           ()
@@ -684,7 +701,7 @@ struct
     let
       fun print [] = ()
         | print ((p, args) :: tail) = (
-        Printf out `p `": ";
+        Printf out ?p `": ";
         Printf out PtokenL 1 args;
         print tail
       )
@@ -732,7 +749,7 @@ struct
       fun def dl = collect (level + dl) ppc ((tk, pos) :: acc)
 
       fun unexpected tk prevTk =
-        error pos `"unexpected " T.Ptk tk `" inside " T.Ptk prevTk %
+        error pos `"unexpected " Ptk tk `" inside " Ptk prevTk %
 
       fun handleIfdef ifTk =
         if tk = T.PpcElif then
@@ -837,7 +854,7 @@ struct
         (not defined, "ifndef")
   in
     dprintf ppc PDP T.S.Ppos ifPos `": #" `form `" "
-        `id `" -> " B cond `"\n"%;
+        ?id `" -> " B cond `"\n"%;
     (cond, ppc)
   end
 
@@ -884,7 +901,7 @@ struct
     val (_, _, ppc) = getClassNoexpand ppc [Ctk T.NewLine]
     val (prevVal, macros) = Tree.delete macroCompare (#macros ppc) id
   in
-    dprintf ppc PDP `"#undef " `id `"\n" %;
+    dprintf ppc PDP `"#undef " ?id `"\n" %;
     case prevVal of
       NONE => warning pos
         `"#undef: no macro with provided name was defined" %
@@ -892,7 +909,7 @@ struct
     updatePpc ppc s#macros macros %
   end
 
-  and handleStray (tk, pos) _ = errorSpos pos `"stray " T.Ptk tk %
+  and handleStray (tk, pos) _ = errorSpos pos `"stray " Ptk tk %
 
   and handlePragma (_, pos) ppc = (
     dprintf ppc PDP `"#pragma -> ignored\n";
@@ -962,7 +979,7 @@ struct
     | getToken (P as { buffer = [], ... }: t) = (T.EOS, dummyEOSpos, P)
     | getToken (P as { buffer = Stream head :: tail, ... }: t) =
   let
-    val (tk, pos, head) = T.getToken head
+    val (tk, pos, head) = T.getToken symtab head
   in
     case (tk, tail) of
       (T.EOS, []) =>
@@ -1004,5 +1021,17 @@ struct
     printf A2 debugPrint' startCache ppc F %
   end
 
-  val getToken = getTokenSkipNL
+  fun getToken ppc =
+  let
+    val (tk, pos, ppc) = getTokenSkipNL ppc
+    fun def () = (tk, pos, ppc)
+  in
+    case tk of
+      T.Id id => (
+        case T.ST.isKw symtab id of
+          SOME kw => (kw, pos, ppc)
+        | NONE => def ()
+      )
+    | _ => def ()
+  end
 end