From d289f01594024a8fe64aeed56721260fab6b4e50 Mon Sep 17 00:00:00 2001 From: Vladimir Azarov Date: Sun, 18 May 2025 14:17:50 +0200 Subject: #else, #elif (rudimentary) support --- ppc.fun | 147 ++++++++++++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 112 insertions(+), 35 deletions(-) (limited to 'ppc.fun') diff --git a/ppc.fun b/ppc.fun index 58ca66f..656a4b1 100644 --- a/ppc.fun +++ b/ppc.fun @@ -16,7 +16,7 @@ struct type t = { buffer: layer list, - macros: (string, bool * macro) Tree.t, + macros: (string, bool * tkPos * macro) Tree.t, debugMode: bool, incDirs: string list @@ -45,7 +45,8 @@ struct val dummyEOSpos = pos2tkPos $ T.S.Pos ("", 0, 0) fun raiseTkError pos msg = raise TkError (pos, msg) - (* fun raiseTkErrorSPos pos = raiseTkError (pos2tkPos pos) *) + fun raiseTkErrorP pos g = + sprintf (fn (a, f) => g (a, raiseTkError pos o f)) fun printLayers ((macroName, pos) :: layers) = ( printf `"\t" `macroName `" " T.S.Ppos pos %; @@ -202,6 +203,8 @@ struct bind A1 PtkPos end z + fun warning pos g = printf `"\n" PtkPos pos `":warning: " g + val printMacroHeader = fn z => let fun printMacroHeader (out, (id, mLayers)) = @@ -494,9 +497,13 @@ struct let val ((macroName, pos), macro, ppc) = parseDefine ppc - val macros = insertMacro (#macros ppc) macroName (false, macro) - handle Tree.Exists => raiseTkError pos "macro redefinition" + val (prevVal, macros) = + insertMacro (#macros ppc) macroName (false, pos, macro) in + case prevVal of + SOME (_, pos', _) => warning pos + `"macro redefinition (see " PtkPos pos' `")" % + | NONE => (); updatePpc ppc s#macros macros % end @@ -530,6 +537,9 @@ struct bind A1 printBody end z + datatype collectCtx = + AfterIf | AfterIfdef | AfterIfndef | AfterElse | AfterElif + fun expandObjMacro (id, pos) body ppc = let val mend = (T.MacroEnd id, if body = [] then pos else (#2 o hd) body) @@ -672,37 +682,99 @@ struct insertRevBody (rev body) ppc end - and getIfRevBody ifPos cond (ppc: t) = + and collectRevBody ifPos acc ctx ppc = let - fun collect level f acc ppc = + fun collect level ppc acc = let val (tk, pos, ppc) = getTokenNoexpand ppc - fun def dx = collect (level + dx) f (f ((tk, pos), acc)) ppc + fun def dl = collect (level + dl) ppc ((tk, pos) :: acc) + + fun unexpected tk prevTk = + raiseTkErrorP pos + `"unexpected " T.Ptoken tk `" inside " T.Ptoken prevTk % + + fun handleIfdef ifTk = + if tk = T.PpcElif then + unexpected tk ifTk + else + (SOME (tk, pos), acc, ppc) + + fun handleElse () = + if level > 0 then + def 0 + else + case ctx of + AfterIf => (SOME (tk, pos), acc, ppc) + | AfterIfdef => handleIfdef T.PpcIfdef + | AfterIfndef => handleIfdef T.PpcIfndef + | AfterElse => unexpected tk T.PpcElse + | AfterElif => def 0 in case tk of - T.PpcEndif => + T.EOS => raiseTkError ifPos "unfinished conditional directive" + | T.PpcEndif => if level = 0 then - let - val (_, _, ppc) = getClassNoexpand ppc [Ctk T.NewLine] - in - (acc, ppc) - end + if ctx = AfterElif then + (NONE, (tk, pos) :: acc, ppc) + else + let + val (_, _, ppc) = getClassNoexpand ppc [Ctk T.NewLine] + in + (NONE, acc, ppc) + end else def (~1) - | T.EOS => raiseTkError ifPos "unfinished conditional directive" - | _ => - if tk = T.PpcIf orelse tk = T.PpcIfdef - orelse tk = T.PpcIfndef - then - def 1 - else - def 0 + | T.PpcElse => handleElse () + | T.PpcElif => handleElse () + | T.PpcIf => def 1 + | T.PpcIfdef => def 1 + | T.PpcIfndef => def 1 + | _ => def 0 end + in + collect 0 ppc acc + end - val skip = collect 0 (fn (_, _) => []) [] - val collect = collect 0 (op ::) [] + and finishElse collect ppc = + let + val (_, _, ppc) = getClassNoexpand ppc [Ctk T.NewLine] + val (_, body, ppc) = collect [] AfterElse ppc in - (if cond then collect else skip) ppc + (body, ppc) + end + + and getIfdefRevBody ifTk ifPos cond ppc = + let + val collect = collectRevBody ifPos + val afterTk = if ifTk = T.PpcIfdef then AfterIfdef else AfterIfndef + + val (elseTk, ifTrue, ppc) = collect [] afterTk ppc + val (ifFalse, ppc) = + case elseTk of + SOME (T.PpcElse, _) => finishElse collect ppc + | NONE => ([], ppc) + | _ => raise Unreachable + in + (if cond then ifTrue else ifFalse, ppc) + end + + and getIfRevBody ifPos cond ppc = + let + val collect = collectRevBody ifPos + val (elseTk, ifTrue, ppc) = collect [] AfterIf ppc + val (ifFalse, ppc) = + case elseTk of + NONE => ([], ppc) + | SOME (T.PpcElse, _) => finishElse collect ppc + | SOME (T.PpcElif, pos) => + let + val (_, body, ppc) = collect [(T.PpcIf, pos)] AfterElif ppc + in + (body, ppc) + end + | _ => raise Unreachable + in + (if cond then ifTrue else ifFalse, ppc) end and ifdefEval pos ifPos ppc = @@ -738,29 +810,34 @@ struct | T.NewLine => ppc | _ => skip ppc end + val cond = true in - (true, skip ppc) + dprintf ppc `"\n" PtkPos ifPos `": #if -> " B cond `" (skipping)" %; + (cond, skip ppc) end and handleIf (tk, ifPos) ppc = let val dprintf = dprintf ppc `"\n" - val (cond, ppc) = - (case tk of - T.PpcIfdef => ifdefEval true - | T.PpcIfndef => ifdefEval false - | _ => ifEval) ifPos ppc + val (eval, getRevBody) = + case tk of + T.PpcIfdef => (ifdefEval true, getIfdefRevBody T.PpcIfdef) + | T.PpcIfndef => (ifdefEval false, getIfdefRevBody T.PpcIfndef) + | T.PpcIf => (ifEval, getIfRevBody) + | _ => raise Unreachable - val (revBody, ppc) = getIfRevBody ifPos cond ppc + val (cond, ppc) = eval ifPos ppc + val (revBody, ppc) = getRevBody ifPos cond ppc in - dprintf `"{" printTokenL (1, [], rev revBody) `"}\n"; + dprintf `" {" printTokenL (1, [], rev revBody) `"}\n"; insertRevBody revBody ppc end and handleRegularToken tk pos ppc = let - fun checkAndMark (true, _) = (NONE, NONE) - | checkAndMark (false, macro) = (SOME (true, macro), SOME macro) + fun checkAndMark (true, _, _) = (NONE, NONE) + | checkAndMark (false, pos, macro) = + (SOME (true, pos, macro), SOME macro) fun getMacro tree id = macrosLookup tree id (checkAndMark, NONE) fun def () = (tk, pos, ppc) @@ -781,7 +858,7 @@ struct T.Id id => handleMacro id | T.MacroEnd id => let - val f = fn (_, macro) => (SOME (false, macro), ()) + val f = fn (_, pos, macro) => (SOME (false, pos, macro), ()) val ((), tree) = macrosLookup (#macros ppc) id (f, ()) in getToken $ updatePpc ppc s#macros tree % -- cgit v1.2.3