Merge pull request #3782 from rgrinberg/factor-engine-include

Split Stanza_common from include stanza

src/dune_engine/include_stanza.ml

@@ -0,0 +1,52 @@
+open Import
+
+type context =
+  { current_file : Path.Source.t
+  ; include_stack : (Loc.t * Path.Source.t) list
+  }
+
+let in_file file = { current_file = file; include_stack = [] }
+
+let error { current_file = file; include_stack } =
+  let last, rest =
+    match include_stack with
+    | [] -> assert false
+    | last :: rest -> (last, rest)
+  in
+  let loc = fst (Option.value (List.last rest) ~default:last) in
+  let line_loc (loc, file) =
+    sprintf "%s:%d"
+      (Path.Source.to_string_maybe_quoted file)
+      loc.Loc.start.pos_lnum
+  in
+  User_error.raise ~loc
+    [ Pp.text "Recursive inclusion of dune files detected:"
+    ; Pp.textf "File %s is included from %s"
+        (Path.Source.to_string_maybe_quoted file)
+        (line_loc last)
+    ; Pp.vbox
+        (Pp.concat_map rest ~sep:Pp.cut ~f:(fun x ->
+             Pp.box ~indent:3
+               (Pp.seq (Pp.verbatim "-> ")
+                  (Pp.textf "included from %s" (line_loc x)))))
+    ]
+
+let load_sexps ~context:{ current_file; include_stack } (loc, fn) =
+  let include_stack = (loc, current_file) :: include_stack in
+  let dir = Path.Source.parent_exn current_file in
+  let current_file = Path.Source.relative dir fn in
+  if not (Path.exists (Path.source current_file)) then
+    User_error.raise ~loc
+      [ Pp.textf "File %s doesn't exist."
+          (Path.Source.to_string_maybe_quoted current_file)
+      ];
+  if
+    List.exists include_stack ~f:(fun (_, f) ->
+        Path.Source.equal f current_file)
+  then
+    error { current_file; include_stack };
+  let sexps =
+    Dune_lang.Parser.load ~lexer:Dune_lang.Lexer.token
+      (Path.source current_file) ~mode:Many
+  in
+  (sexps, { current_file; include_stack })

src/dune_engine/include_stanza.mli

@@ -0,0 +1,8 @@
+open Import
+
+type context
+
+val in_file : Path.Source.t -> context
+
+val load_sexps :
+  context:context -> Loc.t * string -> Dune_lang.Ast.t list * context

src/dune_engine/sub_dirs.ml

@@ -331,9 +331,7 @@ let decode_includes ~context =
              ~f:(fun fn dir -> Filename.concat dir fn)
              ~init:fn path
          in
-         let sexps, context =
-           Stanza_common.Include.load_sexps ~context (loc, fn)
-         in
+         let sexps, context = Include_stanza.load_sexps ~context (loc, fn) in
          let* () = set_input sexps in
          fields (decode ~context ~path ~inside_include:true))
     in
@@ -345,6 +343,6 @@ let decode_includes ~context =
 
 let decode ~file =
   let open Dune_lang.Decoder in
-  let* sexps = decode_includes ~context:(Stanza_common.Include.in_file file) in
+  let* sexps = decode_includes ~context:(Include_stanza.in_file file) in
   let* () = set_input [ List (Loc.none, sexps) ] in
   decode

src/dune_rules/coq_stanza.ml

@@ -1,7 +1,6 @@
 open! Dune_engine
 open Import
 open Dune_lang.Decoder
-open Stanza_common
 
 module Coqpp = struct
   type t =
@@ -99,7 +98,8 @@ module Theory = struct
             | None -> Package.Name.of_string name
             | Some (pkg, _) -> Package.Name.of_string pkg
           in
-          Pkg.resolve project pkg |> Result.map ~f:(fun pkg -> Some (loc, pkg)))
+          Stanza_common.Pkg.resolve project pkg
+          |> Result.map ~f:(fun pkg -> Some (loc, pkg)))
 
   let select_deprecation ~package ~public =
     match (package, public) with
