From f1ebc0ed7dcc76ba55579a983642d279b26d3a6c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= <jeremie@dimino.org>
Date: Sun, 28 May 2017 04:25:02 +0100
Subject: [PATCH] Add (mli-to-ml ...) as a hack for mli only modules

---
 doc/jbuild.rst      | 32 +++++++++++++++++++++++++++++++-
 src/jbuild_types.ml | 18 ++++++++++++++++++
 src/sexp.ml         |  3 +++
 src/sexp.mli        |  2 ++
 4 files changed, 54 insertions(+), 1 deletion(-)

diff --git a/doc/jbuild.rst b/doc/jbuild.rst
index c9e72f1b..6498598b 100644
--- a/doc/jbuild.rst
+++ b/doc/jbuild.rst
@@ -336,7 +336,37 @@ Extra flags can be passed to menhir using the ``flags`` flag:
     (menhir
      ((flags (<option1> <option2> ...))
       (modules (<parser1> <parser2> ...))))
-         
+
+ml_of_mli, re_of_rei
+--------------------
+
+``(ml_of_mli (<names>))`` produces rules that generate ``.ml`` files
+from ``.mli`` files, using a hack based on recursive
+modules. ``re_of_rei`` is the equivalent fot reason files.
+
+More precisely, given a stanza ``(ml_of_mli (foo))`` the following
+``.ml`` file is generated:
+
+.. code:: ocaml
+
+    [@@@warning "-a"]
+    module rec Foo : sig
+    (* contents of foo.mli *)
+    end = Foo
+
+If you have a ``.mli`` file containing only type declarations, this
+allows you to automatically produce the corresponding
+implementation.
+
+Note that if the ``.mli`` file does contain a value declaration, the
+compilation of the generated ``.ml`` file will fail with an error
+about recursive module. In particular declaring an exception or
+extension constructor implicitely declares a value. The error won't be
+precide because the compiler doesn't support checking that a mli file
+doesn't contain value declaration. See ``this ticket
+<https://github.com/janestreet/jbuilder/issues/9>``__ for a discussion
+about these issues.
+
 alias
 -----
 
diff --git a/src/jbuild_types.ml b/src/jbuild_types.ml
index 82ef9f77..44d493b6 100644
--- a/src/jbuild_types.ml
+++ b/src/jbuild_types.ml
@@ -737,6 +737,22 @@ module Do = struct
     { loc = Sexp.Ast.loc sexp
     ; action = Action.Unexpanded.t sexp
     }
+
+  let ml_of_mli names =
+    List.map names ~f:(fun (loc, name) ->
+      let strf fmt = Printf.ksprintf (String_with_vars.of_string ~loc) fmt in
+      let m = String.capitalize_ascii name in
+      { loc
+      ; action =
+          Redirect
+            (Stdout,
+             strf "%s.ml" name,
+             Progn
+               [ Echo (strf "[@@@warning \"-a\"]\nmodule rec %s : sig\n" m)
+               ; Cat  (strf "%s.mli" name)
+               ; Echo (strf "\nend = %s\ninclude %s\n" m m)
+               ])
+      })
 end
 
 module Menhir = struct
@@ -921,6 +937,8 @@ module Stanza = struct
           (fun pat vals sexps ->
              let sexps = Foreach.expand pat vals sexps in
              List.concat_map sexps ~f:(v1 pkgs))
+      ; cstr "ml_of_mli" (list (located string) @> nil)
+          (fun x -> List.map (Do.ml_of_mli x) ~f:(fun x -> Do x))
       (* Just for validation and error messages *)
       ; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> [])
       ]
diff --git a/src/sexp.ml b/src/sexp.ml
index 3ef3ef8e..478860f1 100644
--- a/src/sexp.ml
+++ b/src/sexp.ml
@@ -190,6 +190,9 @@ module Of_sexp = struct
 
   type 'a t = ast -> 'a
 
+  let located f sexp =
+    (Ast.loc sexp, f sexp)
+
   let of_sexp_error sexp str = raise (Loc.Error (Ast.loc sexp, str))
   let of_sexp_errorf sexp fmt = ksprintf (of_sexp_error sexp) fmt
 
diff --git a/src/sexp.mli b/src/sexp.mli
index 44f8d743..be5a96bf 100644
--- a/src/sexp.mli
+++ b/src/sexp.mli
@@ -66,6 +66,8 @@ module Of_sexp : sig
   val of_sexp_error  : Ast.t -> string -> _
   val of_sexp_errorf : Ast.t -> ('a, unit, string, 'b) format4 -> 'a
 
+  val located : 'a t -> (Loc.t * 'a) t
+
   (* Record parsing monad *)
   type 'a record_parser
   val return : 'a -> 'a record_parser