Function-like macros

1 files changed, 87 insertions, 73 deletions

diff --git a/tokenizer.fun b/tokenizer.fun
index 12b3257..9d7f8fc 100644
--- a/tokenizer.fun
+++ b/tokenizer.fun
@@ -114,25 +114,25 @@ struct
 
     CommentStart |
 
-    CppInclude |
-    CppDefine |
-    CppUndef |
-    CppIf |
-    CppIfdef |
-    CppIfndef |
-    CppElse |
-    CppElif |
-    CppEndif |
-    CppWarning |
-    CppError |
-    CppPragma
+    PpcInclude |
+    PpcDefine |
+    PpcUndef |
+    PpcIf |
+    PpcIfdef |
+    PpcIfndef |
+    PpcElse |
+    PpcElif |
+    PpcEndif |
+    PpcWarning |
+    PpcError |
+    PpcPragma
 
   datatype tkErrorAuxInfo = TkiEOF | TkiDx of int | TkiStart
 
   exception TkError of tkErrorAuxInfo * string
   exception TkErrorAug of S.pos * string
 
-  exception ExpectedCppDir (* handled in postprocess *)
+  exception ExpectedPpcDir (* handled in postprocess *)
 
   exception FsmTableIsTooSmall
 
@@ -141,17 +141,19 @@ struct
   exception SuffixWithoutRepr
 
   val kwPrefix  = #"`"
-  val cppPrefix = #"$"
+  val ppcPrefix = #"$"
   val otherPrefix = #"@"
 
   val tokenRepr =
   let
     fun & repr = str kwPrefix ^ repr
-    fun % repr = str cppPrefix ^ repr
+    fun % repr = str ppcPrefix ^ repr
+    fun ` repr = str otherPrefix ^ repr
   in
     [
-      (NewLine, "@NewLine"),
-      (EOS, "@EOS"),
+      (NewLine, `"NewLine"),
+      (EOS, `"EOS"),
+      (Invalid, `"Invalid"),
 
       (kwBreak, &"break"),
       (kwCase, &"case"),
@@ -242,18 +244,18 @@ struct
 
       (CommentStart, "/*"),
 
-      (CppInclude, %"include"),
-      (CppDefine, %"define"),
-      (CppUndef, %"undef"),
-      (CppIf, %"if"),
-      (CppIfdef, %"ifdef"),
-      (CppIfndef, %"ifndef"),
-      (CppElse, %"else"),
-      (CppElif, %"elif"),
-      (CppEndif, %"endif"),
-      (CppWarning, %"warning"),
-      (CppError, %"error"),
-      (CppPragma, %"pragma")
+      (PpcInclude, %"include"),
+      (PpcDefine, %"define"),
+      (PpcUndef, %"undef"),
+      (PpcIf, %"if"),
+      (PpcIfdef, %"ifdef"),
+      (PpcIfndef, %"ifndef"),
+      (PpcElse, %"else"),
+      (PpcElif, %"elif"),
+      (PpcEndif, %"endif"),
+      (PpcWarning, %"warning"),
+      (PpcError, %"error"),
+      (PpcPragma, %"pragma")
   ]
   end
 
@@ -280,10 +282,11 @@ struct
   fun getSfxReprSimple sfx buf =
     getSfxRepr sfx buf (fn () => raise SuffixWithoutRepr)
 
-  val token2str = fn
-      Id s => s
-    | MacroStart macro => "m(" ^ macro ^ ")"
-    | MacroEnd macro => "mend(" ^ macro ^ ")"
+  fun printToken (out, tk) =
+    case tk of
+      Id s => Printf out `s %
+    | MacroStart macro => Printf out `"m(" `macro `")" %
+    | MacroEnd macro => Printf out `"mend(" `macro `")" %
     | Num (IntConst (it, str, sfx)) =>
       let
         val intType =
@@ -292,19 +295,25 @@ struct
           | ItOct => "0"
           | ItHex => "0x"
       in
-        intType ^ str ^ getSfxReprSimple sfx intSuffixRepr
+        Printf out `intType `str  `(getSfxReprSimple sfx intSuffixRepr) %
       end
     | Num (FloatConst (str, sfx)) =>
-        str ^ getSfxReprSimple sfx floatSuffixRepr
-    | CharConst (repr, _) => repr
-    | StringConst s =>
-        "\"" ^ s ^ "\""
+        Printf out `str `(getSfxReprSimple sfx floatSuffixRepr) %
+    | CharConst (repr, _) => Printf out `repr %
+    | StringConst s => Printf out `"\"" `s `"\"" %
     | v =>
       case List.find (fn (x, _) => x = v) tokenRepr of
