diff --git a/src/dune_file.ml b/src/dune_file.ml index f48a29ce22b..7350d93d185 100644 --- a/src/dune_file.ml +++ b/src/dune_file.ml @@ -140,33 +140,13 @@ module Pkg = struct | Some name -> resolve p (Package.Name.of_string name)) end -module Pp : sig - type t = private Lib_name.t - val of_string : loc:Loc.t option -> string -> t - val to_string : t -> string - val compare : t -> t -> Ordering.t - val to_lib_name : t -> Lib_name.t -end = struct - type t = Lib_name.t - - let to_lib_name s = s - - let of_string ~loc s = - assert (not (String.is_prefix s ~prefix:"-")); - Lib_name.of_string_exn ~loc s - - let to_string = Lib_name.to_string - - let compare = Lib_name.compare -end - module Pps_and_flags = struct module Jbuild_syntax = struct let of_string ~loc s = if String.is_prefix s ~prefix:"-" then Right [s] else - Left (loc, Pp.of_string ~loc:(Some loc) s) + Left (loc, Lib_name.of_string_exn ~loc:(Some loc) s) let item = peek_exn >>= function @@ -196,7 +176,7 @@ module Pps_and_flags = struct if String.is_prefix s ~prefix:"-" then Right s else - Left (loc, Pp.of_string ~loc:(Some loc) s)) + Left (loc, Lib_name.of_string_exn ~loc:(Some loc) s)) in (pps, more_flags @ Option.value flags ~default:[]) end @@ -365,7 +345,7 @@ end module Preprocess = struct type pps = { loc : Loc.t - ; pps : (Loc.t * Pp.t) list + ; pps : (Loc.t * Lib_name.t) list ; flags : string list ; staged : bool } @@ -467,13 +447,11 @@ module Preprocess_map = struct let default = Per_module.for_all Preprocess.No_preprocessing - module Pp_map = Map.Make(Pp) - let pps t = - Per_module.fold t ~init:Pp_map.empty ~f:(fun pp acc -> + Per_module.fold t ~init:Lib_name.Map.empty ~f:(fun pp acc -> List.fold_left (Preprocess.pps pp) ~init:acc ~f:(fun acc (loc, pp) -> - Pp_map.add acc pp loc)) - |> Pp_map.foldi ~init:[] ~f:(fun pp loc acc -> (loc, pp) :: acc) + Lib_name.Map.add acc pp loc)) + |> Lib_name.Map.foldi ~init:[] ~f:(fun pp loc acc -> (loc, pp) :: acc) end module Lint = struct @@ -583,7 +561,7 @@ module Lib_dep = struct let direct x = Direct x - let of_pp (loc, pp) = Direct (loc, Pp.to_lib_name pp) + let of_lib_name (loc, pp) = Direct (loc, pp) end module Lib_deps = struct @@ -635,7 +613,7 @@ module Lib_deps = struct let decode = parens_removed_in_dune decode let of_pps pps = - List.map pps ~f:(fun pp -> Lib_dep.of_pp (Loc.none, pp)) + List.map pps ~f:(fun pp -> Lib_dep.of_lib_name (Loc.none, pp)) let info t ~kind = diff --git a/src/dune_file.mli b/src/dune_file.mli index cb01ba9d573..a0d4663dc30 100644 --- a/src/dune_file.mli +++ b/src/dune_file.mli @@ -3,20 +3,10 @@ open! Stdune open Import -(** Ppx preprocessors *) -module Pp : sig - type t = private Lib_name.t - val of_string : loc:Loc.t option -> string -> t - val to_string : t -> string - - val to_lib_name : t -> Lib_name.t - val compare : t -> t -> Ordering.t -end - module Preprocess : sig type pps = { loc : Loc.t - ; pps : (Loc.t * Pp.t) list + ; pps : (Loc.t * Lib_name.t) list ; flags : string list ; staged : bool } @@ -39,7 +29,7 @@ module Preprocess_map : sig given module *) val find : Module.Name.t -> t -> Preprocess.t - val pps : t -> (Loc.t * Pp.t) list + val pps : t -> (Loc.t * Lib_name.t) list end module Lint : sig @@ -77,12 +67,12 @@ module Lib_dep : sig val to_lib_names : t -> Lib_name.t list val direct : Loc.t * Lib_name.t -> t - val of_pp : Loc.t * Pp.t -> t + val of_lib_name : Loc.t * Lib_name.t -> t end module Lib_deps : sig type t = Lib_dep.t list - val of_pps : Pp.t list -> t + val of_pps : Lib_name.t list -> t val info : t -> kind:Lib_deps_info.Kind.t -> Lib_deps_info.t end diff --git a/src/lib.ml b/src/lib.ml index bb1245b285b..67eb17c6a7d 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -796,7 +796,6 @@ and resolve_user_deps db deps ~allow_private_deps ~pps ~stack = { (fst first) with stop = (fst last).stop } in let pps = - let pps = (pps : (Loc.t * Dune_file.Pp.t) list :> (Loc.t * Lib_name.t) list) in resolve_simple_deps db pps ~allow_private_deps:true ~stack >>= fun pps -> closure_with_overlap_checks None pps ~stack ~linking:true @@ -1042,9 +1041,7 @@ module DB = struct } let resolve_pps t pps = - resolve_simple_deps t ~allow_private_deps:true - (pps : (Loc.t * Dune_file.Pp.t) list :> (Loc.t * Lib_name.t) list) - ~stack:Dep_stack.empty + resolve_simple_deps t ~allow_private_deps:true pps ~stack:Dep_stack.empty let rec all ?(recursive=false) t = let l = diff --git a/src/lib.mli b/src/lib.mli index 4dd7b028f08..7da8e156c8f 100644 --- a/src/lib.mli +++ b/src/lib.mli @@ -276,12 +276,12 @@ module DB : sig : t -> ?allow_overlaps:bool -> Dune_file.Lib_dep.t list - -> pps:(Loc.t * Dune_file.Pp.t) list + -> pps:(Loc.t * Lib_name.t) list -> Compile.t val resolve_pps : t - -> (Loc.t * Dune_file.Pp.t) list + -> (Loc.t * Lib_name.t) list -> L.t Or_exn.t (** Return the list of all libraries in this database. If diff --git a/src/lib_info.ml b/src/lib_info.ml index b501f35df01..17f5de0f609 100644 --- a/src/lib_info.ml +++ b/src/lib_info.ml @@ -75,7 +75,7 @@ type t = ; jsoo_runtime : Path.t list ; requires : Deps.t ; ppx_runtime_deps : (Loc.t * Lib_name.t) list - ; pps : (Loc.t * Dune_file.Pp.t) list + ; pps : (Loc.t * Lib_name.t) list ; optional : bool ; virtual_deps : (Loc.t * Lib_name.t) list ; dune_version : Syntax.Version.t option diff --git a/src/lib_info.mli b/src/lib_info.mli index 540cb3e3c2c..1d1a8647ab2 100644 --- a/src/lib_info.mli +++ b/src/lib_info.mli @@ -55,7 +55,7 @@ type t = private ; jsoo_runtime : Path.t list ; requires : Deps.t ; ppx_runtime_deps : (Loc.t * Lib_name.t) list - ; pps : (Loc.t * Dune_file.Pp.t) list + ; pps : (Loc.t * Lib_name.t) list ; optional : bool ; virtual_deps : (Loc.t * Lib_name.t) list ; dune_version : Syntax.Version.t option diff --git a/src/merlin.ml b/src/merlin.ml index 8c1eb495abb..9aba3defc87 100644 --- a/src/merlin.ml +++ b/src/merlin.ml @@ -29,7 +29,7 @@ module Preprocess = struct | Gt | Lt as ne -> ne | Eq -> List.compare pps1 pps2 ~compare:(fun (_, a) (_, b) -> - Dune_file.Pp.compare a b) + Lib_name.compare a b) with | Eq -> a | _ -> Other diff --git a/src/preprocessing.ml b/src/preprocessing.ml index 783efb94fe5..8b1bd6cb42c 100644 --- a/src/preprocessing.ml +++ b/src/preprocessing.ml @@ -117,8 +117,8 @@ module Driver = struct (* Where are we called from? *) type loc = - | User_file of Loc.t * (Loc.t * Pp.t) list - | Dot_ppx of Path.t * Pp.t list + | User_file of Loc.t * (Loc.t * Lib_name.t) list + | Dot_ppx of Path.t * Lib_name.t list let make_error loc msg = match loc with @@ -127,7 +127,7 @@ module Driver = struct Error (Errors.exnf (Loc.in_file (Path.to_string path)) "%a" Fmt.text (sprintf "Failed to create on-demand ppx rewriter for %s; %s" - (String.enumerate_and (List.map pps ~f:Pp.to_string)) + (String.enumerate_and (List.map pps ~f:Lib_name.to_string)) (String.uncapitalize msg))) let select libs ~loc = @@ -157,7 +157,7 @@ module Driver = struct compatible with Dune. Examples of ppx rewriters that \ are compatible with Dune are ones using \ ocaml-migrate-parsetree, ppxlib or ppx_driver." - (String.enumerate_and (List.map pps ~f:Pp.to_string)) + (String.enumerate_and (List.map pps ~f:Lib_name.to_string)) (match pps with | [_] -> "is" | _ -> "are") @@ -190,7 +190,7 @@ module Jbuild_driver = struct information. If it is, use the corresponding hardcoded driver information. *) - let make name info : (Pp.t * Driver.t) Lazy.t = lazy ( + let make name info : (Lib_name.t * Driver.t) Lazy.t = lazy ( let info = let parsing_context = Univ_map.singleton (Syntax.key Stanza.syntax) (0, 0) @@ -200,7 +200,7 @@ module Jbuild_driver = struct ~lexer:Dune_lang.Lexer.jbuild_token |> Dune_lang.Decoder.parse Driver.Info.parse parsing_context in - (Pp.of_string ~loc:None name, + (Lib_name.of_string_exn ~loc:None name, { info ; lib = lazy (assert false) ; replaces = Ok [] @@ -222,9 +222,9 @@ module Jbuild_driver = struct |} let drivers = - [ Pp.of_string ~loc:None "ocaml-migrate-parsetree.driver-main" , omp - ; Pp.of_string ~loc:None "ppxlib.runner" , ppxlib - ; Pp.of_string ~loc:None "ppx_driver.runner" , ppx_driver + [ Lib_name.of_string_exn ~loc:None "ocaml-migrate-parsetree.driver-main" , omp + ; Lib_name.of_string_exn ~loc:None "ppxlib.runner" , ppxlib + ; Lib_name.of_string_exn ~loc:None "ppx_driver.runner" , ppx_driver ] let get_driver pps = @@ -272,8 +272,7 @@ let build_ppx_driver sctx ~lib_db ~dep_kind ~target ~dir_kind pps = Result.map_error ~f:(fun e -> (* Extend the dependency stack as we don't have locations at this point *) - Dep_path.prepend_exn e - (Preprocess (pps : Dune_file.Pp.t list :> Lib_name.t list))) + Dep_path.prepend_exn e (Preprocess pps)) (Lib.DB.resolve_pps lib_db (List.map pps ~f:(fun x -> (Loc.none, x))) >>= Lib.closure ~linking:true @@ -324,7 +323,7 @@ let get_rules sctx key ~dir_kind = | [] -> [] | driver :: rest -> List.sort rest ~compare:String.compare @ [driver] in - let pps = List.map names ~f:(Dune_file.Pp.of_string ~loc:None) in + let pps = List.map names ~f:(Lib_name.of_string_exn ~loc:None) in build_ppx_driver sctx pps ~lib_db ~dep_kind:Required ~target:exe ~dir_kind let gen_rules sctx components = diff --git a/src/preprocessing.mli b/src/preprocessing.mli index 28b891b7502..0bb7d4f53d0 100644 --- a/src/preprocessing.mli +++ b/src/preprocessing.mli @@ -42,7 +42,7 @@ val get_ppx_driver : Super_context.t -> scope:Scope.t -> dir_kind:File_tree.Dune_file.Kind.t - -> (Loc.t * Dune_file.Pp.t) list + -> (Loc.t * Lib_name.t) list -> Path.t Or_exn.t module Compat_ppx_exe_kind : sig diff --git a/src/stdune/exn.mli b/src/stdune/exn.mli index d7e3e2ab093..3cbe225b19a 100644 --- a/src/stdune/exn.mli +++ b/src/stdune/exn.mli @@ -9,7 +9,7 @@ exception Code_error of Sexp.t - Rename to [User_error] - change the [string] argument to [Loc.t option * string] and get rid of [Loc.Error]. The two are a bit confusing - - change [string] to [Colors.Style.t Pp.t] + - change [string] to [Colors.Style.t Lib_name.t] *) (** A fatal error, that should be reported to the user in a nice way *) exception Fatal_error of string