Conditional inclusion

1 files changed, 58 insertions, 11 deletions

diff --git a/tokenizer.fun b/tokenizer.fun
index 9d7f8fc..4bdc047 100644
--- a/tokenizer.fun
+++ b/tokenizer.fun
@@ -16,7 +16,6 @@ struct
     Invalid |
     EOS |
     NewLine |
-    MacroStart of string |
     MacroEnd of string |
 
     Num of numConst |
@@ -114,7 +113,7 @@ struct
 
     CommentStart |
 
-    PpcInclude |
+    PpcInclude of string * string |
     PpcDefine |
     PpcUndef |
     PpcIf |
@@ -132,8 +131,6 @@ struct
   exception TkError of tkErrorAuxInfo * string
   exception TkErrorAug of S.pos * string
 
-  exception ExpectedPpcDir (* handled in postprocess *)
-
   exception FsmTableIsTooSmall
 
   (* Unreachable (should be) *)
@@ -244,7 +241,6 @@ struct
 
       (CommentStart, "/*"),
 
-      (PpcInclude, %"include"),
       (PpcDefine, %"define"),
       (PpcUndef, %"undef"),
       (PpcIf, %"if"),
@@ -285,8 +281,9 @@ struct
   fun printToken (out, tk) =
     case tk of
       Id s => Printf out `s %
-    | MacroStart macro => Printf out `"m(" `macro `")" %
     | MacroEnd macro => Printf out `"mend(" `macro `")" %
+    | PpcInclude (dir, arg) =>
+        Printf out `"#include(" `dir `", " `arg `")" %
     | Num (IntConst (it, str, sfx)) =>
       let
         val intType =
@@ -861,7 +858,53 @@ struct
   val charParser = seqParser SpmChr
   val strParser = seqParser SpmStr
 
-  fun formPpcDir (Id s) =
+  fun getDir stream = OS.Path.getParent o S.getFname $ stream
+
+  fun completePpcInclude (S.Pos (fname, line, _)) stream =
+  let
+    val pos = S.Pos (fname, line, 1)
+    val (line, stream) = S.getLine stream
+  in
+    case line of
+      SOME line => (PpcInclude (getDir stream, line), stream)
+    | NONE => raise TkErrorAug (pos, "line does not end with '\n'\n")
+  end
+
+  fun isPpcDir (PpcInclude _) = true
+    | isPpcDir tk =
+      case List.find (fn (tk', _) => tk' = tk) tokenRepr of
+        SOME (_, repr) => String.sub (repr, 0) = ppcPrefix
+      | NONE => false
+
+  fun handlePpcDir (tk, pos) stream =
+  let
+    open String
+    fun error () =
+      raise TkErrorAug (pos, "expected preprocessor directive")
+
+    fun getById id =
+    let
+      fun right repr =
+        sub (repr, 0) = ppcPrefix andalso extract (repr, 1, NONE) = id
+    in
+      case List.find (fn (_, repr) => right repr) tokenRepr of
+        SOME (tk, _) => (tk, stream)
+      | NONE =>
+          if id = "include" then
+            completePpcInclude pos stream
+          else
+            error ()
+    end
+  in
+    case tk of
+      Id id => getById id
+    | kwElse => (PpcElse, stream)
+    | kwIf => (PpcIf, stream)
+    | _ => error ()
+  end
+
+  (*
+  fun formPpcDir (Id s)  =
   let
     open String
   in
@@ -878,10 +921,10 @@ struct
     | formPpcDir kwIf = PpcIf
     | formPpcDir _ = raise ExpectedPpcDir
 
-  fun handlePpcDir (pos, tk) =
-    formPpcDir tk handle
-        ExpectedPpcDir =>
+  fun handlePpcDir (pos, tk) stream =
+    formPpcDir tk stream handle ExpectedPpcDir =>
            raise TkErrorAug (pos, "expected preprocessor directive")
+  *)
 
   fun unexpectedCharRaise stream c =
   let
@@ -949,7 +992,11 @@ struct
             if tk = EOS then
               raise TkErrorAug (pos, "unfinished preprecessor directive")
             else
-              (handlePpcDir (pos', tk), pos, stream)
+              let
+                val (tk, stream) = handlePpcDir (tk, pos') stream
+              in
+                (tk, pos, stream)
+              end
           end
         else
           (tk, pos, stream)