--- camlp4/meta/pa_macro.ml	31 Oct 2003 01:02:24 -0000
+++ camlp4/meta/pa_macro.ml	31 Oct 2003 08:06:32 -0000
@@ -49,6 +49,11 @@
   The expression __FILE__ returns the current compiled file name.
   The expression __LOCATION__ returns the current location of itself.
 
+  If a macro is defined to = NOTHING, and then used as an argument to a function,
+  this will be equivalent to function taking one less argument. Similarly,
+  passing NOTHING as an argument to a macro is equivalent to "erasing" the
+  corresponding parameter from the macro body.
+
 *)
 
 #load "pa_extend.cmo";
@@ -77,40 +82,95 @@
 
 value loc = (0, 0);
 
+value rec no_nothing =
+  fun
+    [ [] -> []
+    | [<:expr< NOTHING >> :: tl] -> no_nothing tl
+    | [hd :: tl] -> [hd :: no_nothing tl] ]
+;
+
+value rec no_nothingp =
+  fun
+    [ [] -> []
+    | [<:patt< NOTHING >> :: tl] -> no_nothingp tl
+    | [hd :: tl] -> [hd :: no_nothingp tl] ]
+;
+
 value subst mloc env =
-  loop where rec loop =
+  let rec loop =
     fun
     [ <:expr< let $opt:rf$ $list:pel$ in $e$ >> ->
         let pel = List.map (fun (p, e) -> (p, loop e)) pel in
         <:expr< let $opt:rf$ $list:pel$ in $loop e$ >>
     | <:expr< if $e1$ then $e2$ else $e3$ >> ->
-         <:expr< if $loop e1$ then $loop e2$ else $loop e3$ >>
-    | <:expr< $e1$ $e2$ >> -> <:expr< $loop e1$ $loop e2$ >>
+        <:expr< if $loop e1$ then $loop e2$ else $loop e3$ >>
+    | <:expr< fun $args$ -> $e$ >> -> 
+        match loopp args with
+        [ <:patt< NOTHING >> -> loop e
+        | p -> <:expr< fun $p$ -> $loop e$ >> ]
+    | <:expr< fun [ $list: peoel$ ] >> -> <:expr< fun [ $list: (List.map loop_peoel peoel)$ ] >>
+    | <:expr< $e1$ $e2$ >> as e ->
+        match loop e2 with
+        [ <:expr< NOTHING >> -> loop e1
+        | e2 -> <:expr< $loop e1$ $e2$ >> ]
     | <:expr< $lid:x$ >> | <:expr< $uid:x$ >> as e ->
-        try <:expr< $anti:List.assoc x env$ >> with
-        [ Not_found -> e ]
-    | <:expr< ($list:x$) >> -> <:expr< ($list:List.map loop x$) >>
+        try List.assoc x env with [ Not_found -> e ]
+    | <:expr< ($list:x$) >> -> <:expr< ($list:no_nothing (List.map loop x)$) >>
     | <:expr< do {$list:x$} >> -> <:expr< do {$list:List.map loop x$} >>
     | <:expr< { $list:pel$ } >> ->
-        let pel = List.map (fun (p, e) -> (p, loop e)) pel in
+        let pel = List.map (fun (p, e) -> (loopp p, loop e)) pel in
         <:expr< { $list:pel$ } >>
-    | <:expr< try $e$ with [ $list:pel$ ] >> ->
-        let loop' = fun
-        [ (p, Some e1, e2) -> (p, Some (loop e1), loop e2)
-        | (p, None, e2) -> (p, None, loop e2) ] in
-        <:expr< try $loop e$ with [ $list: (List.map loop' pel)$ ] >>
+    | <:expr< match $e$ with [ $list:peoel$ ] >> ->
+        <:expr< match $loop e$ with [ $list: (List.map loop_peoel peoel)$ ] >>
+    | <:expr< try $e$ with [ $list:peoel$ ] >> ->
+        <:expr< try $loop e$ with [ $list: (List.map loop_peoel peoel)$ ] >>
     | e -> e ]
+  and loop_peoel =
+    fun
+      [ (p, Some e1, e2) -> (loopp p, Some (loop e1), loop e2)
+      | (p, None, e2) -> (loopp p, None, loop e2) ]
+  and loopp =
+    fun
+    [ <:patt< $p1$ $p2$ >> ->
+        match loopp p2 with
+          [ <:patt< NOTHING >> -> loopp p1
+          | p2 -> <:patt< $loopp p1$ $p2$ >> ]
+    | <:patt< $lid:x$ >> ->
+        try to_patt (List.assoc x env) with
+        [ Not_found -> <:patt< $lid:x$ >> ]
+    | <:patt< $uid:x$ >> ->
+        try to_patt (List.assoc x env) with
+        [ Not_found -> <:patt< $uid:x$ >> ]
+    | <:patt< ($list:x$) >> -> <:patt< ($list:no_nothingp (List.map loopp x)$) >>
+    | <:patt< { $list:ppl$ } >> ->
+        let ppl = List.map (fun (p1, p2) -> (p1, loopp p2)) ppl in
+        <:patt< { $list:ppl$ } >>
+    | p -> p ]
+  and to_patt =
+    fun
+      [ <:expr< $e1$ $e2$ >> ->
+         match to_patt e2 with
+          [ <:patt< NOTHING >> -> to_patt e1
+          | e2 -> <:patt< $to_patt e1$ $e2$ >> ]
+      | <:expr< $lid:x$ >> -> <:patt< $lid:x$ >> 
+      | <:expr< $uid:x$ >> -> <:patt< $uid:x$ >> 
+      | <:expr< ($list:x$) >> -> <:patt< ($list:no_nothingp(List.map to_patt x)$) >>
+      | _ -> raise Not_found (* Will be caught by loopp *) ]
+  in loop
 ;
 
 value substp mloc env =
   loop where rec loop =
     fun
-    [ <:expr< $e1$ $e2$ >> -> <:patt< $loop e1$ $loop e2$ >>
+    [ <:expr< $e1$ $e2$ >> ->
+        match loop e2 with
+          [ <:patt< NOTHING >> -> loop e1
+          | p2 -> <:patt< $loop e1$ $p2$ >> ]
     | <:expr< $lid:x$ >> ->
-        try <:patt< $anti:List.assoc x env$ >> with
+        try List.assoc x env with
         [ Not_found -> <:patt< $lid:x$ >> ]
     | <:expr< $uid:x$ >> ->
-        try <:patt< $anti:List.assoc x env$ >> with
+        try List.assoc x env with
         [ Not_found -> <:patt< $uid:x$ >> ]
     | <:expr< $int:x$ >> -> <:patt< $int:x$ >>
     | <:expr< ($list:x$) >> -> <:patt< ($list:List.map loop x$) >>
@@ -133,7 +193,17 @@
 value define eo x =
   do {
     match eo with
-    [ Some ([], e) ->
+    [ Some ([], <:expr< NOTHING >>) ->
+        EXTEND
+          expr: LEVEL "apply"
+            [ [ e = SELF; UIDENT $x$ -> e ] ]
+          ;
+          patt: LEVEL "simple"
+            [ [ p = SELF; UIDENT $x$ -> p
+              | UIDENT $x$; p = SELF -> p ] ]
+          ;
+        END
+    | Some ([], e) ->
         EXTEND
           expr: LEVEL "simple"
             [ [ UIDENT $x$ -> Pcaml.expr_reloc (fun _ -> loc) 0 e ] ]
@@ -185,7 +255,13 @@
     do {
       let eo = List.assoc x defined.val in
       match eo with
-      [ Some ([], _) ->
+      [ Some ([], <:expr< NOTHING >>) ->
+          do {
+            DELETE_RULE expr: SELF; UIDENT $x$ END;
+            DELETE_RULE patt: SELF; UIDENT $x$ END;
+            DELETE_RULE patt: UIDENT $x$; SELF END;
+          }
+      | Some ([], _) ->
           do {
             DELETE_RULE expr: UIDENT $x$ END;
             DELETE_RULE patt: UIDENT $x$ END;