New printf combinator interface

8 files changed, 180 insertions, 130 deletions

diff --git a/common.sml b/common.sml
index d039471..788c28b 100644
--- a/common.sml
+++ b/common.sml
@@ -37,6 +37,7 @@ structure Fold = struct
   fun step1 h (a, f) b = fold (h (b, a), f)
   fun step2 h (a, f) b c = fold (h (b, c, a), f)
   fun step3 h (a, f) b c d = fold (h (b, c, d, a), f)
+  fun step4 h (a, f) b c d e = fold (h (b, c, d, e, a), f)
 end
 
 structure FRU = struct
@@ -127,6 +128,8 @@ in
   (output', mf)
 end
 
+type 'a acc = (string -> unit) * 'a
+
 local
   val ctx = ((false, makePrintfBase $ output TextIO.stdOut),
     fn (_: bool * ((string -> unit) * (unit -> unit))) => ())
@@ -154,22 +157,24 @@ in
   fun A0 z = Fold.step1 (fn (f, (ign, out)) =>
     (ifF ign (fn () => f out); (ign, out))) z
   fun A1 z = Fold.step2 (fn (f, v, (ign, out)) =>
-    (ifF ign (fn () => f (out, v)); (ign, out))) z
+    (ifF ign (fn () => f v out); (ign, out))) z
   fun A2 z = Fold.step3 (fn (f, v1, v2, (ign, out)) =>
-    (ifF ign (fn () => f (out, v1, v2)); (ign, out))) z
+    (ifF ign (fn () => f v1 v2 out); (ign, out))) z
+  fun A3 z = Fold.step4 (fn (f, v1, v2, v3, (ign, out)) =>
+    (ifF ign (fn () => f v1 v2 v3 out); (ign, out))) z
 end
 
 fun Ign z = Fold.step0 (fn (_, out) => (true, out)) z
 
 fun bind A f = fn z => Fold.fold z A f
-fun bindWith2str to = bind A1 (fn ((output, _), v) => output $ to v)
+fun bindWith2str to = bind A1 (fn v => fn (output, _) => output $ to v)
 
 fun F z = bind A0 (fn (_, mf) => mf ()) z
 
 val I = fn z => bindWith2str Int.toString z
 val C = fn z => bindWith2str str z
 val B = fn z => bindWith2str Bool.toString z
