refactor: move Ordered_set_lang to Dune_lang (#7772)

Signed-off-by: Rudi Grinberg <[email protected]>

src/dune_lang/dune_lang.ml

@@ -12,3 +12,4 @@ module Blang = Blang
 module Binary_kind = Binary_kind
 module Package_name = Package_name
 module Pkg = Pkg
+module Ordered_set_lang = Ordered_set_lang

src/dune_rules/ordered_set_lang.ml → src/dune_lang/ordered_set_lang.ml

@@ -1,4 +1,6 @@
-open Import
+open Stdune
+open Dune_sexp
+include Ordered_set_lang_intf
 
 module Ast = struct
   [@@@warning "-37"]
@@ -31,7 +33,7 @@ end
 type 'ast generic =
   { ast : 'ast
   ; loc : Loc.t option
-  ; context : Univ_map.t (* Parsing context for Dune_lang.Decoder.parse *)
+  ; context : Univ_map.t (* Parsing context for Decoder.parse *)
   }
 
 let equal_generic f { ast; loc = _; context } t =
@@ -52,11 +54,11 @@ let equal = equal_generic (Ast.equal (fun (_, x) (_, y) -> String.equal x y))
 let loc t = t.loc
 
 module Parse = struct
-  open Dune_lang.Decoder
+  open Decoder
   open Ast
 
   let generic ~inc ~elt =
-    let open Dune_lang.Decoder in
+    let open Decoder in
     let rec one () =
       peek_exn >>= function
       | Atom (loc, A "\\") -> User_error.raise ~loc [ Pp.text "unexpected \\" ]
@@ -110,7 +112,7 @@ module Parse = struct
 end
 
 let decode =
-  let open Dune_lang.Decoder in
+  let open Decoder in
   let+ context = get_all
   and+ loc, ast =
     located
@@ -168,7 +170,7 @@ end
 
 let eval t ~parse ~eq ~standard = Eval.ordered eq t ~parse ~standard
 
-module Unordered (Key : Ordered_set_lang_intf.Key) = struct
+module Unordered (Key : Key) = struct
   type nonrec t = t
 
   module Key = Key
@@ -209,9 +211,9 @@ let field ?check name =
   let decode =
     match check with
     | None -> decode
-    | Some x -> Dune_lang.Decoder.( >>> ) x decode
+    | Some x -> Decoder.( >>> ) x decode
   in
-  Dune_lang.Decoder.field name decode ~default:standard
+  Decoder.field name decode ~default:standard
 
 module Unexpanded = struct
   type ast = (String_with_vars.t, Ast.unexpanded) Ast.t
@@ -220,8 +222,8 @@ module Unexpanded = struct
 
   let equal x y = equal_generic (Ast.equal String_with_vars.equal_no_loc) x y
 
-  let decode : t Dune_lang.Decoder.t =
-    let open Dune_lang.Decoder in
+  let decode : t Decoder.t =
+    let open Decoder in
     let+ context = get_all
     and+ loc, ast =
       located
@@ -232,17 +234,17 @@ module Unexpanded = struct
 
   let encode t =
     let open Ast in
+    let open Dune_sexp in
     let rec loop = function
       | Element s -> String_with_vars.encode s
-      | Standard -> Dune_lang.atom ":standard"
+      | Standard -> atom ":standard"
       | Union l -> List (List.map l ~f:loop)
-      | Diff (a, b) -> List [ loop a; Dune_lang.atom "\\"; loop b ]
-      | Include fn ->
-        List [ Dune_lang.atom ":include"; String_with_vars.encode fn ]
+      | Diff (a, b) -> List [ loop a; atom "\\"; loop b ]
+      | Include fn -> List [ atom ":include"; String_with_vars.encode fn ]
     in
     match t.ast with
     | Union l -> List.map l ~f:loop
-    | Diff (a, b) -> [ loop a; Dune_lang.atom "\\"; loop b ]
+    | Diff (a, b) -> [ loop a; atom "\\"; loop b ]
     | ast -> [ loop ast ]
 
   let standard = standard
@@ -266,9 +268,9 @@ module Unexpanded = struct
     let decode =
       match check with
       | None -> decode
-      | Some x -> Dune_lang.Decoder.( >>> ) x decode
+      | Some x -> Decoder.( >>> ) x decode
     in
-    Dune_lang.Decoder.field name decode ~default:standard
+    Decoder.field name decode ~default:standard
 
   let has_special_forms t =
     let rec loop (t : ast) =
@@ -314,46 +316,47 @@ module Unexpanded = struct
     in
     loop t.ast Pos init
 
-  let expand t ~dir
-      ~(f : Value.t list Action_builder.t String_with_vars.expander) =
-    let open Action_builder.O in
-    let context = t.context in
-    let expand_template ~mode sw =
-      Action_builder_expander.expand sw ~mode ~dir ~f
-    in
-    let f_elems s =
-      let loc = String_with_vars.loc s in
-      let+ l = expand_template s ~mode:Many in
-      Ast.union
-        (List.map l ~f:(fun s -> Ast.Element (loc, Value.to_string ~dir s)))
-    in
-    let rec expand ~allow_include (t : ast) : ast_expanded Action_builder.t =
-      let open Ast in
-      match t with
-      | Element s -> f_elems s
-      | Standard -> Action_builder.return Standard
-      | Include fn ->
-        let loc = String_with_vars.loc fn in
-        if not allow_include then
-          User_error.raise ~loc [ Pp.text "(:include ...) is not allowed here" ]
-        else
-          let* sexp =
-            let* path = expand_template fn ~mode:Single in
-            let path = Value.to_path path ?error_loc:(Some loc) ~dir in
-            Action_builder.read_sexp path
-          in
-          let t = Dune_lang.Decoder.parse decode context sexp in
-          expand t.ast ~allow_include:false
-      | Union l ->
-        let+ l = Action_builder.all (List.map l ~f:(expand ~allow_include)) in
-        Union l
-      | Diff (l, r) ->
-        let+ l = expand l ~allow_include
-        and+ r = expand r ~allow_include in
-        Diff (l, r)
-    in
-    let+ ast = expand t.ast ~allow_include:true in
-    { t with ast }
+  module Expand (Action_builder : Action_builder) = struct
+    let expand (t : t) ~dir
+        ~(f : Value.t list Action_builder.t String_with_vars.expander) =
+      let open Action_builder.O in
+      let context = t.context in
+      let expand_template ~mode sw = Action_builder.expand sw ~mode ~dir ~f in
+      let f_elems s =
+        let loc = String_with_vars.loc s in
+        let+ l = expand_template s ~mode:Many in
+        Ast.union
+          (List.map l ~f:(fun s -> Ast.Element (loc, Value.to_string ~dir s)))
+      in
+      let rec expand ~allow_include (t : ast) : ast_expanded Action_builder.t =
+        let open Ast in
+        match t with
+        | Element s -> f_elems s
+        | Standard -> Action_builder.return Standard
+        | Include fn ->
+          let loc = String_with_vars.loc fn in
+          if not allow_include then
+            User_error.raise ~loc
+              [ Pp.text "(:include ...) is not allowed here" ]
+          else
+            let* sexp =
+              let* path = expand_template fn ~mode:Single in
+              let path = Value.to_path path ?error_loc:(Some loc) ~dir in
+              Action_builder.read_sexp path
+            in
+            let t = Decoder.parse decode context sexp in
+            expand t.ast ~allow_include:false
+        | Union l ->
+          let+ l = Action_builder.all (List.map l ~f:(expand ~allow_include)) in
+          Union l
+        | Diff (l, r) ->
+          let+ l = expand l ~allow_include
+          and+ r = expand r ~allow_include in
+          Diff (l, r)
+      in
+      let+ ast = expand t.ast ~allow_include:true in
+      { t with ast }
+  end
 end
 
 module Unordered_string = Unordered (String)

src/dune_rules/ordered_set_lang.mli → src/dune_lang/ordered_set_lang.mli

@@ -1,13 +1,16 @@
 (** [Ordered_set_lang.t] is a sexp-based representation for an ordered list of
     strings, with some set like operations. *)
 
-open Import
+open Stdune
+open Dune_sexp
 
 type t
 
+include module type of Ordered_set_lang_intf
+
 val of_atoms : loc:Loc.t -> string list -> t
 
-val decode : t Dune_lang.Decoder.t
+val decode : t Decoder.t
 
 (** Return the location of the set. [loc standard] returns [None] *)
 val loc : t -> Loc.t option
@@ -19,7 +22,7 @@ val eval :
   -> standard:'a list
   -> 'a list
 
-module Unordered (Key : Ordered_set_lang_intf.Key) :
+module Unordered (Key : Key) :
   Ordered_set_lang_intf.Unordered_eval with type t = t and module Key := Key
 
 val eval_loc :
@@ -36,8 +39,7 @@ val replace_standard_with_empty : t -> t
 
 val is_standard : t -> bool
 
-val field :
-  ?check:unit Dune_lang.Decoder.t -> string -> t Dune_lang.Decoder.fields_parser
+val field : ?check:unit Decoder.t -> string -> t Decoder.fields_parser
 
 val equal : t -> t -> bool
 
@@ -48,9 +50,9 @@ module Unexpanded : sig
 
   val equal : t -> t -> bool
 
-  include Dune_lang.Conv.S with type t := t
+  include Dune_sexp.Conv.S with type t := t
 
-  val encode : t -> Dune_lang.t list
+  val encode : t -> Dune_sexp.t list
 
   val standard : t
 
@@ -59,25 +61,12 @@ module Unexpanded : sig
   val include_single :
     context:Univ_map.t -> pos:string * int * int * int -> string -> t
 
-  val field :
-       ?check:unit Dune_lang.Decoder.t
-    -> string
-    -> t Dune_lang.Decoder.fields_parser
+  val field : ?check:unit Decoder.t -> string -> t Decoder.fields_parser
 
   val has_special_forms : t -> bool
 
   val has_standard : t -> bool
 
-  (** Expand [t] using with the given file contents. [file_contents] is a map
-      from filenames to their parsed contents. Every [(:include fn)] in [t] is
-      replaced by [Map.find files_contents fn]. Every element is converted to a
-      string using [f]. *)
-  val expand :
-       t
-    -> dir:Path.t
-    -> f:Value.t list Action_builder.t String_with_vars.expander
-    -> expanded Action_builder.t
-
   type position =
     | Pos
     | Neg
@@ -87,6 +76,18 @@ module Unexpanded : sig
       of a \ operator. *)
   val fold_strings :
     t -> init:'a -> f:(position -> String_with_vars.t -> 'a -> 'a) -> 'a