-      SOME (_, repr) => repr
+      SOME (_, repr) =>
+      let
+        val head = String.sub (repr, 0)
+        val head = if head = ppcPrefix then #"#" else head
+        val tail = String.extract (repr, 1, NONE)
+      in
+        Printf out C head `tail %
+      end
       | NONE => raise TokenWithoutRepr
 
-  fun printToken tk = printf A1 token2str tk %
+  val Ptoken = fn z => bind A1 printToken z
 
   fun isIdStart c = Char.isAlpha c orelse c = #"_"
   fun isIdBody c = Char.isAlphaNum c orelse c = #"_"
@@ -356,7 +365,7 @@ struct
                 let
                   val c = String.sub (repr, 0)
                 in
-                  c <> kwPrefix andalso c <> cppPrefix
+                  c <> kwPrefix andalso c <> ppcPrefix
                     andalso c <> otherPrefix
                 end)
               tokenRepr
@@ -401,12 +410,12 @@ struct
     T
   end
 
-  (* Unused right now
   fun printTable (nextState, buf) =
   let
+    open Array
     fun printRow i row =
       if i = length row then
-        output "\n"
+        printf `"\n" %
       else
         let
           val state = sub (row, i)
@@ -414,7 +423,7 @@ struct
           if state = ~1 then
             ()
           else
-            printf C (chr i) `": " I state `", " %;
+            printf C (chr i) `" -> " I state `", " %;
             printRow (i + 1) row
         end
 
@@ -425,16 +434,16 @@ struct
         let
           val (tk, row) = sub (buf, rowNum)
         in
-          printf A1 token2string tk `": " %;
+          printf `"row " I rowNum `" - " Ptoken tk `": \t" %;
           printRow 0 row;
           print' (rowNum + 1) buf
         end
   in
+    printf `"FSM table:\n";
     printf `"NextState: " I (!nextState) `"\n" %;
     print' 0 buf;
-    output "\n"
+    printf `"\n" %
   end
-  *)
 
   val fsmTable = lazy fsmTableCreate
 
@@ -852,26 +861,26 @@ struct
   val charParser = seqParser SpmChr
   val strParser = seqParser SpmStr
 
-  fun formCppDir (Id s) =
+  fun formPpcDir (Id s) =
   let
     open String
   in
     case List.find
       (fn (_, repr) =>
-          sub (repr, 0) = cppPrefix andalso
+          sub (repr, 0) = ppcPrefix andalso
               extract (repr, 1, NONE) = s)
       tokenRepr
     of
       SOME (tk, _) => tk
-    | NONE => raise ExpectedCppDir
+    | NONE => raise ExpectedPpcDir
   end
-    | formCppDir kwElse = CppElse
-    | formCppDir kwIf = CppIf
-    | formCppDir _ = raise ExpectedCppDir
+    | formPpcDir kwElse = PpcElse
+    | formPpcDir kwIf = PpcIf
+    | formPpcDir _ = raise ExpectedPpcDir
 
-  fun handleCppDir (pos, tk) =
-    formCppDir tk handle
-        ExpectedCppDir =>
+  fun handlePpcDir (pos, tk) =
+    formPpcDir tk handle
+        ExpectedPpcDir =>
            raise TkErrorAug (pos, "expected preprocessor directive")
 
   fun unexpectedCharRaise stream c =
@@ -940,7 +949,7 @@ struct
             if tk = EOS then
               raise TkErrorAug (pos, "unfinished preprecessor directive")
             else
-              (handleCppDir (pos', tk), pos, stream)
+              (handlePpcDir (pos', tk), pos, stream)
           end
         else
           (tk, pos, stream)
@@ -977,23 +986,28 @@ struct
         unexpectedCharRaise stream c
   end
 
-  (* TODO: remove *)
-  fun debugPrint tkl fname =
+  fun debugPrint fname =
   let
-    fun print' line _ ((NewLine, _) :: tks) =
-      print' (line + 1) true tks
-      | print' line firstOnLine ((tk, _) :: tks) = (
-        if firstOnLine then
-          printf `"\n" `fname `":" I line `"\t" %
-        else
-          ();
-        printToken tk;
-        output " ";
-        print' line false tks
-      )
-      | print' _ _ [] = ()
+    val stream = S.create fname
+
+    fun print line stream =
+    let
+      val (tk, S.Pos (_, line', col'), stream) = getToken stream
+    in
+      if line <> line' then
+        printf `"\nline " I line' `": \t" %
+      else
+        ();
+      printf I col' `":" Ptoken tk `" ";
+      if tk = EOS then
+        ()
+      else
+        print line' stream
+    end
   in
-    print' 1 true tkl;
-    output "\n"
+    printTable $ fsmTable ();
+    printf `"Tokenizing file: " `fname;
+    print 0 stream;
+    printf `"\n" %
   end
 end