Merge pull request #128 from janestreet/use-parameter-flag

Process the `-parameter` flag

Author: lukemaurer

src/kernel/mconfig.ml

@@ -54,6 +54,7 @@ let dump_ocaml x =
       ("pp", Json.option (dump_with_workdir Json.string) x.pp);
       ("warnings", dump_warnings x.warnings);
       ("cmi_file", Json.option Json.string x.cmi_file);
+      ("parameters", `List (List.map ~f:Json.string x.parameters));
       ("as_parameter", `Bool x.as_parameter);
       ( "zero_alloc_check",
         `String (Zero_alloc_annotations.to_string x.zero_alloc_check) )

src/kernel/mocaml.ml

@@ -52,11 +52,16 @@ let setup_reader_config config =
   as_parameter := ocaml.as_parameter;
   zero_alloc_check := ocaml.zero_alloc_check
 
+let init_params params =
+  List.iter params ~f:(fun s ->
+      Env.register_parameter (s |> Global_module.Name.create_no_args))
+
 let setup_typer_config config =
   setup_reader_config config;
   let visible = Mconfig.build_path config in
   let hidden = Mconfig.hidden_build_path config in
-  Load_path.(init ~auto_include:no_auto_include ~visible ~hidden)
+  Load_path.(init ~auto_include:no_auto_include ~visible ~hidden);
+  init_params config.ocaml.parameters
 
 (** Switchable implementation of Oprint *)
 

src/kernel/mtyper.ml

@@ -289,10 +289,13 @@ let run config parsetree =
     (* Resetting the local store will clear the load_path cache.
        Save it now, reset the store and then restore the path. *)
     let { Load_path.visible; hidden } = Load_path.get_paths () in
+    (* Same story with the registered parameters. *)
+    let parameters = Env.parameters () in
     Mocaml.flush_caches ();
     Local_store.reset ();
     Load_path.reset ();
-    Load_path.(init ~auto_include:no_auto_include ~visible ~hidden));
+    Load_path.(init ~auto_include:no_auto_include ~visible ~hidden);
+    List.iter ~f:Env.register_parameter parameters);
   let caught = ref [] in
   Msupport.catch_errors Mconfig.(config.ocaml.warnings) caught @@ fun () ->
   Typecore.reset_delayed_checks ();

tests/test-dirs/parameters.t/basic.ml

@@ -0,0 +1,6 @@
+type t = P.t
+
+let create () = P.create ()
+let wrap t = t
+let p t = t
+let to_string t = "Basic(" ^ P.to_string t ^ ")"

tests/test-dirs/parameters.t/basic.mli

@@ -0,0 +1,15 @@
+(** Basic functionality implemented over the [P] parameter. *)
+
+(** A [P.t] with minor enhancements. *)
+type t
+
+(** Make a [t] from scratch. *)
+val create : unit -> t
+
+(** Make a [t] from a [P.t]. *)
+val wrap : P.t -> t
+
+val p : t -> P.t
+
+(** Convert [t] to string. *)
+val to_string : t -> string

tests/test-dirs/parameters.t/fancy.ml

@@ -0,0 +1,5 @@
+type t = Basic.t
+
+let create t = t
+let wrap t = Basic.wrap t
+let to_string t = "Fancy(" ^ Basic.to_string t ^ ")"

tests/test-dirs/parameters.t/fancy.mli

@@ -0,0 +1,6 @@
+type t
+
+(** Make something fancy out of something basic. *)
+val create : Basic.t -> t
+val wrap : P.t -> t
+val to_string : t -> string

tests/test-dirs/parameters.t/p_int.ml

@@ -0,0 +1,5 @@
+type t = int
+
+let create () = 0
+let frob = succ
+let to_string = string_of_int

tests/test-dirs/parameters.t/p_int.mli

@@ -0,0 +1,5 @@
+type t = int
+
+val create : unit -> t
+val frob : t -> t
+val to_string : t -> string

tests/test-dirs/parameters.t/p_modified.mli

@@ -0,0 +1,13 @@
+(** A parameter module. *)
+
+(** A thing. *)
+type t
+
+(** Make a thing. *)
+val create : int -> t
+
+(** Frobnicate the thing. *)
+val frob : t -> t
+
+(** Show the thing. *)
+val to_string : t -> string