move [fail_if_wrong_syntactic_category] to functor

ocaml/parsing/jane_syntax.ml

@@ -458,9 +458,7 @@ module Core_type = struct
   let of_ast_internal (feat : Feature.t) _typ = match feat with
     | _ -> None
 
-  let of_ast =
-    Core_type.make_of_ast
-      ~of_ast_internal ~fail_if_wrong_syntactic_category:true
+  let of_ast = Core_type.make_of_ast ~of_ast_internal
 end
 
 module Constructor_argument = struct
@@ -469,9 +467,7 @@ module Constructor_argument = struct
   let of_ast_internal (feat : Feature.t) _carg = match feat with
     | _ -> None
 
-  let of_ast =
-    Constructor_argument.make_of_ast
-      ~of_ast_internal ~fail_if_wrong_syntactic_category:true
+  let of_ast = Constructor_argument.make_of_ast ~of_ast_internal
 end
 
 module Expression = struct
@@ -492,9 +488,7 @@ module Expression = struct
       Some (Jexp_unboxed_constant expr, attrs)
     | _ -> None
 
-  let of_ast =
-    Expression.make_of_ast
-      ~of_ast_internal ~fail_if_wrong_syntactic_category:true
+  let of_ast = Expression.make_of_ast ~of_ast_internal
 
   let expr_of ~loc ~attrs = function
     | Jexp_comprehension    x -> Comprehensions.expr_of    ~loc ~attrs x
@@ -512,8 +506,7 @@ module Case = struct
       Some (Jcase_pattern_guarded case)
     | _ -> None
 
-  let of_ast =
-    Case.make_of_ast ~of_ast_internal ~fail_if_wrong_syntactic_category:false
+  let of_ast = Case.make_of_ast ~of_ast_internal
 
   let case_of ~loc = function
     | Jcase_pattern_guarded x -> Pattern_guarded.case_of ~loc x
@@ -533,8 +526,7 @@ module Pattern = struct
       Some (Jpat_unboxed_constant pat, attrs)
     | _ -> None
 
-  let of_ast =
-    Pattern.make_of_ast ~of_ast_internal ~fail_if_wrong_syntactic_category:true
+  let of_ast = Pattern.make_of_ast ~of_ast_internal
 
   let pat_of ~loc ~attrs = function
     | Jpat_immutable_array x -> Immutable_arrays.pat_of ~loc ~attrs x
@@ -551,9 +543,7 @@ module Module_type = struct
       Some (Jmty_strengthen mty, attrs)
     | _ -> None
 
-  let of_ast =
-    Module_type.make_of_ast
-      ~of_ast_internal ~fail_if_wrong_syntactic_category:true
+  let of_ast = Module_type.make_of_ast ~of_ast_internal
 end
 
 module Signature_item = struct
@@ -567,8 +557,7 @@ module Signature_item = struct
     | _ -> None
 
   let of_ast =
-    Signature_item.make_of_ast
-      ~of_ast_internal ~fail_if_wrong_syntactic_category:true
+    Signature_item.make_of_ast ~of_ast_internal
 end
 
 module Structure_item = struct
@@ -581,9 +570,7 @@ module Structure_item = struct
       Some (Jstr_include_functor (Include_functor.of_str_item stri))
     | _ -> None
 
-  let of_ast =
-    Structure_item.make_of_ast
-      ~of_ast_internal ~fail_if_wrong_syntactic_category:true
+  let of_ast = Structure_item.make_of_ast ~of_ast_internal
 end
 
 module Extension_constructor = struct
@@ -592,7 +579,5 @@ module Extension_constructor = struct
   let of_ast_internal (feat : Feature.t) _ext = match feat with
     | _ -> None
 
-  let of_ast =
-    Extension_constructor.make_of_ast
-      ~of_ast_internal ~fail_if_wrong_syntactic_category:true
+  let of_ast = Extension_constructor.make_of_ast ~of_ast_internal
 end

ocaml/parsing/jane_syntax_parsing.ml

@@ -465,6 +465,16 @@ module type AST_syntactic_category = sig
 
   (** Set the location of an AST node. *)
   val with_location : ast -> Location.t -> ast
+
+  (** A boolean flag indicating whether the presence of a syntax feature that
+      doesn't extend the given syntactic category should be reported as an
+      error.
+
+      (For example: There are no pattern comprehensions, so when building the
+      extended pattern AST, an error will be raised if an embedding from
+      [Language_extension Comprehensions] is encountered when this flag is set.)
+   *)
+  val fail_if_wrong_syntactic_category : bool
 end
 
 module type AST_internal = sig
