From 2a1cfad37d5e87b2d7eb3c9da16db66364a9b9a3 Mon Sep 17 00:00:00 2001
From: Vladimir Azarov <avm@intermediate-node.net>
Date: Tue, 20 May 2025 01:15:06 +0200
Subject:  #pragma support

---
 ppc.fun | 50 +++++++++++++++++++++++++++++---------------------
 ppc.sig |  3 +--
 2 files changed, 30 insertions(+), 23 deletions(-)

diff --git a/ppc.fun b/ppc.fun
index 23684ab..bb07107 100644
--- a/ppc.fun
+++ b/ppc.fun
@@ -820,25 +820,29 @@ struct
       else
         (not defined, "ifndef")
   in
-    dprintf ppc PDP T.S.Ppos ifPos `": #" `form `" " `id `" -> " B cond %;
+    dprintf ppc PDP T.S.Ppos ifPos `": #" `form `" "
+        `id `" -> " B cond `"\n"%;
     (cond, ppc)
   end
 
+  and skip ppc cl =
+  let
+    val (tk, _, ppc) = getTokenNoexpand ppc
+  in
+    case tk of
+      T.EOS => cl ()
+    | T.NewLine => ppc
+    | _ => skip ppc cl
+  end
+
   and ifEval ifPos ppc =
   let
-    fun skip ppc =
-    let
-      val (tk, _, ppc) = getTokenNoexpand ppc
-    in
-      case tk of
-        T.EOS => errorSpos ifPos `"unfinished #if condition" %
-      | T.NewLine => ppc
-      | _ => skip ppc
-    end
+    val ppc =
+      skip ppc (fn () => errorSpos ifPos `"unfinished #if condition" %)
     val cond = true
   in
-    dprintf ppc PDP T.S.Ppos ifPos `": #if -> " B cond `" (skipping)" %;
-    (cond, skip ppc)
+    dprintf ppc PDP T.S.Ppos ifPos `": #if -> " B cond `" (skipping)";
+    (cond, ppc)
   end
 
   and handleIf (tk, ifPos) ppc =
@@ -864,7 +868,7 @@ struct
     val (_, _, ppc) = getClassNoexpand ppc [Ctk T.NewLine]
     val (prevVal, macros) = Tree.delete macroCompare (#macros ppc) id
   in
-    dprintf ppc PDP `"#undef " `id %;
+    dprintf ppc PDP `"#undef " `id `"\n" %;
     case prevVal of
       NONE => warning pos
         `"#undef: no macro with provided name was defined" %
@@ -872,6 +876,16 @@ struct
     updatePpc ppc s#macros macros %
   end
 
+  and handleStray (tk, pos) _ = errorSpos pos `"stray " T.Ptk tk %
+
+  and handlePragma (_, pos) ppc = (
+    dprintf ppc PDP `"#pragma -> ignored\n";
+    skip ppc (fn () => errorSpos pos `"unfinished #pragma" %)
+  )
+
+  and ppcFallback (_, pos) _ =
+    errorSpos pos `"directive is not implemented" %
+
   and handleRegularToken tk pos ppc =
   let
     fun checkAndMark (true, _, _) = (NONE, NONE)
@@ -899,11 +913,6 @@ struct
     | _ => def ()
   end
 
-  and handleStray (tk, pos) _ = errorSpos pos `"stray " T.Ptk tk %
-
-  and ppcFallback (_, pos) _ =
-    errorSpos pos `"directive is not implemented" %
-
   and handleToken tk pos ppc =
   let
     fun %tk = fn tk' => tk' = tk
@@ -919,7 +928,7 @@ struct
         (%T.PpcEndif, handleStray),
         (%T.PpcWarning, ppcFallback),
         (%T.PpcError, ppcFallback),
-        (%T.PpcPragma, ppcFallback)
+        (%T.PpcPragma, handlePragma)
     ]
   in
     case List.find (fn (f, _) => f tk) directiveTable of
@@ -979,6 +988,5 @@ struct
     printf A2 debugPrint' startCache ppc F %
   end
 
-  fun getClass ppc clList =
-    getClassGeneric clList getTokenSkipNL ppc
+  val getToken = getTokenSkipNL
 end
diff --git a/ppc.sig b/ppc.sig
index eaddbe5..ce7a720 100644
--- a/ppc.sig
+++ b/ppc.sig
@@ -14,7 +14,6 @@ signature PPC = sig
     Cop
 
   val create: { fname: string, incDirs: string list, debugMode: bool } -> t
+  val getToken: t -> T.token * tkPos * t
   val debugPrint: string -> string list -> unit
-
-  val getClass: t -> tkClass list -> T.token * tkPos * t
 end
-- 
cgit v1.2.3