-val R = fn z => bind A1 (fn ((output, _), n) => app (fn f => f ())
+val R = fn z => bind A1 (fn n => fn (output, _) => app (fn f => f ())
         (List.tabulate (n, fn _ => fn () => output "    "))) z
 
 type ('t, 'a, 'b, 'c) a1printer = (bool * ((string -> unit) * 'a)) * 'b
@@ -179,15 +184,26 @@ type ('t1, 't2, 'a, 'b, 'c) a2printer =
     (bool * ((string -> unit) * 'a)) * 'b -> 't1 -> 't2 ->
         ((bool * ((string -> unit) * 'a)) * 'b -> 'c) -> 'c
 
-val Popt = fn z =>
+fun popt p v out =
+  case v of
+    NONE => Printf out `"none" %
+  | SOME v => Printf out A1 p v %
+val Popt = fn z => bind A2 popt z
+
+fun plist p l (s, parens) out =
 let
-  fun f (out, p, v) =
-    case v of
-      NONE => Printf out `"none" %
-    | SOME v => Printf out p v %
+  fun f [] _ = ()
+    | f [e] out = Printf out A1 p e %
+    | f (e1 :: e2 :: tail) out =
+      (Printf out A1 p e1 %; Printf out `s A1 f (e2 :: tail) %)
 in
-  bind A2 f
-end z
+  if parens andalso length l > 1 then
+    Printf out `"(" A1 f l `")" %
+  else
+    Printf out A1 f l %
+end
+
+val Plist = fn z => bind A3 plist z
 
 fun die code g =
 let
diff --git a/driver.fun b/driver.fun
index 3e2df5e..ff99091 100644
--- a/driver.fun
+++ b/driver.fun
@@ -53,9 +53,20 @@ functor Driver(P: PARSER): DRIVER = struct
       Normal =>
         let
           val parseCtx = P.createParseCtx file (#includeDirs config)
-          val (_, _) = P.parseDef parseCtx
+
+          fun collect ctx =
+          let
+            val result = P.parseDef ctx
+          in
+            case result of
+              NONE => ()
+            | SOME (def, ctx) => (
+              P.printDef def;
+              collect ctx
+            )
+          end
         in
-          raise Unimplemented
+          collect parseCtx
         end
     | DebugT => P.P.T.debugPrint file
     | DebugE => P.P.debugPrint file (#includeDirs config)
diff --git a/parser.fun b/parser.fun
index 9f66fc3..f27510d 100644
--- a/parser.fun
+++ b/parser.fun
@@ -100,7 +100,7 @@ functor Parser(P: PPC): PARSER = struct
     SpecStatic |
     SpecRegister
 
-  datatype stmt = StmtCompound of exprAug
+  datatype stmt = StmtCompound of exprAug list
 
   type declaredId = {
     id: int option,
@@ -168,23 +168,18 @@ functor Parser(P: PPC): PARSER = struct
     (BrComma, T.Comma, 1, true)
   ]
 
-  val PstorSpec = fn z =>
-  let
-    fun f (out, s) =
-      Printf out `(
-        case s of
-          SpecTypedef => "typedef"
-        | SpecExtern => "extern"
-        | SpecRegister => "register"
-        | SpecStatic => "static"
-      ) %
-  in
-    bind A1 f
-  end z
+  fun pStorSpec s out =
+    Printf out `(
+      case s of
+        SpecTypedef => "typedef"
+      | SpecExtern => "extern"
+      | SpecRegister => "register"
+      | SpecStatic => "static"
+    ) %
 
   val Pctype = fn z =>
   let
-    fun Pctype (out, t) =
+    fun pctype t out =
     let
       fun &s = Printf out `s %
     in
@@ -203,20 +198,13 @@ functor Parser(P: PPC): PARSER = struct
       | float_t => &"float"
       | double_t => &"double"
       | pointer_t (plevel, t) =>
-          Printf out `"[" I plevel `"]" A1 Pctype t %
-      | function_t (ret, params) =>
-          let
-            fun Pparams (_, []) = ()
-              | Pparams (out, [p]) = Printf out A1 Pctype p %
-              | Pparams (out, (p1 :: p2 :: t)) =
-                Printf out A1 Pctype p1 `", " A1 Pparams (p2 :: t) %
-          in
-            Printf out `"(" A1 Pparams params `") -> " A1 Pctype ret %
-          end
-      | array_t el => Printf out `"() -> " A1 Pctype el %
+          Printf out `"{" I plevel `"} " A1 pctype t %
+      | function_t (ret, params) => Printf out
+        Plist pctype params (", ", true) `" -> " A1 pctype ret %
+      | array_t el => Printf out `"[] -> " A1 pctype el %
     end
   in
-    bind A1 Pctype
+    bind A1 pctype
   end z
 
   val typeSpecs = [
@@ -343,11 +331,11 @@ functor Parser(P: PPC): PARSER = struct
         SOME (repr, _) => repr
       | NONE => raise Unreachable
 
-    fun printRepr (out, l) =
+    fun printRepr l out =
     let
-      fun printRepr' (_, []) = ()
-        | printRepr' (out, [tk]) = Printf out P.Ptk tk %
-        | printRepr' (out, tk1 :: tk2 :: tail) =
+      fun printRepr' [] _ = ()
+        | printRepr' [tk] out = Printf out P.Ptk tk %
+        | printRepr' (tk1 :: tk2 :: tail) out =
             Printf out P.Ptk tk1 `", " A1 printRepr' (tk2 :: tail) %
     in
       Printf out `"[" A1 printRepr' l `"]" %
@@ -441,20 +429,23 @@ functor Parser(P: PPC): PARSER = struct
   fun typeRepr2type typeReprId =
     valOf o #1 o Array.sub $ (prefixFsm, typeReprId)
 
-  fun PtokenL (_, []) = ()
-    | PtokenL (out, head :: tail) =
+  fun pTokenL l out =
+  let
+    fun pToken (tk, _) out =
     let
-      fun printL list s e =
-        Printf out `s`"| " A1 PtokenL list `" |"`e `", " A1 PtokenL tail %
-      val (tk, _) = head
+      fun printList list opr cpr = Printf out `(opr ^ "| ")
+        Plist pToken list (",", false) `(" |" ^ cpr) %
     in
       case tk of
-        Tk tk => Printf out P.Ptk tk `"," A1 PtokenL tail %
-      | TkParens list => printL list "(" ")"
-      | TkBrackets list => printL list "[" "]"
-      | TkBraces list => printL list "{" "}"
-      | TkTernary list => printL list "?" ":"
+        Tk tk => Printf out P.Ptk tk %
+      | TkParens list => printList list "(" ")"
+      | TkBrackets list => printList list "[" "]"
+      | TkBraces list => printList list "{" "}"
+      | TkTernary list => printList list "?" ":"
     end
+  in
+    Printf out Plist pToken l (",", false) %
+  end
 
   type parseCtx = P.t * (token * P.tkPos) list list
 
@@ -530,7 +521,7 @@ functor Parser(P: PPC): PARSER = struct
     (v, (fn (ppc, layers) => (ppc, tl layers)) ctx)
   end
 
-  fun Punop (out, unop) =
+  fun Punop unop out =
   let
     fun ~s = Printf out `s %
   in
@@ -546,15 +537,15 @@ functor Parser(P: PPC): PARSER = struct
     | UnopCast ctype => Printf out Pctype ctype %
   end
 
-  and Pbinop (out, binop) =
+  and Pbinop binop out =
     case List.find (fn (binop', _, _, _) => binop' = binop) binopTable
     of
       SOME (_, tk, _, _) => Printf out P.Ptk tk %
     | NONE => raise Unreachable
 
-  and printExpr (out, off, ea) =
+  and printExpr off ea out =
   let
-    fun printExpr' (out, off, EAug (e, pos)) =
+    fun printExpr' off (EAug (e, pos)) out =
     let
       val P = fn z =>
       let
@@ -842,8 +833,10 @@ functor Parser(P: PPC): PARSER = struct
             if typeReprId = 0 then
               let
                 val (_, pos, _) = getTokenCtx ctx
+                val ets = "expected type specifier"
+                val etss = "expected type or storage specifier"
               in
-                P.error pos `"expected type specifier" %
+                P.error pos `(if isSome storSpec then ets else etss) %
               end
             else
               ((storSpec, typeRepr2type typeReprId), ctx)
@@ -860,7 +853,7 @@ functor Parser(P: PPC): PARSER = struct
     collect ctx (NONE, 0)
   end
 
-  and Ppart (out, part) =
+  and Ppart part out =
     case part of
       Pointer plevel => Printf out `"[" I plevel `"] " %
     | Id _ => Printf out `"id" %
@@ -872,7 +865,6 @@ functor Parser(P: PPC): PARSER = struct
     isSome $ List.find
       (fn tk' => case tk of Tk tk => tk = tk' | _ => false) typeSpecs
 
-
   and parseTypeName ctx =
   let
     val (prefix, ctx) = parseDeclPrefix ctx
@@ -987,6 +979,15 @@ functor Parser(P: PPC): PARSER = struct
       parts, ctx)
   end
 
+  and checkParamUniqueness _ [] = ()
+    | checkParamUniqueness acc ((SOME id, pos, _) :: ids) = (
+      case List.find (fn id' => id' = id) acc of
+        SOME _ => P.error pos `"parameter redefinition" %
+      | NONE => checkParamUniqueness (id :: acc) ids
+    )
+    | checkParamUniqueness acc ((NONE, _, _) :: ids) =
+        checkParamUniqueness acc ids
+
   and assembleDeclarator (storSpec, ctype) parts =
   let
     val parts = rev parts
@@ -1001,7 +1002,7 @@ functor Parser(P: PPC): PARSER = struct
         pointer_t (plevel, complete tail)
       | complete (FuncApp params :: tail) =
       let
-        (* TODO: check params uniqness *)
+        val () = checkParamUniqueness [] params
         val params = map (fn (_, _, ctype) => ctype) params
       in
         function_t (complete tail, params)
@@ -1019,20 +1020,15 @@ functor Parser(P: PPC): PARSER = struct
     { id, pos, spec = storSpec, ctype = complete $ tl parts, params }
   end
 
-  fun printDeclId ({ id, spec, ctype, params, ... }: declaredId) =
-  let
-    fun Pstor (_, NONE) = ()
-      | Pstor (out, SOME s) = Printf out PstorSpec s %
-  in
-    printf A1 Pstor spec Popt P.? id `": " Pctype ctype `"\n" %;
+  fun pDeclId ({ id, spec, ctype, params, ... }: declaredId) out = (
+    Printf out Popt pStorSpec spec `" " Popt P.psid id `": "
+        Pctype ctype `"\n" %;
+
     case params of
       NONE => ()
-    | SOME params => (
-        printf `"params: " %;
-        List.app (fn (id, _) => printf Popt P.?id `", " %) params;
-        printf `"\n" %
-    )
-  end
+    | SOME params => Printf out
+      `"params: " Plist (popt P.psid) (map #1 params) (", ", false) `"\n" %
+  )
 
   datatype declaration =
     DeclIds of declaredId list |
@@ -1074,15 +1070,38 @@ functor Parser(P: PPC): PARSER = struct
 
   fun parseStmtCompound ctx =
   let
-    val (ea, ctx) = parseExpr ctx (SOME T.Semicolon)
-    val (_, _, ctx) = getTokenCtx ctx
-    val (tk, pos, ctx) = getTokenCtx ctx
+    fun collect acc ctx =
+    let
+      val (tk, _, _) = getTokenCtx ctx
+    in
+      case tk of
+        Tk T.EOS => (rev acc, ctx)
+      | _ =>
+          let
+            val (ea, ctx) = parseExpr ctx (SOME T.Semicolon)
+            val (tk, pos, ctx) = getTokenCtx ctx
+          in
+            case tk of
+              Tk T.Semicolon => collect (ea :: acc) ctx
+            | _ => P.clerror pos [P.Ctk T.Semicolon]
+          end
+    end
+
+    val (eas, ctx) = collect [] ctx
   in
-    case tk of
-      Tk T.EOS => (StmtCompound ea, ctx)
-    | _ => P.clerror pos [P.Ctk T.RBrace]
+    (StmtCompound eas, ctx)
   end
 
+  val Pstmt = fn z =>
+  let
+    fun Pstmt off (StmtCompound eas) out =
+      Printf out R off `"{\n"
+        Plist (printExpr (off + 1)) eas ("", false)
+        R off `"}\n" %
+  in
+    bind A2 Pstmt
+  end z
+
   fun parseFuncDefinition id ctx =
   let
     val (stmt, ctx) = parseStmtCompound ctx
@@ -1090,14 +1109,26 @@ functor Parser(P: PPC): PARSER = struct
     (Definition (id, stmt), ctx)
   end
 
+  fun printDef (Definition (id, stmt)) =
+    printf `"Function: " A1 pDeclId id Pstmt 0 stmt %
+  | printDef (Declaration ids) = printf Plist pDeclId ids ("", false) %
+
   fun parseDef ctx =
   let
-    val (toplev, ctx) = parseDeclaration ctx true
+    val (tk, _, _) = getTokenCtx ctx
   in
-    case toplev of
-      DeclIds ids => (Declaration ids, ctx)
-    | FuncDef (id, body) =>
-        ctxWithLayer ctx body (fn ctx =>
-          parseFuncDefinition id ctx)
+    case tk of
+      Tk T.EOS => NONE
+    | _ =>
+      let
+        val (toplev, ctx) = parseDeclaration ctx true
+      in
+        SOME (case toplev of
+          DeclIds ids => (Declaration ids, ctx)
+        | FuncDef (id, body) =>
+            ctxWithLayer ctx body (fn ctx =>
+              parseFuncDefinition id ctx))
+      end
+
   end
 end
diff --git a/parser.sig b/parser.sig
index 7545f22..e3a1d3b 100644
--- a/parser.sig
+++ b/parser.sig
@@ -6,5 +6,6 @@ signature PARSER = sig
   type def
 
   val createParseCtx: string -> string list -> parseCtx
-  val parseDef: parseCtx -> def * parseCtx
+  val parseDef: parseCtx -> (def * parseCtx) option
+  val printDef: def -> unit
 end
diff --git a/ppc.fun b/ppc.fun
index b3428c2..a097390 100644
--- a/ppc.fun
+++ b/ppc.fun
@@ -6,16 +6,12 @@ struct
   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
+  fun psid id out = Printf out `(??id) %
+  val ? = fn z => bind A1 psid z
 
   val Ptk = fn z =>
   let
-    fun f (out, tk) = Printf out T.Ptk symtab tk %
+    fun f tk out = Printf out T.Ptk symtab tk %
   in
     bind A1 f
   end z
@@ -58,10 +54,10 @@ struct
 
   val PlayersU = fn z =>
   let
-    fun PlayersU (out, ((macroName, pos) :: layers)) =
+    fun PlayersU ((macroName, pos) :: layers) out =
       Printf out F `"\tfrom " ?macroName `" at " T.S.Ppos pos `"\n"
         A1 PlayersU layers %
-      | PlayersU (_, []) = ()
+      | PlayersU [] _ = ()
   in
     bind A1 PlayersU
   end z
@@ -78,7 +74,7 @@ struct
 
   fun clerror (TkPos (pos, layers)) cls =
   let
-    fun Pcl (out, cl) =
+    fun pcl cl out =
       case cl of
         Ctk tk => Printf out Ptk tk %
       | Cid => Printf out `"identifier" %
@@ -87,14 +83,12 @@ struct
       | Cbinop => Printf out `"binary operator" %
       | Cop => Printf out `"operator" %
 
-    fun Pcls (_, []) = raise Unreachable
-      | Pcls (out, [cl]) = Printf out A1 Pcl cl %
-      | Pcls (out, [cl1, cl2]) =
-          Printf out A1 Pcl cl1 `" or " A1 Pcl cl2 %
-      | Pcls (out, cl :: cls) =
-        Printf out A1 Pcl cl `", " A1 Pcls cls %
+    fun pcls [] _ = raise Unreachable
+      | pcls [cl] out = Printf out A1 pcl cl %
+      | pcls [cl1, cl2] out = Printf out A1 pcl cl1 `" or " A1 pcl cl2 %
+      | pcls (cl :: cls) out = Printf out A1 pcl cl `", " A1 pcls cls %
   in
-    printf F T.S.Ppos pos `":error: expected " A1 Pcls cls `"\n"
+    printf F T.S.Ppos pos `":error: expected " A1 pcls cls `"\n"
         PlayersU layers;
     exit 1
   end
@@ -143,8 +137,8 @@ struct
     findPrefix' 0 s1 s2
   end
 
-  fun PlayersCompact (_, _, []) = ""
-    | PlayersCompact (out, startPrx, L as (layer :: layers)) =
+  fun PlayersCompact _ [] _ = ""
+    | PlayersCompact startPrx (L as (layer :: layers)) out =
   let
     fun getFname (_, T.S.Pos (fname, _, _)) = fname
 
@@ -166,18 +160,18 @@ struct
 
   val PtkPos = fn z =>
   let
-    fun PtkPos (out, TkPos (p as T.S.Pos (fname, line, col), layers)) =
+    fun ptkPos (TkPos (p as T.S.Pos (fname, line, col), layers)) out =
       case layers of
         [] => Printf out T.S.Ppos p %
       | _ =>
         let
-          val prefix = PlayersCompact (out, SOME fname, layers)
+          val prefix = PlayersCompact (SOME fname) layers out
           val fname = String.extract (fname, size prefix, NONE)
         in
           Printf out `"; @" T.S.Ppos (T.S.Pos (fname, line, col)) %
         end
   in
-    bind A1 PtkPos
+    bind A1 ptkPos
   end z
 
   val startCache = (0, [], ("", 0))
@@ -191,7 +185,7 @@ struct
         [] => Printf out `fname' `":" I line' `"| \t" %
       | _ =>
         let
-          val prefix = PlayersCompact (out, SOME fname', layers')
+          val prefix = PlayersCompact (SOME fname') layers' out
           val fname' = String.extract (fname', size prefix, NONE)
         in
           Printf out `"; @" `fname' `":" I line' `"| \t" %
@@ -207,9 +201,9 @@ struct
 
   val PmacroHeader = fn z =>
   let
-    fun printMacroHeader (out, id, mLayers) =
+    fun printMacroHeader id mLayers out =
     let
-      fun Players (out, x, y) = ignore $ PlayersCompact (out, x, y)
+      fun Players x y out = ignore $ PlayersCompact x y out
     in
       Printf out F `"expanding (" A2 Players NONE (rev mLayers)
         `") macro " ?id %
@@ -220,7 +214,7 @@ struct
 
   val PtokenL = fn z =>
   let
-    fun printTokenL (out, offset, l) =
+    fun printTokenL offset l out =
     let
       fun printList _ [] = ()
         | printList cache (tk :: tail) =
@@ -413,7 +407,7 @@ struct
     tk = T.LParen andalso line1 = line2 andalso col1 + len = col2
   end
 
-  fun PrintMacroBody (out, body) =
+  fun PrintMacroBody body out =
     if body = [] then
       ()
     else (
@@ -575,7 +569,7 @@ struct
 
   val Pbody = fn z =>
   let
-    fun printBody (out, msg, body) = (
+    fun printBody msg body out = (
       Printf out F `msg `" {";
       Printf out PtokenL 1 body;
       Printf out `"}\n" %
@@ -697,7 +691,7 @@ struct
 
   and printBinded z =
   let
-    fun printBinded (out, (msg, params)) =
+    fun printBinded msg params out =
     let
       fun print [] = ()
         | print ((p, args) :: tail) = (
@@ -711,7 +705,7 @@ struct
       Printf out `"}\n" %
     end
   in
-    bind A1 printBinded
+    bind A2 printBinded
   end z
 
   and expandFuncMacro (id, mPos) (params, body) ppc =
@@ -729,10 +723,10 @@ struct
     val (bindedParams, ppc) = parseFuncMacroArgs mPos params ppc
 
     val bp1 = apply addLayers2args bindedParams
-    val () = dprintf ppc printBinded ("args", bp1) %
+    val () = dprintf ppc printBinded "args" bp1 %
 
     val bp2 = apply (expandArgument ppc) bp1
-    val () = dprintf ppc printBinded ("expanded args", bp2) %
+    val () = dprintf ppc printBinded "expanded args" bp2 %
 
     val body = setLayers (id, mPos) body
     val body = subst (id, mPos) bp2 body []
@@ -1003,7 +997,7 @@ struct
     | _ => (tk, pos, ppc)
   end
 
-  fun debugPrint' (out, cache, ppc) =
+  fun debugPrint' cache ppc out =
   let
     val (tk, pos, ppc) = getToken ppc
     val cache = printTokenCompact cache out (tk, pos)
diff --git a/ppc.sig b/ppc.sig
index f700634..c82c600 100644
--- a/ppc.sig
+++ b/ppc.sig
@@ -22,6 +22,7 @@ signature PPC = sig
   val debugPrint: string -> string list -> unit
 
   val ? : (int, 'a, 'b, 'c) a1printer
+  val psid: int -> 'a acc -> unit
   val Ptk: (T.token, 'a, 'b, 'c) a1printer
   val PtkPos: (tkPos, 'a, 'b, 'c) a1printer
 end
diff --git a/stream.sml b/stream.sml
index 4d58911..aa8d0aa 100644
--- a/stream.sml
+++ b/stream.sml
@@ -28,13 +28,9 @@ structure Stream :> STREAM = struct
     end
     z
 
-  val Ppos = fn z =>
-  let
-    fun p (out, Pos (fname, line, col)) =
-        Printf out `fname `":" I line `":" I col %
-  in
-    bind A1 p
-  end z
+  fun ppos (Pos (fname, line, col)) out =
+      Printf out `fname `":" I line `":" I col %
+  val Ppos = fn z => bind A1 ppos z
 
   fun getchar (S as { contents, off, ... }: t) =
     (String.sub (contents, off), updateStream S s#off (off + 1) %)
diff --git a/tokenizer.fun b/tokenizer.fun
index d6695d0..2adfd5c 100644
--- a/tokenizer.fun
+++ b/tokenizer.fun
@@ -265,11 +265,11 @@ struct
     symtab
   end
 
-  fun printToken (out, symtab, tk) =
+  fun ptk symtab tk out =
   let
     val ? = fn z =>
     let
-      fun f (out, id) = Printf out `(ST.getStr symtab id) %
+      fun f id out = Printf out `(ST.getStr symtab id) %
     in
       bind A1 f
     end z
@@ -296,7 +296,7 @@ struct
       | NONE => raise TokenWithoutRepr
   end
 
-  val Ptk = fn z => bind A2 printToken z
+  val Ptk = fn z => bind A2 ptk z
 
   fun isNondigit c = Char.isAlpha c orelse c = #"_"