@@ -622,6 +632,8 @@ module Type_AST_syntactic_category = struct
   let location typ = typ.ptyp_loc
   let with_location typ l = { typ with ptyp_loc = l }
 
+  let fail_if_wrong_syntactic_category = true
+
   let attributes typ = typ.ptyp_attributes
   let with_attributes typ ptyp_attributes = { typ with ptyp_attributes }
 end
@@ -648,6 +660,8 @@ module Expression0 = Make_with_attribute (struct
   let location expr = expr.pexp_loc
   let with_location expr l = { expr with pexp_loc = l }
 
+  let fail_if_wrong_syntactic_category = true
+
   let attributes expr = expr.pexp_attributes
   let with_attributes expr pexp_attributes = { expr with pexp_attributes }
 end)
@@ -662,6 +676,8 @@ module Case0 = Make_with_extension_node (struct
     let pc_rhs = { case.pc_rhs with pexp_loc = l } in
     { case with pc_rhs  }
 
+  let fail_if_wrong_syntactic_category = false
+
   let make_extension_use extension ast =
     let ext = Ast_helper.Exp.extension extension in
     { ast with pc_rhs = Ast_helper.Exp.apply ext [ Nolabel, ast.pc_rhs ] }
@@ -681,6 +697,8 @@ module Pattern0 = Make_with_attribute (struct
   let location pat = pat.ppat_loc
   let with_location pat l = { pat with ppat_loc = l }
 
+  let fail_if_wrong_syntactic_category = true
+
   let attributes pat = pat.ppat_attributes
   let with_attributes pat ppat_attributes = { pat with ppat_attributes }
 end)
@@ -693,6 +711,8 @@ module Module_type0 = Make_with_attribute (struct
     let location mty = mty.pmty_loc
     let with_location mty l = { mty with pmty_loc = l }
 
+    let fail_if_wrong_syntactic_category = true
+
     let attributes mty = mty.pmty_attributes
     let with_attributes mty pmty_attributes = { mty with pmty_attributes }
 end)
@@ -705,6 +725,8 @@ module Extension_constructor0 = Make_with_attribute (struct
     let location ext = ext.pext_loc
     let with_location ext l = { ext with pext_loc = l }
 
+    let fail_if_wrong_syntactic_category = true
+
     let attributes ext = ext.pext_attributes
     let with_attributes ext pext_attributes = { ext with pext_attributes }
 end)
@@ -721,6 +743,8 @@ module Signature_item0 = Make_with_extension_node (struct
     let location sigi = sigi.psig_loc
     let with_location sigi l = { sigi with psig_loc = l }
 
+    let fail_if_wrong_syntactic_category = true
+
     let make_extension_use extension sigi =
       let extension_node = Ast_helper.Sig.extension extension in
       Ast_helper.Sig.include_
@@ -755,6 +779,8 @@ module Structure_item0 = Make_with_extension_node (struct
     let location stri = stri.pstr_loc
     let with_location stri l = { stri with pstr_loc = l }
 
+    let fail_if_wrong_syntactic_category = true
+
     let make_extension_use extension stri =
       let extension_node = Ast_helper.Str.extension extension in
       Ast_helper.Str.include_
@@ -787,9 +813,7 @@ module type AST = sig
   val make_entire_jane_syntax :
     loc:Location.t -> Feature.t -> (unit -> ast) -> ast
   val make_of_ast :
-    of_ast_internal:(Feature.t -> ast -> 'a option) ->
-    fail_if_wrong_syntactic_category:bool ->
-    (ast -> 'a option)
+    of_ast_internal:(Feature.t -> ast -> 'a option) -> ast -> 'a option
 end
 
 module Make_ast (AST : AST_internal) : AST with type ast = AST.ast = struct
@@ -807,7 +831,7 @@ module Make_ast (AST : AST_internal) : AST with type ast = AST.ast = struct
       loc
 
   (** Generically lift our custom ASTs for our novel syntax from OCaml ASTs. *)
-  let make_of_ast ~of_ast_internal ~fail_if_wrong_syntactic_category =
+  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

ocaml/parsing/jane_syntax_parsing.mli

@@ -187,15 +187,6 @@ module type AST = sig
         If the given syntax feature does not actually extend the given syntactic
         category, returns [None].
     *)
-    -> fail_if_wrong_syntactic_category:bool
-    (** A boolean flag indicating whether the presence of a syntax feature that
-        doesn't extend the given syntactic category should be reported as an
-        error.
-
-        (For example: There are no pattern comprehensions, so when building the
-        extended pattern AST, an error will be raised if an embedding from
-        [Language_extension Comprehensions] if this flag is set.)
-      *)
     -> (ast -> 'a option)
 end