Extend ifdef example, with a compile-time getenv.

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

4 files changed, 38 insertions, 7 deletions

diff --git a/experimental/frisch/ast_mapper.ml b/experimental/frisch/ast_mapper.ml
index f6c3611a34..945cee6c24 100644
--- a/experimental/frisch/ast_mapper.ml
+++ b/experimental/frisch/ast_mapper.ml
@@ -6,6 +6,7 @@ open Asttypes
 (* First, some helpers to build AST fragments *)
 
 let map_flatten f l = List.flatten (List.map f l)
+let map_snd f (x, y) = (x, f y)
 
 module SI = struct
   (* Structure items *)
@@ -33,7 +34,8 @@ module E = struct
   let ident ?loc x = mk ?loc (Pexp_ident x)
   let lid ?(loc = Location.none) lid = ident ~loc (mkloc (Longident.parse lid) loc)
   let let_ ?loc r pel e = mk ?loc (Pexp_let (r, pel, e))
-  let app ?loc f el = mk ?loc (Pexp_apply (f, List.map (fun e -> ("", e)) el))
+  let apply_with_labels ?loc f el = mk ?loc (Pexp_apply (f, el))
+  let apply ?loc f el = apply_with_labels ?loc f (List.map (fun e -> ("", e)) el)
   let const ?loc x = mk ?loc (Pexp_constant x)
   let strconst ?loc x = const ?loc (Const_string x)
 end
@@ -235,6 +237,7 @@ class create =
       match desc with
       | Pexp_ident x -> this # exp_ident ~loc x
       | Pexp_let (r, pel, e) -> this # exp_let ~loc r pel e
+      | Pexp_apply (e, l) -> this # exp_apply ~loc e l
             (* ... *)
       | _ -> x
 
@@ -247,6 +250,10 @@ class create =
         (List.map (fun (p, e) -> this # pat p, this # expr e) pel)
         (this # expr e)
 
+    method exp_apply = this # default_exp_apply
+    method default_exp_apply ~loc e l =
+      E.apply_with_labels ~loc (this # expr e) (List.map (map_snd (this # expr)) l)
+
         (* module exprs *)
 
     method module_expr = this # default_module_expr
diff --git a/experimental/frisch/ifdef.ml b/experimental/frisch/ifdef.ml
index 78278f71e8..944d1feb99 100644
--- a/experimental/frisch/ifdef.ml
+++ b/experimental/frisch/ifdef.ml
@@ -3,12 +3,20 @@
    IFDEF(X)(<m1>)(<m2>)
                ---> <m1>      if the environment variable X is defined
                ---> <m2>      otherwise
+
+   And, on expressions:
+
+   GETENV X    ---> the string literal representing the compile-time value
+                    of environment variable X
 *)
 
+open Ast_mapper
 open Parsetree
 open Longident
 open Location
 
+let getenv s = try Sys.getenv s with Not_found -> ""
+
 let ifdef =
   object(this)
     inherit Ast_mapper.create as super
@@ -22,7 +30,7 @@ let ifdef =
           )},
           body_def)},
          body_not_def)} ->
-           if (try Sys.getenv sym <> "" with Not_found -> false) then
+           if getenv sym <> "" then
              this # module_expr body_def
            else
              this # module_expr body_not_def
@@ -32,6 +40,19 @@ let ifdef =
             Location.print_loc loc;
           exit 2
       | x -> super # module_expr x
+
+    method! expr = function
+      | {pexp_desc = Pexp_construct (
+         {txt = Lident "GETENV"},
+         Some {pexp_loc = loc; pexp_desc = Pexp_construct (
+               {txt = Lident sym},
+               None,
+               _
+              )},
+         _
+        )} ->
+          E.strconst ~loc (getenv sym)
+      | x -> super # expr x
   end
 
 let () = ifdef # main
diff --git a/experimental/frisch/test_ifdef.ml b/experimental/frisch/test_ifdef.ml
index 18fdaf87a1..6f1479019a 100644
--- a/experimental/frisch/test_ifdef.ml
+++ b/experimental/frisch/test_ifdef.ml
@@ -1,7 +1,12 @@
 include IFDEF(XHOME)(struct
   let () = print_endline "Defined!"
 end)
-(*(struct
+(struct
   let () = print_endline "Not defined!"
 end)
-*)
+
+
+let () =
+  Printf.printf "compiled by user %s in directory %s\n%!"
+    (GETENV USER)
+    (GETENV PWD)
diff --git a/experimental/frisch/tracer.ml b/experimental/frisch/tracer.ml
index 8ed376b69f..9dba1a97f9 100644
--- a/experimental/frisch/tracer.ml
+++ b/experimental/frisch/tracer.ml
@@ -1,7 +1,5 @@
 open Ast_mapper
-open Longident
 open Location
-open Parsetree
 
 (* To define a concrete AST rewriter, we can inherit from the generic
    mapper, and redefine the cases we are interested in.  In the
@@ -10,7 +8,7 @@ open Parsetree
    the compilation unit.  *)
 
 let trace s =
-  SI.eval E.(app (lid "Pervasives.print_endline") [strconst s])
+  SI.eval E.(apply (lid "Pervasives.print_endline") [strconst s])
 
 let tracer =
   object