Merge pull request #1340 from rgrinberg/remove-pp

Remove Pp module

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 =

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
 

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 =

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

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

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

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

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 =

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

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