flambda-backend: Use exported modules in Jane_syntax_parsing (#1477)

This reverts an earlier change to use GADTs to accomplish a similar
goal. In ongoing work to add layout annotations, though, I need to
add more types to these modules, and adding them to the GADT approach
felt unwieldy. (I believe the two approaches are equally expressive.
It just comes down to taste.)

To keep things clean, I'm pushing this change separately from the
annotations work.

parsing/ast_mapper.ml

@@ -149,7 +149,7 @@ module T = struct
     match Jane_syntax.Core_type.of_ast typ with
     | Some (jtyp, attrs) -> begin
         let attrs = sub.attributes sub attrs in
-        Jane_syntax_parsing.AST.wrap_desc Core_type ~loc ~attrs @@
+        Jane_syntax_parsing.Core_type.wrap_desc ~loc ~attrs @@
         match sub.typ_jane_syntax sub jtyp with
         | _ -> .
     end
@@ -302,7 +302,7 @@ module MT = struct
     match Jane_syntax.Module_type.of_ast mty with
     | Some (jmty, attrs) -> begin
         let attrs = sub.attributes sub attrs in
-        Jane_syntax_parsing.AST.wrap_desc Module_type ~loc ~attrs @@
+        Jane_syntax_parsing.Module_type.wrap_desc ~loc ~attrs @@
         match sub.module_type_jane_syntax sub jmty with
         | Jmty_strengthen smty -> Jane_syntax.Strengthen.mty_of ~loc smty
       end
@@ -354,7 +354,7 @@ module MT = struct
     let loc = sub.location sub loc in
     match Jane_syntax.Signature_item.of_ast sigi with
     | Some jsigi -> begin
-        Jane_syntax_parsing.AST.wrap_desc Signature_item ~loc ~attrs:[] @@
+        Jane_syntax_parsing.Signature_item.wrap_desc ~loc ~attrs:[] @@
         match sub.signature_item_jane_syntax sub jsigi with
         | Jsig_include_functor incl ->
             Jane_syntax.Include_functor.sig_item_of ~loc incl
@@ -434,7 +434,7 @@ module M = struct
     let loc = sub.location sub loc in
     match Jane_syntax.Structure_item.of_ast stri with
     | Some jstri -> begin
-        Jane_syntax_parsing.AST.wrap_desc Structure_item ~loc ~attrs:[] @@
+        Jane_syntax_parsing.Structure_item.wrap_desc ~loc ~attrs:[] @@
         match sub.structure_item_jane_syntax sub jstri with
         | Jstr_include_functor incl ->
             Jane_syntax.Include_functor.str_item_of ~loc incl
@@ -512,7 +512,7 @@ module E = struct
     match Jane_syntax.Expression.of_ast exp with
     | Some (jexp, attrs) -> begin
         let attrs = sub.attributes sub attrs in
-        Jane_syntax_parsing.AST.wrap_desc Expression ~loc ~attrs @@
+        Jane_syntax_parsing.Expression.wrap_desc ~loc ~attrs @@
         match sub.expr_jane_syntax sub jexp with
         | Jexp_comprehension   c -> Jane_syntax.Comprehensions.expr_of   ~loc c
         | Jexp_immutable_array i -> Jane_syntax.Immutable_arrays.expr_of ~loc i
@@ -623,7 +623,7 @@ module P = struct
     match Jane_syntax.Pattern.of_ast pat with
     | Some (jpat, attrs) -> begin
         let attrs = sub.attributes sub attrs in
-        Jane_syntax_parsing.AST.wrap_desc Pattern ~loc ~attrs @@
+        Jane_syntax_parsing.Pattern.wrap_desc ~loc ~attrs @@
         match sub.pat_jane_syntax sub jpat with
         | Jpat_immutable_array i -> Jane_syntax.Immutable_arrays.pat_of ~loc i
     end

parsing/jane_syntax.ml

@@ -95,8 +95,8 @@ module Comprehensions = struct
   *)
 
   let comprehension_expr names x =
