1 files changed, 51 insertions, 17 deletions

diff --git a/parser.fun b/parser.fun
index 0d2c774..6ee35ce 100644
--- a/parser.fun
+++ b/parser.fun
@@ -720,17 +720,45 @@ functor Parser(structure Tree: TREE; structure P: PPC;
     | (union_t { fields, ... }) => fields
     | _ => raise Unreachable
 
-  fun createCtx fname incDirs = Ctx {
-    aggrTypeNames = Tree.empty,
-    localScopes = [],
-    funcRetType = NONE,
-    globalSyms = Tree.empty,
-    tokenBuf = (P.create { fname, incDirs, debugMode = false }, []),
-    loopLevel = 0,
-    paramNum = NONE,
-    defs = [],
-    strlits = []
-  }
+  val debugFile = ref NONE
+
+  local
+    fun output s =
+    let
+      val outstream = !debugFile
+    in
+      case outstream of
+        NONE => ()
+      | SOME outstream => TextIO.output (outstream, s)
+    end
+
+    val ctx = ((false, makePrintfBase output),
+      fn (_: bool * ((string -> unit) * (unit -> unit))) => ())
+  in
+    fun dprintf g = Fold.fold ctx g
+  end
+
+  fun createCtx fname incDirs debug =
+  let
+    val () =
+      if debug then
+        debugFile := SOME (TextIO.openOut (fname ^ ".p"))
+      else
+        ()
+  in
+    Ctx {
+      aggrTypeNames = Tree.empty,
+      localScopes = [],
+      funcRetType = NONE,
+      globalSyms = Tree.empty,
+      tokenBuf =
+        (P.create { fname = fname ^ ".c", incDirs, debugMode = false }, []),
+      loopLevel = 0,
+      paramNum = NONE,
+      defs = [],
+      strlits = []
+    }
+  end
 
   fun loopWrapper ctx f =
   let
@@ -3055,7 +3083,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
       | f (SOME (GsTypedef _)) =
         P.error pos `"symbol is already typedef'ed" %
 
-    val () = printf `(class2str class) `" decl "
+    val () = dprintf `(class2str class) `" decl "
       `(link2str linkage) `" " P.?id `": " Pctype t `"\n" %
 
     val ((), tree) = lookup2 (#globalSyms ctx) id f
@@ -3905,7 +3933,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
         function_t (ret, _, v) => (ret, v)
       | _ => raise Unreachable
   in
-    printf P.?name `" " Plist printParam params (", ", true, 2)
+    dprintf P.?name `" " Plist printParam params (", ", true, 2)
         `(if variadic then " variadic" else "")
         `" -> " Pctype ret `"\n" %
   end
@@ -3920,7 +3948,7 @@ functor Parser(structure Tree: TREE; structure P: PPC;
         `" = " A2 printIni 0 ini `"\n" %
     end
   in
-    printf Plist pobj objs ("", false, 2) %
+    dprintf Plist pobj objs ("", false, 2) %
   end
   | printDef (Definition (D as { stmt, localVars, ... })) =
   let
@@ -3929,8 +3957,8 @@ functor Parser(structure Tree: TREE; structure P: PPC;
         `(if onStack then "& " else "") Pctype t `"\n" %
   in
     printFuncHeader D;
-    printf Pstmt 0 stmt %;
-    Vector.appi (fn (i, var) => printf A2 pLocalVar i var %) localVars
+    dprintf Pstmt 0 stmt %;
+    Vector.appi (fn (i, var) => dprintf A2 pLocalVar i var %) localVars
   end
 
   type decl = P.tkPos * declClass * ctype * linkage
@@ -4005,10 +4033,16 @@ functor Parser(structure Tree: TREE; structure P: PPC;
         val (toplev: toplev, ctx) = parseDeclaration ctx
       in
         case toplev of
-          ObjDefs objDefList => (true, ctxAddDef ctx (Objects objDefList))
+          ObjDefs objDefList =>
+          let
+            val () = printDef (Objects objDefList)
+          in
+            (true, ctxAddDef ctx (Objects objDefList))
+          end
         | FuncDef (id, body) =>
           let
             val (def, ctx) = ctxWithLayer ctx body (parseFuncDefinition id)
+            val () = printDef def
           in
             (true, ctxAddDef ctx def)
           end