#undef

5 files changed, 85 insertions, 16 deletions

diff --git a/ppc.fun b/ppc.fun
index 656a4b1..5c0cb2b 100644
--- a/ppc.fun
+++ b/ppc.fun
@@ -64,7 +64,7 @@ struct
   fun tkClassErrorPrint (TkPos (pos, layers), cls) =
   let
     val printCtk = fn
-        Ctk tk => printf T.Ptoken tk %
+        Ctk tk => printf T.Ptk tk %
       | Cid => printf `"identifier" %
       | Cconst => printf `"constant" %
       | Cunop => printf `"unary operator" %
@@ -166,7 +166,7 @@ struct
       Printf out `"\n" R offset2 `fname' `":" I line' `"|\t" %
     else
       ();
-    Printf out I col' `":" T.Ptoken tk `" ";
+    Printf out I col' `":" T.Ptk tk `" ";
     (offset2, layers', (fname', line'))
   end
 
@@ -480,7 +480,7 @@ struct
     val macroName =
       case macroName of T.Id id => id | _ => raise Unreachable
 
-    val () = dprintf ppc `"\ndefine " `macroName %
+    val () = dprintf ppc `"\n#define " `macroName %
 
     val parser =
       if isFuncMacroDefine (size macroName) pos ppc then
@@ -552,9 +552,6 @@ struct
     insertRevBody revBody ppc
   end
 
-  fun getClass ppc clList =
-    getClassGeneric clList getToken raiseTkClassError ppc
-
   and parseFuncMacroArgs mPos params ppc =
   let
 
@@ -691,7 +688,7 @@ struct
 
       fun unexpected tk prevTk =
         raiseTkErrorP pos
-            `"unexpected " T.Ptoken tk `" inside " T.Ptoken prevTk %
+            `"unexpected " T.Ptk tk `" inside " T.Ptk prevTk %
 
       fun handleIfdef ifTk =
         if tk = T.PpcElif then
@@ -866,6 +863,21 @@ struct
     | _ => def ()
   end
 
+  and handleUndef _ ppc =
+  let
+    val (tk, pos, ppc) = getTokenNoexpand ppc
+    val id = case tk of T.Id id => id | _ => raise Unreachable
+    val (_, _, ppc) = getClassNoexpand ppc [Ctk T.NewLine]
+    val (prevVal, macros) = Tree.delete macroCompare (#macros ppc) id
+  in
+    dprintf ppc `"\n#undef " `id %;
+    case prevVal of
+      NONE => warning pos
+        `"#undef: no macro with provided name was defined" %
+    | SOME _ => ();
+    updatePpc ppc s#macros macros %
+  end
+
   and ppcFallback (_, pos) _ =
     raiseTkError pos "directive is not implemented"
 
@@ -877,7 +889,7 @@ struct
         (%T.PpcDefine, handleDefine),
         (%T.PpcIfdef, handleIf),
         (%T.PpcIfndef, handleIf),
-        (%T.PpcUndef, ppcFallback),
+        (%T.PpcUndef, handleUndef),
         (%T.PpcIf, handleIf),
         (%T.PpcElse, ppcFallback),
         (%T.PpcElif, ppcFallback),
@@ -935,4 +947,18 @@ struct
     debugPrint' startCache ppc;
     printf `"\n" %
   end
+
+  fun getClass ppc clList =
+  let
+    fun getTokenSkipNL ppc =
+    let
+      val (tk, pos, ppc) = getToken ppc
+    in
+      case tk of
+        T.NewLine => getTokenSkipNL ppc
+      | _ => (tk, pos, ppc)
+    end
+  in
+    getClassGeneric clList getTokenSkipNL raiseTkClassError ppc
+  end
 end
diff --git a/tokenizer.fun b/tokenizer.fun
index 999aabf..806209e 100644
--- a/tokenizer.fun
+++ b/tokenizer.fun
@@ -311,7 +311,7 @@ struct
       end
       | NONE => raise TokenWithoutRepr
 
-  val Ptoken = fn z => bind A1 printToken z
+  val Ptk = fn z => bind A1 printToken z
 
   fun isIdStart c = Char.isAlpha c orelse c = #"_"
   fun isIdBody c = Char.isAlphaNum c orelse c = #"_"
@@ -432,7 +432,7 @@ struct
         let
           val (tk, row) = sub (buf, rowNum)
         in
-          printf `"row " I rowNum `" - " Ptoken tk `": \t" %;
+          printf `"row " I rowNum `" - " Ptk tk `": \t" %;
           printRow 0 row;
           print' (rowNum + 1) buf
         end
@@ -1046,7 +1046,7 @@ struct
         printf `"\nline " I line' `": \t" %
       else
         ();
-      printf I col' `":" Ptoken tk `" ";
+      printf I col' `":" Ptk tk `" ";
       if tk = EOS then
         ()
       else
diff --git a/tokenizer.sig b/tokenizer.sig
index a0f5127..91de93a 100644
--- a/tokenizer.sig
+++ b/tokenizer.sig
@@ -128,7 +128,7 @@ signature TOKENIZER = sig
   exception TkErrorAug of S.pos * string
 
   val getToken: S.t -> token * S.pos * S.t
-  val Ptoken: (token, 'a, 'b) a1printer
+  val Ptk: (token, 'a, 'b) a1printer
 
   val isPpcDir: token -> bool
   val debugPrint: string -> unit
diff --git a/tree.sig b/tree.sig
index 8caf4cc..a1ebf86 100644
--- a/tree.sig
+++ b/tree.sig
@@ -3,11 +3,14 @@ signature TREE = sig
 
   val empty: ('k, 'v) t
 
-  val insert: ('k -> 'k -> order) -> ('k, 'v) t -> 'k -> 'v
-        -> 'v option * ('k, 'v) t
+  type 'k cmp = 'k -> 'k -> order
 
-  val lookup: ('k -> 'k -> order) -> ('k, 'v) t -> 'k -> 'v option
-  val lookup2: ('k -> 'k -> order) -> ('k, 'v) t -> 'k ->
+  val insert: 'k cmp -> ('k, 'v) t -> 'k -> 'v -> 'v option * ('k, 'v) t
+
+  val delete: 'k cmp -> ('k, 'v) t -> 'k -> 'v option * ('k, 'v) t
+
+  val lookup: 'k cmp -> ('k, 'v) t -> 'k -> 'v option
+  val lookup2: 'k cmp -> ('k, 'v) t -> 'k ->
         ('v -> 'v option * 'a) * 'a -> 'a * ('k, 'v) t
 
   val print: ('k, 'v) t -> ('k -> string) -> ('v -> string) -> unit
diff --git a/tree.sml b/tree.sml
index 57e9a24..0a788af 100644
--- a/tree.sml
+++ b/tree.sml
@@ -1,6 +1,8 @@
 structure Tree: TREE = struct
   datatype ('k, 'v) t = Node of 'k * 'v * ('k, 'v) t * ('k, 'v) t | Empty
 
+  type 'k cmp = 'k -> 'k -> order
+
   val empty = Empty
 
   fun insert _ Empty k v = (NONE, Node (k, v, Empty, Empty))
@@ -20,6 +22,44 @@ structure Tree: TREE = struct
             (res, Node (k', v', left, right))
           end
 
+  fun delete _ Empty _ = (NONE, Empty)
+    | delete cmp (Node (k', v', left, right)) k =
+        case cmp k k' of
+          LESS =>
+          let
+            val (res, left) = delete cmp left k
+          in
+            (res, Node (k', v', left, right))
+          end
+        | GREATER =>
+          let
+            val (res, right) = delete cmp right k
+          in
+            (res, Node (k', v', left, right))
+          end
+        | EQUAL => (
+            case (left, right) of
+              (Empty, Node _) => (SOME v', right)
+            | (Node _, Empty) => (SOME v', left)
+            | (Empty, Empty) => (SOME v', Empty)
+            | (Node _, Node _) =>
+              let
+                fun deleteRightmost Empty = raise Unreachable
+                  | deleteRightmost (Node (k, v, left, Empty)) =
+                    ((k, v), left)
+                  | deleteRightmost (Node (k, v, left, right)) =
+                  let
+                    val (p, right) = deleteRightmost right
+                  in
+                    (p, Node (k, v, left, right))
+                  end
+
+                val ((k, v), left) = deleteRightmost left
+              in
+                (SOME v', Node (k, v, left, right))
+              end
+        )
+
   fun lookup _ Empty _ = NONE
     | lookup cmp (Node (k', v', left, right)) k =
         case cmp k k' of