+
+  module Expand (Action_builder : Action_builder) : sig
+    (** Expand [t] using with the given file contents. [file_contents] is a map
+        from filenames to their parsed contents. Every [(:include fn)] in [t] is
+        replaced by [Map.find files_contents fn]. Every element is converted to
+        a string using [f]. *)
+    val expand :
+         t
+      -> dir:Path.t
+      -> f:Value.t list Action_builder.t String_with_vars.expander
+      -> expanded Action_builder.t
+  end
 end
 
 module Unordered_string :

src/dune_rules/ordered_set_lang_intf.ml → src/dune_lang/ordered_set_lang_intf.ml

@@ -1,4 +1,4 @@
-open Import
+open Stdune
 
 module type Key = sig
   type t
@@ -42,3 +42,28 @@ module type Unordered_eval = sig
     -> standard:(Loc.t * 'a) Key.Map.t
     -> (Loc.t * 'a) Key.Map.t
 end
+
+module type Action_builder = sig
+  type 'a t
+
+  val return : 'a -> 'a t
+
+  val all : 'a t list -> 'a list t
+
+  val read_sexp : Path.t -> Dune_sexp.Ast.t t
+
+  module O : sig
+    val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
+
+    val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
+
+    val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
+  end
+
+  val expand :
+       String_with_vars.t
+    -> mode:'a String_with_vars.Mode.t
+    -> dir:Path.t
+    -> f:Value.t list t String_with_vars.expander
+    -> 'a t
+end

src/dune_rules/expander.ml

@@ -822,12 +822,19 @@ module With_reduced_var_set = struct
       ~dir:(Path.build dir) blang
 end
 
+let expand_ordered_set_lang =
+  let module Expander = Ordered_set_lang.Unexpanded.Expand (struct
+    include Action_builder
+    include Action_builder_expander
+  end) in
+  Expander.expand
+
 let expand_and_eval_set t set ~standard =
   let dir = Path.build (dir t) in
   let+ standard =
     if Ordered_set_lang.Unexpanded.has_special_forms set then standard
     else Action_builder.return []
-  and+ set = Ordered_set_lang.Unexpanded.expand set ~dir ~f:(expand_pform t) in
+  and+ set = expand_ordered_set_lang set ~dir ~f:(expand_pform t) in
   Ordered_set_lang.eval set ~standard ~eq:String.equal ~parse:(fun ~loc:_ s ->
       s)
 

src/dune_rules/import.ml

@@ -41,6 +41,7 @@ end
 
 include Ocaml
 module Re = Dune_re
+module Ordered_set_lang = Dune_lang.Ordered_set_lang
 module Stanza = Dune_lang.Stanza
 module Predicate_lang = Dune_lang.Predicate_lang
 module Predicate_with_id = Dune_engine.File_selector.Predicate_with_id