Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Remove Pp module #1340

Merged
merged 1 commit into from
Sep 27, 2018
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
38 changes: 8 additions & 30 deletions src/dune_file.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
}
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand Down
18 changes: 4 additions & 14 deletions src/dune_file.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
}
Expand All @@ -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
Expand Down Expand Up @@ -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

Expand Down
5 changes: 1 addition & 4 deletions src/lib.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand Down
4 changes: 2 additions & 2 deletions src/lib.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion src/lib_info.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion src/lib_info.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion src/merlin.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
23 changes: 11 additions & 12 deletions src/preprocessing.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 =
Expand Down Expand Up @@ -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")
Expand Down Expand Up @@ -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)
Expand All @@ -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 []
Expand All @@ -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 =
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand Down
2 changes: 1 addition & 1 deletion src/preprocessing.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion src/stdune/exn.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down