diff options
Diffstat (limited to 'ppc.fun')
| -rw-r--r-- | ppc.fun | 60 |
1 files changed, 27 insertions, 33 deletions
@@ -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) |