@@ -122,13 +122,13 @@ module Theory = struct
   let decode =
     fields
       (let+ name = field "name" Coq_lib_name.decode
-       and+ package = field_o "package" Pkg.decode
+       and+ package = field_o "package" Stanza_common.Pkg.decode
        and+ project = Dune_project.get_exn ()
        and+ public = coq_public_decode
        and+ synopsis = field_o "synopsis" string
        and+ boot =
          field_b "boot" ~check:(Dune_lang.Syntax.since coq_syntax (0, 2))
-       and+ modules = modules_field "modules"
+       and+ modules = Stanza_common.modules_field "modules"
        and+ enabled_if = Enabled_if.decode ~allowed_vars:Any ~since:None ()
        and+ buildable = Buildable.decode in
        let package = select_deprecation ~package ~public in

src/dune_rules/dune_file.ml

@@ -2,7 +2,6 @@ open! Dune_engine
 open! Stdune
 open Import
 open Dune_lang.Decoder
-open Stanza_common
 
 (* This file defines Dune types as well as the S-expression syntax for the
    various supported versions of the specification. *)
@@ -210,7 +209,7 @@ module Buildable = struct
       located
         (only_in_library
            (field_o "cxx_names" (use_foreign >>> Ordered_set_lang.decode)))
-    and+ modules = modules_field "modules"
+    and+ modules = Stanza_common.modules_field "modules"
     and+ self_build_stubs_archive_loc, self_build_stubs_archive =
       located
         (only_in_library
@@ -219,7 +218,7 @@ module Buildable = struct
                   ~extra_info:"Use the (foreign_archives ...) field instead."
               >>> enter (maybe string) )))
     and+ modules_without_implementation =
-      modules_field "modules_without_implementation"
+      Stanza_common.modules_field "modules_without_implementation"
     and+ libraries =
       field "libraries" (Lib_deps.decode ~allow_re_export) ~default:[]
     and+ flags = Ocaml_flags.Spec.decode
@@ -327,7 +326,7 @@ module Public_lib = struct
     match x with
     | Some x -> Ok x
     | None ->