-    AST.wrap_desc Expression ~attrs:[] ~loc:x.pexp_loc @@
-    AST.make_jane_syntax Expression feature names x
+    Expression.wrap_desc ~attrs:[] ~loc:x.pexp_loc @@
+    Expression.make_jane_syntax feature names x
 
   (** First, we define how to go from the nice AST to the OCaml AST; this is
       the [expr_of_...] family of expressions, culminating in
@@ -145,7 +145,7 @@ module Comprehensions = struct
 
   let expr_of ~loc cexpr =
     (* See Note [Wrapping with make_entire_jane_syntax] *)
-    AST.make_entire_jane_syntax Expression ~loc feature (fun () ->
+    Expression.make_entire_jane_syntax ~loc feature (fun () ->
       match cexpr with
       | Cexp_list_comprehension comp ->
           expr_of_comprehension ~type_:["list"] comp
@@ -289,7 +289,7 @@ module Immutable_arrays = struct
   let expr_of ~loc = function
     | Iaexp_immutable_array elts ->
       (* See Note [Wrapping with make_entire_jane_syntax] *)
-      AST.make_entire_jane_syntax Expression ~loc feature (fun () ->
+      Expression.make_entire_jane_syntax ~loc feature (fun () ->
         Ast_helper.Exp.array elts)
 
   (* Returns remaining unconsumed attributes *)
@@ -300,7 +300,7 @@ module Immutable_arrays = struct
   let pat_of ~loc = function
     | Iapat_immutable_array elts ->
       (* See Note [Wrapping with make_entire_jane_syntax] *)
-      AST.make_entire_jane_syntax Pattern ~loc feature (fun () ->
+      Pattern.make_entire_jane_syntax ~loc feature (fun () ->
         Ast_helper.Pat.array elts)
 
   (* Returns remaining unconsumed attributes *)
@@ -322,7 +322,7 @@ module Include_functor = struct
   let sig_item_of ~loc = function
     | Ifsig_include_functor incl ->
         (* See Note [Wrapping with make_entire_jane_syntax] *)
-        AST.make_entire_jane_syntax Signature_item ~loc feature (fun () ->
+        Signature_item.make_entire_jane_syntax ~loc feature (fun () ->
           Ast_helper.Sig.include_ incl)
 
   let of_sig_item sigi = match sigi.psig_desc with
@@ -332,7 +332,7 @@ module Include_functor = struct
   let str_item_of ~loc = function
     | Ifstr_include_functor incl ->
         (* See Note [Wrapping with make_entire_jane_syntax] *)
-        AST.make_entire_jane_syntax Structure_item ~loc feature (fun () ->
+        Structure_item.make_entire_jane_syntax ~loc feature (fun () ->
           Ast_helper.Str.include_ incl)
 
   let of_str_item stri = match stri.pstr_desc with
@@ -353,7 +353,7 @@ module Strengthen = struct
 
   let mty_of ~loc { mty; mod_id } =
     (* See Note [Wrapping with make_entire_jane_syntax] *)
-    AST.make_entire_jane_syntax Module_type ~loc feature (fun () ->
+    Module_type.make_entire_jane_syntax ~loc feature (fun () ->
       Ast_helper.Mty.functor_ (Named (Location.mknoloc None, mty))
         (Ast_helper.Mty.alias mod_id))
 
@@ -380,7 +380,7 @@ module Core_type = struct
   let of_ast_internal (feat : Feature.t) _typ = match feat with
     | _ -> None
 
-  let of_ast = AST.make_of_ast Core_type ~of_ast_internal
+  let of_ast = Core_type.make_of_ast ~of_ast_internal
 end
 
 module Constructor_argument = struct
@@ -389,7 +389,7 @@ module Constructor_argument = struct
   let of_ast_internal (feat : Feature.t) _carg = match feat with
     | _ -> None
 
-  let of_ast = AST.make_of_ast Constructor_argument ~of_ast_internal
+  let of_ast = Constructor_argument.make_of_ast ~of_ast_internal
 end
 
 module Expression = struct
@@ -406,7 +406,7 @@ module Expression = struct
       Some (Jexp_immutable_array expr, attrs)
     | _ -> None
 
-  let of_ast = AST.make_of_ast Expression ~of_ast_internal
+  let of_ast = Expression.make_of_ast ~of_ast_internal
 end
 
 module Pattern = struct
@@ -419,7 +419,7 @@ module Pattern = struct
       Some (Jpat_immutable_array expr, attrs)
     | _ -> None
 
-  let of_ast = AST.make_of_ast Pattern ~of_ast_internal
+  let of_ast = Pattern.make_of_ast ~of_ast_internal
 end
 
 module Module_type = struct
@@ -432,7 +432,7 @@ module Module_type = struct
       Some (Jmty_strengthen mty, attrs)
     | _ -> None
 
-  let of_ast = AST.make_of_ast Module_type ~of_ast_internal
+  let of_ast = Module_type.make_of_ast ~of_ast_internal
 end
 
 module Signature_item = struct
@@ -445,7 +445,7 @@ module Signature_item = struct
       Some (Jsig_include_functor (Include_functor.of_sig_item sigi))
     | _ -> None
 
-  let of_ast = AST.make_of_ast Signature_item ~of_ast_internal
+  let of_ast = Signature_item.make_of_ast ~of_ast_internal
 end
 
 module Structure_item = struct
@@ -458,5 +458,5 @@ module Structure_item = struct
       Some (Jstr_include_functor (Include_functor.of_str_item stri))
     | _ -> None
 
-  let of_ast = AST.make_of_ast Structure_item ~of_ast_internal
+  let of_ast = Structure_item.make_of_ast ~of_ast_internal
 end

parsing/jane_syntax_parsing.ml

@@ -464,7 +464,7 @@ module type AST_syntactic_category = sig
     ?loc:Location.t -> attrs:attributes -> ast_desc -> ast
 end
 
-module type AST = sig
+module type AST_internal = sig
   include AST_syntactic_category
 
   val embedding_syntax : Embedding_syntax.t
@@ -543,9 +543,9 @@ module Make_with_attribute
        val attributes : ast -> attributes
        val with_attributes : ast -> attributes -> ast
      end) :
-    AST with type ast      = AST_syntactic_category.ast
-         and type ast_desc =
-               AST_syntactic_category.ast_desc With_attributes.t
+    AST_internal with type ast      = AST_syntactic_category.ast
+                  and type ast_desc =
+                        AST_syntactic_category.ast_desc With_attributes.t
 = struct
     include AST_syntactic_category
 
@@ -606,8 +606,8 @@ module Make_with_extension_node
           [AST.match_extension]). Partial inverse of [make_extension_use]. *)
       val match_extension_use : ast -> (extension * ast) option
      end) :
-    AST with type ast      = AST_syntactic_category.ast
-         and type ast_desc = AST_syntactic_category.ast_desc =
+    AST_internal with type ast      = AST_syntactic_category.ast
+                  and type ast_desc = AST_syntactic_category.ast_desc =
   struct
     include AST_syntactic_category
 
@@ -655,21 +655,21 @@ module Type_AST_syntactic_category = struct
 end
 
 (** Types; embedded as [[[%jane.FEATNAME] * BODY]]. *)
-module Core_type = Make_with_attribute (struct
+module Core_type0 = Make_with_attribute (struct
     include Type_AST_syntactic_category
 
     let plural = "types"
 end)
 
 (** Constructor arguments; the same as types, but used in fewer places *)
-module Constructor_argument = Make_with_attribute (struct
+module Constructor_argument0 = Make_with_attribute (struct
   include Type_AST_syntactic_category
 
   let plural = "constructor arguments"
 end)
 
 (** Expressions; embedded using an attribute on the expression. *)
-module Expression = Make_with_attribute (struct
+module Expression0 = Make_with_attribute (struct
   type ast = expression
   type ast_desc = expression_desc
 
@@ -685,7 +685,7 @@ module Expression = Make_with_attribute (struct
 end)
 
 (** Patterns; embedded using an attribute on the pattern. *)
-module Pattern = Make_with_attribute (struct
+module Pattern0 = Make_with_attribute (struct
   type ast = pattern
   type ast_desc = pattern_desc
 
@@ -701,7 +701,7 @@ module Pattern = Make_with_attribute (struct
 end)
 
 (** Module types; embedded using an attribute on the module type. *)
-module Module_type = Make_with_attribute (struct
+module Module_type0 = Make_with_attribute (struct
     type ast = module_type
     type ast_desc = module_type_desc
 
@@ -720,7 +720,7 @@ end)
     [include sig [%%extension.EXTNAME];; BODY end]. Signature items don't have
     attributes or we'd use them instead.
 *)
-module Signature_item = Make_with_extension_node (struct
+module Signature_item0 = Make_with_extension_node (struct
     type ast = signature_item
     type ast_desc = signature_item_desc
 
@@ -763,7 +763,7 @@ end)
     [include struct [%%extension.EXTNAME];; BODY end]. Structure items don't
     have attributes or we'd use them instead.
 *)
-module Structure_item = Make_with_extension_node (struct
+module Structure_item0 = Make_with_extension_node (struct
     type ast = structure_item
     type ast_desc = structure_item_desc
 
@@ -803,51 +803,37 @@ module Structure_item = Make_with_extension_node (struct
 end)
 
 (******************************************************************************)
+(* Main exports *)
 
-module AST = struct
-  type (_, _) t =
-    | Expression : (expression, expression_desc With_attributes.t) t
-    | Pattern : (pattern, pattern_desc With_attributes.t) t
-    | Module_type : (module_type, module_type_desc With_attributes.t) t
-    | Signature_item : (signature_item, signature_item_desc) t
-    | Structure_item : (structure_item, structure_item_desc) t
-    | Core_type : (core_type, core_type_desc With_attributes.t) t
-    | Constructor_argument : (core_type, core_type_desc With_attributes.t) t
-
-  let to_module (type ast ast_desc) (t : (ast, ast_desc) t) :
-    (module AST with type ast = ast and type ast_desc = ast_desc) =
-    match t with
-    | Expression -> (module Expression)
-    | Pattern -> (module Pattern)
-    | Module_type -> (module Module_type)
-    | Signature_item -> (module Signature_item)
-    | Structure_item -> (module Structure_item)
-    | Core_type -> (module Core_type)
-    | Constructor_argument -> (module Constructor_argument)
-
-  let wrap_desc (type ast ast_desc) (t : (ast, ast_desc) t) =
-    let (module AST) = to_module t in
-    AST.wrap_desc
-
-  let make_jane_syntax
-      (type ast ast_desc)
-      (t : (ast, ast_desc) t)
-      feature
-      trailing_components
-      ast
-    =
-    let (module AST) = to_module t in
+module type AST = sig
+  type ast
+  type ast_desc
+
+  val wrap_desc :
+    ?loc:Location.t -> attrs:Parsetree.attributes -> ast_desc -> ast
+  val make_jane_syntax : Feature.t -> string list -> ast -> ast_desc
+  val make_entire_jane_syntax :
+    loc:Location.t -> Feature.t -> (unit -> ast) -> ast_desc
+  val make_of_ast :
+    of_ast_internal:(Feature.t -> ast -> 'a option) -> (ast -> 'a option)
+end
+
+module Make_ast (AST : AST_internal) : AST with type ast = AST.ast
+                                            and type ast_desc = AST.ast_desc
+  = struct
+  include AST
+
+  let make_jane_syntax feature trailing_components ast =
     AST.make_jane_syntax
       (Embedded_name.of_feature feature trailing_components)
       ast
 
-  let make_entire_jane_syntax t ~loc feature ast =
-    make_jane_syntax t feature []
+  let make_entire_jane_syntax ~loc feature ast =
+    make_jane_syntax feature []
       (Ast_helper.with_default_loc (Location.ghostify loc) ast)
 
   (** Generically lift our custom ASTs for our novel syntax from OCaml ASTs. *)
-  let make_of_ast (type ast ast_desc) (t : (ast, ast_desc) t) ~of_ast_internal =
-    let (module AST) = to_module t in
+  let make_of_ast ~of_ast_internal =
     let of_ast ast =
       let loc = AST.location ast in
       let raise_error err = raise (Error (loc, err)) in
@@ -873,3 +859,11 @@ module AST = struct
     in
     of_ast
 end
+
+module Expression = Make_ast(Expression0)
+module Pattern = Make_ast(Pattern0)
+module Module_type = Make_ast(Module_type0)
+module Signature_item = Make_ast(Signature_item0)
+module Structure_item = Make_ast(Structure_item0)
+module Core_type = Make_ast(Core_type0)
+module Constructor_argument = Make_ast(Constructor_argument0)