[camlp4] tests fixtures and examples...

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@7539 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

camlp4/examples/expression_closure_filter.ml

@@ -0,0 +1,50 @@
+(* camlp4r *)
+#default_quotation "expr";
+
+open Camlp4.PreCast;
+open Format;
+
+module FV = Camlp4.Struct.FreeVars.Make Ast;
+module S = FV.S;
+
+value _loc = Loc.ghost;
+
+value pervasives =
+  let list =
+    [ "+"; "-"; "/"; "*" (* ... *) ]
+  in List.fold_right S.add list S.empty;
+
+value collect_free_vars_sets =
+  object (self)
+    inherit FV.fold_free_vars [S.t] S.add ~env_init:pervasives S.empty as super;
+    value free_sets = [];
+    method set_free free = {< free = free >};
+    method expr =
+      fun
+      [ << close_expr $e$ >> -> (self#expr e)#add_current_free#set_free free
+      | e -> super#expr e ];
+    method add_current_free = {< free_sets = [ free :: free_sets ] >};
+    method free_sets = free_sets;
+  end;
+
+value apply_close_expr next_free_set =
+  object (self)
+    inherit Ast.map as super;
+    method expr =
+      fun
+      [ << close_expr $e$ >> ->
+          let e = self#expr e in
+          let fv = next_free_set () in
+          S.fold (fun x acc -> << fun ~ $x$ -> $acc$ >>) fv e
+      | e -> super#expr e ];
+  end;
+
+value f st =
+  let fv_sets = ref (collect_free_vars_sets#str_item st)#free_sets in
+  let next_free_set () =
+    match fv_sets.val with
+    [ [] -> assert False
+    | [x::xs] -> let () = fv_sets.val := xs in x ]
+  in (apply_close_expr next_free_set)#str_item st;
+
+AstFilters.register_str_item_filter f;

camlp4/examples/global_handler.ml

@@ -0,0 +1,22 @@
+open Camlp4.PreCast;
+
+value ghost = Loc.ghost;
+
+value global_handler_ref = ref <:expr@ghost<>>;
+
+value find_global_handler = object
+  inherit Ast.map as super;
+  method str_item st = do {
+    match st with
+    [ <:str_item< value global_handler = $f$ >> -> global_handler_ref.val := f
+    | _ -> () ];
+    super#str_item st
+  };
+end;
+
+AstFilters.register_str_item_filter
+  (fun st ->
+    let _ = find_global_handler#str_item st in
+    <:str_item@ghost< try let module Main = struct $st$ end in ()
+                      with e -> $global_handler_ref.val$ e >>);
+

camlp4/examples/global_handler_test.ml

@@ -0,0 +1,12 @@
+open Format;;
+let f1 x = printf "f1 %d@." x;;
+let f2 x = printf "f2 %f@." x;;
+let f3 x = printf "f3 %s@." x;;
+f1 1;;
+f2 1.1;;
+f3 "1.1.1";;
+raise (Failure "test");;
+let global_handler e =
+  (* Note that I need to give the complete name for eprintf since
+     Format is not opened in the new environment of global_handler. *)
+  Format.eprintf "global_handler: %s@." (Printexc.to_string e)

camlp4/test/fixtures/expression_closure_test.ml

@@ -0,0 +1,14 @@
+(* x and y are free *)
+close_expr(x y);;
+
+(* bind x *)
+let x = 42;;
+
+(* y is free *)
+close_expr(x y);;
+
+(* bind y locally so the expr is closed *)
+close_expr(let y = x in x y);;
+
+(* bind y locally but outside, z is free *)
+let y = x in close_expr(x z y);;