-      Pkg.resolve project pkg
+      Stanza_common.Pkg.resolve project pkg
       |> Result.map ~f:(fun pkg ->
              { package = pkg
              ; sub_dir =
@@ -837,7 +836,7 @@ module Plugin = struct
        and+ libraries = field "libraries" (repeat (located Lib_name.decode))
        and+ site =
          field "site" (located (pair Package.Name.decode Section.Site.decode))
-       and+ package = Pkg.field "package"
+       and+ package = Stanza_common.Pkg.field "package"
        and+ optional = field_b "optional" in
        { name; libraries; site; package; optional })
 end
@@ -854,7 +853,7 @@ module Install_conf = struct
     fields
       (let+ section = field "section" Install.Section_with_site.decode
        and+ files = field "files" File_binding.Unexpanded.L.decode
-       and+ package = Pkg.field "install"
+       and+ package = Stanza_common.Pkg.field "install"
        and+ enabled_if =
          let allowed_vars = Enabled_if.common_vars ~since:(2, 6) in
          Enabled_if.decode ~allowed_vars ~since:(Some (2, 6)) ()
@@ -979,7 +978,7 @@ module Executables = struct
       and+ package =
         field_o "package"
           (let+ loc = loc
-           and+ pkg = Pkg.decode in
+           and+ pkg = Stanza_common.Pkg.decode in
            (loc, pkg))
       and+ project = Dune_project.get_exn () in
       let names, public_names = names in
@@ -1045,7 +1044,8 @@ module Executables = struct
             Some
               { public_names
               ; package =
-                  Pkg.default_exn ~loc project (pluralize "executable" ~multi)
+                  Stanza_common.Pkg.default_exn ~loc project
+                    (pluralize "executable" ~multi)
               }
         | Some (loc, _), None ->
           User_error.raise ~loc
@@ -1498,7 +1498,8 @@ module Rule = struct
       Enabled_if.decode ~allowed_vars:Any ~since:(Some (1, 4)) ()
     and+ package =
       field_o "package"
-        (Dune_lang.Syntax.since Stanza.syntax (2, 0) >>> Pkg.decode)
+        ( Dune_lang.Syntax.since Stanza.syntax (2, 0)
+        >>> Stanza_common.Pkg.decode )
     and+ alias =
       field_o "alias"
         (Dune_lang.Syntax.since Stanza.syntax (2, 0) >>> Alias.Name.decode)
@@ -1650,7 +1651,7 @@ module Alias_conf = struct
   let decode =
     fields
       (let+ name = field "name" Alias.Name.decode
-       and+ package = field_o "package" Pkg.decode
+       and+ package = field_o "package" Stanza_common.Pkg.decode
        and+ action =
          field_o "action"
            (let extra_info = "Use a rule stanza with the alias field instead" in
@@ -1682,7 +1683,7 @@ module Tests = struct
          Buildable.decode ~in_library:false ~allow_re_export:false
        and+ link_flags = Ordered_set_lang.Unexpanded.field "link_flags"
        and+ names = names
-       and+ package = field_o "package" Pkg.decode
+       and+ package = field_o "package" Stanza_common.Pkg.decode
        and+ locks = field "locks" (repeat String_with_vars.decode) ~default:[]
        and+ modes =
          field "modes" Executables.Link_mode.Map.decode
@@ -1802,7 +1803,7 @@ module Documentation = struct
 
   let decode =
     fields
-      (let+ package = Pkg.field "documentation"
+      (let+ package = Stanza_common.Pkg.field "documentation"
        and+ mld_files = Ordered_set_lang.field "mld_files"
        and+ loc = loc in
        { loc; package; mld_files })
@@ -2061,14 +2062,14 @@ module Stanzas = struct
     List.concat_map sexps ~f:(parse stanza_parser)
     |> List.concat_map ~f:(function
          | Include (loc, fn) ->
-           let sexps, context = Include.load_sexps ~context (loc, fn) in
+           let sexps, context = Include_stanza.load_sexps ~context (loc, fn) in
            parse_file_includes ~stanza_parser ~context sexps
          | stanza -> [ stanza ])
 
   let parse ~file (project : Dune_project.t) sexps =
     let stanza_parser = parser project in
     let stanzas =
-      let context = Include.in_file file in
+      let context = Include_stanza.in_file file in
       parse_file_includes ~stanza_parser ~context sexps
     in
     let (_ : bool) =

src/dune_engine/stanza_common.ml → src/dune_rules/stanza_common.ml

@@ -1,4 +1,5 @@
-open Import
+open Stdune
+open Dune_engine
 open Dune_lang.Decoder
 
 (* Parse and resolve "package" fields *)
@@ -99,56 +100,3 @@ module Pkg = struct
 end
 
 let modules_field name = Ordered_set_lang.field name
-
-module Include = struct
-  type context =
-    { current_file : Path.Source.t
-    ; include_stack : (Loc.t * Path.Source.t) list
-    }
-
-  let in_file file = { current_file = file; include_stack = [] }
-
-  let error { current_file = file; include_stack } =
-    let last, rest =
-      match include_stack with
-      | [] -> assert false
-      | last :: rest -> (last, rest)
-    in
-    let loc = fst (Option.value (List.last rest) ~default:last) in
-    let line_loc (loc, file) =
-      sprintf "%s:%d"
-        (Path.Source.to_string_maybe_quoted file)
-        loc.Loc.start.pos_lnum
-    in
-    User_error.raise ~loc
-      [ Pp.text "Recursive inclusion of dune files detected:"
-      ; Pp.textf "File %s is included from %s"
-          (Path.Source.to_string_maybe_quoted file)
-          (line_loc last)
-      ; Pp.vbox
-          (Pp.concat_map rest ~sep:Pp.cut ~f:(fun x ->
-               Pp.box ~indent:3
-                 (Pp.seq (Pp.verbatim "-> ")
-                    (Pp.textf "included from %s" (line_loc x)))))
-      ]
-
-  let load_sexps ~context:{ current_file; include_stack } (loc, fn) =
-    let include_stack = (loc, current_file) :: include_stack in
-    let dir = Path.Source.parent_exn current_file in
-    let current_file = Path.Source.relative dir fn in
-    if not (Path.exists (Path.source current_file)) then
-      User_error.raise ~loc
-        [ Pp.textf "File %s doesn't exist."
-            (Path.Source.to_string_maybe_quoted current_file)
-        ];
-    if
-      List.exists include_stack ~f:(fun (_, f) ->
-          Path.Source.equal f current_file)
-    then
-      error { current_file; include_stack };
-    let sexps =
-      Dune_lang.Parser.load ~lexer:Dune_lang.Lexer.token
-        (Path.source current_file) ~mode:Many
-    in
-    (sexps, { current_file; include_stack })
-end

src/dune_engine/stanza_common.mli → src/dune_rules/stanza_common.mli

@@ -1,4 +1,5 @@
-open Import
+open Stdune
+open Dune_engine
 
 module Pkg : sig
   val decode : Package.t Dune_lang.Decoder.t
@@ -12,12 +13,3 @@ module Pkg : sig
 end
 
 val modules_field : string -> Ordered_set_lang.t Dune_lang.Decoder.fields_parser
-
-module Include : sig
-  type context
-
-  val in_file : Path.Source.t -> context
-
-  val load_sexps :
-    context:context -> Loc.t * string -> Dune_lang.Ast.t list * context
-end