X-Git-Url: http://git.annexia.org/?p=whenjobs.git;a=blobdiff_plain;f=lib%2Fpa_when.ml;h=2d82cb3cfb8a966a20c13081879d6ed748fb3f97;hp=764cabc22267c799b383a6010e1c8549e5f035a9;hb=f3db678247d4ccc04c6ca1655e2eeec17e1bc169;hpb=2177768e4fe92533adc6ef76098312750576dc49

diff --git a/lib/pa_when.ml b/lib/pa_when.ml
index 764cabc..2d82cb3 100644
--- a/lib/pa_when.ml
+++ b/lib/pa_when.ml
@@ -75,6 +75,11 @@ let expr_of_loc _loc loc =
      $`int:stop_line$, $`int:stop_bol$, $`int:stop_off$,
      $`bool:ghost$) >>
 
+(* Convert 'expr option' to an expression that contains the option inside. *)
+let expr_of_option _loc = function
+  | None -> <:expr< None >>
+  | Some e -> <:expr< Some $e$ >>
+
 (* "Lift" an expression, turning it from an expression into an OCaml
  * abstract syntax tree in the output.  This is pretty obscure.
  * http://caml.inria.fr/pub/ml-archives/caml-list/2008/09/591f7c4a8df9295d675a5adcb6802748.en.html
@@ -83,12 +88,15 @@ module M = Ast.Meta.Make (Ast.Meta.MetaGhostLoc)
 let lift_expr = M.Expr.meta_expr
 
 (* Handle a top level statement. *)
-let rec call_stmt name (_loc, stmt, sh) =
-  let name = if name <> "" then name else unique_job_name () in
-  let name = <:expr< $str:name$ >> in
+let rec call_stmt name cleanup (_loc, stmt, sh) =
+  let name =
+    match name with
+    | None -> let name = unique_job_name () in <:expr< $str:name$ >>
+    | Some name -> name in
+  let cleanup = expr_of_option _loc cleanup in
   match stmt with
-  | `When e -> when_stmt _loc name e sh
-  | `Every p -> every_stmt _loc name p sh
+  | `When e -> when_stmt _loc name cleanup e sh
+  | `Every p -> every_stmt _loc name cleanup p sh
 
 (* Handle a top level "when" statement.
  * e -> when expression
@@ -96,20 +104,20 @@ let rec call_stmt name (_loc, stmt, sh) =
  * Returns a top level statement (str_item) which when executed just
  * adds the statement to a global list.
  *)
-and when_stmt _loc name e sh =
+and when_stmt _loc name cleanup e sh =
   let loc = expr_of_loc _loc _loc in
   let e = lift_expr _loc e in
   <:str_item<
     open Camlp4.PreCast
-    Whenfile.add_when_job $loc$ $name$ $e$ $sh$
+    Whenfile.add_when_job $loc$ $name$ $cleanup$ $e$ $sh$
   >>
 
 (* Handle a top level "every" statement. *)
-and every_stmt _loc name period sh =
+and every_stmt _loc name cleanup period sh =
   let loc = expr_of_loc _loc _loc in
   <:str_item<
     open Camlp4.PreCast
-    Whenfile.add_every_job $loc$ $name$ $period$ $sh$
+    Whenfile.add_every_job $loc$ $name$ $cleanup$ $period$ $sh$
   >>
 
 let () =
@@ -201,6 +209,11 @@ EXTEND Gram
   | [ e = period_parser -> e ]
   ];
 
+  (* Cleanup function. *)
+  cleanup: [
+    [ "cleanup"; f = expr -> f ]
+  ];
+
   (* Top level statements. *)
   statement: [
     [ "when"; e = expr; ":"; sh = expr ->
@@ -211,8 +224,11 @@ EXTEND Gram
 
   (* "str_item" is a top level statement in an OCaml program. *)
   str_item: LEVEL "top" [
-    [ s = statement -> call_stmt "" s ]
-  | [ "job"; name = STRING; s = statement -> call_stmt name s ]
+    [ s = statement -> call_stmt None None s ]
+  | [ "job"; name = expr;
+      cleanup = OPT cleanup;
+      s = statement ->
+        call_stmt (Some name) cleanup s ]
   ];
 
 END