Remove the *0 modules
Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
parent
c4cc9ed54c
commit
a5313be3ac
|
@ -110,9 +110,9 @@ let sexp_of_t t =
|
||||||
bool (Dynlink_supported.By_the_os.get t.natdynlink_supported)
|
bool (Dynlink_supported.By_the_os.get t.natdynlink_supported)
|
||||||
; "supports_shared_libraries",
|
; "supports_shared_libraries",
|
||||||
bool (Dynlink_supported.By_the_os.get t.supports_shared_libraries)
|
bool (Dynlink_supported.By_the_os.get t.supports_shared_libraries)
|
||||||
; "opam_vars", string_hashtbl string t.opam_var_cache
|
; "opam_vars", Hashtbl.sexp_of_t string string t.opam_var_cache
|
||||||
; "ocaml_config", Ocaml_config.sexp_of_t t.ocaml_config
|
; "ocaml_config", Ocaml_config.sexp_of_t t.ocaml_config
|
||||||
; "which", string_hashtbl (option path) t.which_cache
|
; "which", Hashtbl.sexp_of_t string (option path) t.which_cache
|
||||||
]
|
]
|
||||||
|
|
||||||
let compare a b = compare a.name b.name
|
let compare a b = compare a.name b.name
|
||||||
|
|
|
@ -5,7 +5,17 @@ module Template = Template
|
||||||
|
|
||||||
type syntax = Atom.syntax = Jbuild | Dune
|
type syntax = Atom.syntax = Jbuild | Dune
|
||||||
|
|
||||||
include Dsexp0
|
type t =
|
||||||
|
| Atom of Atom.t
|
||||||
|
| Quoted_string of string
|
||||||
|
| List of t list
|
||||||
|
| Template of Template.t
|
||||||
|
|
||||||
|
let atom_or_quoted_string s =
|
||||||
|
if Atom.is_valid_dune s then
|
||||||
|
Atom (Atom.of_string s)
|
||||||
|
else
|
||||||
|
Quoted_string s
|
||||||
|
|
||||||
let atom s = Atom (Atom.of_string s)
|
let atom s = Atom (Atom.of_string s)
|
||||||
|
|
||||||
|
@ -128,6 +138,7 @@ let prepare_formatter ppf =
|
||||||
}
|
}
|
||||||
|
|
||||||
module Ast = struct
|
module Ast = struct
|
||||||
|
type dsexp = t
|
||||||
type t =
|
type t =
|
||||||
| Atom of Loc.t * Atom.t
|
| Atom of Loc.t * Atom.t
|
||||||
| Quoted_string of Loc.t * string
|
| Quoted_string of Loc.t * string
|
||||||
|
@ -144,7 +155,7 @@ module Ast = struct
|
||||||
let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _)
|
let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _)
|
||||||
| Template { loc ; _ }) = loc
|
| Template { loc ; _ }) = loc
|
||||||
|
|
||||||
let rec remove_locs t : Dsexp0.t =
|
let rec remove_locs t : dsexp =
|
||||||
match t with
|
match t with
|
||||||
| Template t -> Template (Template.remove_locs t)
|
| Template t -> Template (Template.remove_locs t)
|
||||||
| Atom (_, s) -> Atom s
|
| Atom (_, s) -> Atom s
|
||||||
|
@ -259,7 +270,6 @@ module To_sexp = struct
|
||||||
type nonrec 'a t = 'a -> t
|
type nonrec 'a t = 'a -> t
|
||||||
let unit () = List []
|
let unit () = List []
|
||||||
let string = atom_or_quoted_string
|
let string = atom_or_quoted_string
|
||||||
let atom = string
|
|
||||||
let int n = Atom (Atom.of_int n)
|
let int n = Atom (Atom.of_int n)
|
||||||
let float f = Atom (Atom.of_float f)
|
let float f = Atom (Atom.of_float f)
|
||||||
let bool b = Atom (Atom.of_bool b)
|
let bool b = Atom (Atom.of_bool b)
|
||||||
|
@ -270,14 +280,8 @@ module To_sexp = struct
|
||||||
let option f = function
|
let option f = function
|
||||||
| None -> List []
|
| None -> List []
|
||||||
| Some x -> List [f x]
|
| Some x -> List [f x]
|
||||||
let string_set set = list atom (String.Set.to_list set)
|
|
||||||
let string_map f map = list (pair atom f) (String.Map.to_list map)
|
|
||||||
let record l =
|
let record l =
|
||||||
List (List.map l ~f:(fun (n, v) -> List [Atom(Atom.of_string n); v]))
|
List (List.map l ~f:(fun (n, v) -> List [Atom(Atom.of_string n); v]))
|
||||||
let string_hashtbl f h =
|
|
||||||
string_map f
|
|
||||||
(Hashtbl.foldi h ~init:String.Map.empty ~f:(fun key data acc ->
|
|
||||||
String.Map.add acc key data))
|
|
||||||
|
|
||||||
type field = string * dsexp option
|
type field = string * dsexp option
|
||||||
|
|
||||||
|
@ -670,21 +674,6 @@ module Of_sexp = struct
|
||||||
| true -> return None
|
| true -> return None
|
||||||
| false -> t >>| Option.some)
|
| false -> t >>| Option.some)
|
||||||
|
|
||||||
let string_set = list string >>| String.Set.of_list
|
|
||||||
let string_map t =
|
|
||||||
list (pair string t) >>= fun bindings ->
|
|
||||||
match String.Map.of_list bindings with
|
|
||||||
| Result.Ok x -> return x
|
|
||||||
| Error (key, _v1, _v2) ->
|
|
||||||
loc >>= fun loc ->
|
|
||||||
of_sexp_errorf loc "key %s present multiple times" key
|
|
||||||
|
|
||||||
let string_hashtbl t =
|
|
||||||
string_map t >>| fun map ->
|
|
||||||
let tbl = Hashtbl.create (String.Map.cardinal map + 32) in
|
|
||||||
String.Map.iteri map ~f:(Hashtbl.add tbl);
|
|
||||||
tbl
|
|
||||||
|
|
||||||
let find_cstr cstrs loc name ctx values =
|
let find_cstr cstrs loc name ctx values =
|
||||||
match List.assoc cstrs name with
|
match List.assoc cstrs name with
|
||||||
| Some t ->
|
| Some t ->
|
||||||
|
|
|
@ -1,7 +0,0 @@
|
||||||
include Types.Sexp
|
|
||||||
|
|
||||||
let atom_or_quoted_string s =
|
|
||||||
if Atom.is_valid_dune s then
|
|
||||||
Atom (Atom.of_string s)
|
|
||||||
else
|
|
||||||
Quoted_string s
|
|
|
@ -1,7 +0,0 @@
|
||||||
type t = Types.Sexp.t =
|
|
||||||
| Atom of Atom.t
|
|
||||||
| Quoted_string of string
|
|
||||||
| List of t list
|
|
||||||
| Template of Types.Template.t
|
|
||||||
|
|
||||||
val atom_or_quoted_string : string -> t
|
|
|
@ -20,11 +20,3 @@ module Template = struct
|
||||||
; loc: Loc.t
|
; loc: Loc.t
|
||||||
}
|
}
|
||||||
end
|
end
|
||||||
|
|
||||||
module Sexp = struct
|
|
||||||
type t =
|
|
||||||
| Atom of Atom.t
|
|
||||||
| Quoted_string of string
|
|
||||||
| List of t list
|
|
||||||
| Template of Template.t
|
|
||||||
end
|
|
||||||
|
|
|
@ -1,3 +1,5 @@
|
||||||
|
module String = StringLabels
|
||||||
|
|
||||||
type quote =
|
type quote =
|
||||||
| Needs_quoting_with_length of int
|
| Needs_quoting_with_length of int
|
||||||
| No_quoting
|
| No_quoting
|
||||||
|
|
|
@ -1,10 +1,10 @@
|
||||||
type t = exn
|
type t = exn
|
||||||
|
|
||||||
exception Code_error of Sexp0.t
|
exception Code_error of Sexp.t
|
||||||
|
|
||||||
exception Fatal_error of string
|
exception Fatal_error of string
|
||||||
|
|
||||||
exception Loc_error of Loc0.t * string
|
exception Loc_error of Loc.t * string
|
||||||
|
|
||||||
external raise : exn -> _ = "%raise"
|
external raise : exn -> _ = "%raise"
|
||||||
external raise_notrace : exn -> _ = "%raise_notrace"
|
external raise_notrace : exn -> _ = "%raise_notrace"
|
||||||
|
@ -26,9 +26,9 @@ let protect ~f ~finally = protectx () ~f ~finally
|
||||||
|
|
||||||
let code_error message vars =
|
let code_error message vars =
|
||||||
Code_error
|
Code_error
|
||||||
(Sexp0.List (Sexp0.Atom message
|
(List (Atom message
|
||||||
:: List.map vars ~f:(fun (name, value) ->
|
:: List.map vars ~f:(fun (name, value) ->
|
||||||
Sexp0.List [Sexp0.Atom name; value])))
|
Sexp.List [Atom name; value])))
|
||||||
|> raise
|
|> raise
|
||||||
|
|
||||||
include
|
include
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
|
|
||||||
(** An programming error, that should be reported upstream. The error message
|
(** An programming error, that should be reported upstream. The error message
|
||||||
shouldn't try to be developer friendly rather than user friendly. *)
|
shouldn't try to be developer friendly rather than user friendly. *)
|
||||||
exception Code_error of Sexp0.t
|
exception Code_error of Sexp.t
|
||||||
|
|
||||||
|
|
||||||
(* CR-soon diml:
|
(* CR-soon diml:
|
||||||
|
@ -14,14 +14,14 @@ exception Code_error of Sexp0.t
|
||||||
(** A fatal error, that should be reported to the user in a nice way *)
|
(** A fatal error, that should be reported to the user in a nice way *)
|
||||||
exception Fatal_error of string
|
exception Fatal_error of string
|
||||||
|
|
||||||
exception Loc_error of Loc0.t * string
|
exception Loc_error of Loc.t * string
|
||||||
|
|
||||||
val fatalf
|
val fatalf
|
||||||
: ?loc:Loc0.t
|
: ?loc:Loc.t
|
||||||
-> ('a, unit, string, string, string, 'b) format6
|
-> ('a, unit, string, string, string, 'b) format6
|
||||||
-> 'a
|
-> 'a
|
||||||
|
|
||||||
val code_error : string -> (string * Sexp0.t) list -> _
|
val code_error : string -> (string * Sexp.t) list -> _
|
||||||
|
|
||||||
type t = exn
|
type t = exn
|
||||||
|
|
||||||
|
|
|
@ -87,3 +87,14 @@ let fold t ~init ~f = foldi t ~init ~f:(fun _ x -> f x)
|
||||||
let iter t ~f = iter ~f t
|
let iter t ~f = iter ~f t
|
||||||
|
|
||||||
let keys t = foldi t ~init:[] ~f:(fun key _ acc -> key :: acc)
|
let keys t = foldi t ~init:[] ~f:(fun key _ acc -> key :: acc)
|
||||||
|
|
||||||
|
let sexp_of_t (type key) f g t =
|
||||||
|
let module M =
|
||||||
|
Map.Make(struct
|
||||||
|
type t = key
|
||||||
|
let compare a b = Ordering.of_int (compare a b)
|
||||||
|
end)
|
||||||
|
in
|
||||||
|
Map.sexp_of_t M.to_list f g
|
||||||
|
(foldi t ~init:M.empty ~f:(fun key data acc ->
|
||||||
|
M.add acc key data))
|
||||||
|
|
|
@ -27,3 +27,5 @@ val foldi : ('a, 'b) t -> init:'c -> f:('a -> 'b -> 'c -> 'c) -> 'c
|
||||||
val mem : ('a, _) t -> 'a -> bool
|
val mem : ('a, _) t -> 'a -> bool
|
||||||
|
|
||||||
val keys : ('a, _) t -> 'a list
|
val keys : ('a, _) t -> 'a list
|
||||||
|
|
||||||
|
val sexp_of_t : ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('a, 'b) t -> Sexp.t
|
||||||
|
|
|
@ -7,6 +7,7 @@ module T = struct
|
||||||
Eq
|
Eq
|
||||||
else
|
else
|
||||||
Gt
|
Gt
|
||||||
|
let sexp_of_t = Sexp.To_sexp.int
|
||||||
end
|
end
|
||||||
|
|
||||||
include T
|
include T
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
type t = int
|
type t = int
|
||||||
val compare : t -> t -> Ordering.t
|
val compare : t -> t -> Ordering.t
|
||||||
|
val sexp_of_t : t -> Sexp.t
|
||||||
|
|
||||||
module Set : Set.S with type elt = t
|
module Set : Set.S with type elt = t
|
||||||
module Map : Map.S with type key = t
|
module Map : Map.S with type key = t
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
type t = Loc0.t =
|
type t =
|
||||||
{ start : Lexing.position
|
{ start : Lexing.position
|
||||||
; stop : Lexing.position
|
; stop : Lexing.position
|
||||||
}
|
}
|
||||||
|
@ -45,7 +45,7 @@ let equal_position
|
||||||
; pos_bol = b_b; pos_cnum = c_b }
|
; pos_bol = b_b; pos_cnum = c_b }
|
||||||
=
|
=
|
||||||
let open Int.Infix in
|
let open Int.Infix in
|
||||||
String.equal f_a f_b
|
Caml.String.equal f_a f_b
|
||||||
&& l_a = l_b
|
&& l_a = l_b
|
||||||
&& b_a = b_b
|
&& b_a = b_b
|
||||||
&& c_a = c_b
|
&& c_a = c_b
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
type t = Loc0.t =
|
type t =
|
||||||
{ start : Lexing.position
|
{ start : Lexing.position
|
||||||
; stop : Lexing.position
|
; stop : Lexing.position
|
||||||
}
|
}
|
||||||
|
@ -9,9 +9,9 @@ val none : t
|
||||||
|
|
||||||
val of_lexbuf : Lexing.lexbuf -> t
|
val of_lexbuf : Lexing.lexbuf -> t
|
||||||
|
|
||||||
val sexp_of_t : t -> Sexp0.t
|
val sexp_of_t : t -> Sexp.t
|
||||||
|
|
||||||
val sexp_of_position_no_file : Lexing.position -> Sexp0.t
|
val sexp_of_position_no_file : Lexing.position -> Sexp.t
|
||||||
|
|
||||||
val equal : t -> t -> bool
|
val equal : t -> t -> bool
|
||||||
|
|
||||||
|
|
|
@ -1,4 +0,0 @@
|
||||||
type t =
|
|
||||||
{ start : Caml.Lexing.position
|
|
||||||
; stop : Caml.Lexing.position
|
|
||||||
}
|
|
|
@ -143,3 +143,6 @@ module Make(Key : Comparable.S) : S with type key = Key.t = struct
|
||||||
let superpose a b =
|
let superpose a b =
|
||||||
union a b ~f:(fun _ _ y -> Some y)
|
union a b ~f:(fun _ _ y -> Some y)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
let sexp_of_t to_list f g t =
|
||||||
|
Sexp.To_sexp.(list (pair f g)) (to_list t)
|
||||||
|
|
|
@ -1,3 +1,9 @@
|
||||||
module type S = Map_intf.S
|
module type S = Map_intf.S
|
||||||
|
|
||||||
module Make(Key : Comparable.S) : S with type key = Key.t
|
module Make(Key : Comparable.S) : S with type key = Key.t
|
||||||
|
|
||||||
|
val sexp_of_t
|
||||||
|
: ('a -> ('b * 'c) list)
|
||||||
|
-> 'b Sexp.To_sexp.t
|
||||||
|
-> 'c Sexp.To_sexp.t
|
||||||
|
-> 'a Sexp.To_sexp.t
|
||||||
|
|
|
@ -45,3 +45,6 @@ module Make(Elt : Comparable.S) : S with type elt = Elt.t = struct
|
||||||
let choose = choose_opt
|
let choose = choose_opt
|
||||||
let split x t = split t x
|
let split x t = split t x
|
||||||
end
|
end
|
||||||
|
|
||||||
|
let sexp_of_t to_list f t =
|
||||||
|
Sexp.To_sexp.list f (to_list t)
|
||||||
|
|
|
@ -1,3 +1,8 @@
|
||||||
module type S = Set_intf.S
|
module type S = Set_intf.S
|
||||||
|
|
||||||
module Make(Elt : Comparable.S) : S with type elt = Elt.t
|
module Make(Elt : Comparable.S) : S with type elt = Elt.t
|
||||||
|
|
||||||
|
val sexp_of_t
|
||||||
|
: ('a -> 'b list)
|
||||||
|
-> 'b Sexp.To_sexp.t
|
||||||
|
-> 'a Sexp.To_sexp.t
|
||||||
|
|
|
@ -1,4 +1,8 @@
|
||||||
type t = Sexp0.t =
|
module Array = ArrayLabels
|
||||||
|
module List = ListLabels
|
||||||
|
module String = StringLabels
|
||||||
|
|
||||||
|
type t =
|
||||||
| Atom of string
|
| Atom of string
|
||||||
| List of t list
|
| List of t list
|
||||||
|
|
||||||
|
@ -21,18 +25,11 @@ module To_sexp = struct
|
||||||
let option f = function
|
let option f = function
|
||||||
| None -> List []
|
| None -> List []
|
||||||
| Some x -> List [f x]
|
| Some x -> List [f x]
|
||||||
let string_set set = list string (String0.Set.to_list set)
|
|
||||||
let string_map f map = list (pair string f) (String0.Map.to_list map)
|
|
||||||
|
|
||||||
let record l =
|
let record l =
|
||||||
List (List.map l ~f:(fun (n, v) -> List [Atom n; v]))
|
List (List.map l ~f:(fun (n, v) -> List [Atom n; v]))
|
||||||
|
|
||||||
let unknown _ = Atom "<unknown>"
|
let unknown _ = Atom "<unknown>"
|
||||||
|
|
||||||
let string_hashtbl f h =
|
|
||||||
string_map f
|
|
||||||
(Caml.Hashtbl.fold h ~init:String0.Map.empty ~f:(fun ~key ~data acc ->
|
|
||||||
String0.Map.add acc key data))
|
|
||||||
end
|
end
|
||||||
|
|
||||||
let rec to_string = function
|
let rec to_string = function
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
type t = Sexp0.t =
|
type t =
|
||||||
| Atom of string
|
| Atom of string
|
||||||
| List of t list
|
| List of t list
|
||||||
|
|
||||||
|
|
|
@ -1,3 +0,0 @@
|
||||||
type t =
|
|
||||||
| Atom of string
|
|
||||||
| List of t list
|
|
|
@ -10,7 +10,4 @@ module type Combinators = sig
|
||||||
val list : 'a t -> 'a list t
|
val list : 'a t -> 'a list t
|
||||||
val array : 'a t -> 'a array t
|
val array : 'a t -> 'a array t
|
||||||
val option : 'a t -> 'a option t
|
val option : 'a t -> 'a option t
|
||||||
val string_set : String0.Set.t t
|
|
||||||
val string_map : 'a t -> 'a String0.Map.t t
|
|
||||||
val string_hashtbl : 'a t -> (string, 'a) Caml.Hashtbl.t t
|
|
||||||
end
|
end
|
||||||
|
|
|
@ -12,7 +12,14 @@ end
|
||||||
|
|
||||||
include StringLabels
|
include StringLabels
|
||||||
|
|
||||||
include String0.T.Include
|
let compare a b = Ordering.of_int (String.compare a b)
|
||||||
|
|
||||||
|
module T = struct
|
||||||
|
type t = StringLabels.t
|
||||||
|
let compare = compare
|
||||||
|
let equal (x : t) (y : t) = x = y
|
||||||
|
let hash (s : t) = Hashtbl.hash s
|
||||||
|
end
|
||||||
|
|
||||||
let capitalize = capitalize_ascii
|
let capitalize = capitalize_ascii
|
||||||
let uncapitalize = uncapitalize_ascii
|
let uncapitalize = uncapitalize_ascii
|
||||||
|
@ -195,16 +202,16 @@ let maybe_quoted s =
|
||||||
else
|
else
|
||||||
Printf.sprintf {|"%s"|} escaped
|
Printf.sprintf {|"%s"|} escaped
|
||||||
|
|
||||||
module Set = String0.Set
|
module Set = Set.Make(T)
|
||||||
|
|
||||||
module Map = struct
|
module Map = struct
|
||||||
include String0.Map
|
include Map.Make(T)
|
||||||
let pp f fmt t =
|
let pp f fmt t =
|
||||||
Format.pp_print_list (fun fmt (k, v) ->
|
Format.pp_print_list (fun fmt (k, v) ->
|
||||||
Format.fprintf fmt "@[<hov 2>(%s@ =@ %a)@]" k f v
|
Format.fprintf fmt "@[<hov 2>(%s@ =@ %a)@]" k f v
|
||||||
) fmt (to_list t)
|
) fmt (to_list t)
|
||||||
end
|
end
|
||||||
module Table = Hashtbl.Make(String0.T)
|
module Table = Hashtbl.Make(T)
|
||||||
|
|
||||||
let enumerate_gen s =
|
let enumerate_gen s =
|
||||||
let s = " " ^ s ^ " " in
|
let s = " " ^ s ^ " " in
|
||||||
|
|
|
@ -53,9 +53,9 @@ val enumerate_and : string list -> string
|
||||||
(** Produces: "x, y or z" *)
|
(** Produces: "x, y or z" *)
|
||||||
val enumerate_or : string list -> string
|
val enumerate_or : string list -> string
|
||||||
|
|
||||||
module Set : Set.S with type elt = t and type t = String0.Set.t
|
module Set : Set.S with type elt = t
|
||||||
module Map : sig
|
module Map : sig
|
||||||
include Map.S with type key = t and type 'a t = 'a String0.Map.t
|
include Map.S with type key = t
|
||||||
|
|
||||||
val pp : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit
|
val pp : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit
|
||||||
end
|
end
|
||||||
|
|
|
@ -1,14 +0,0 @@
|
||||||
module T = struct
|
|
||||||
type t = StringLabels.t
|
|
||||||
|
|
||||||
module Include = struct
|
|
||||||
let compare a b = Ordering.of_int (Caml.String.compare a b)
|
|
||||||
let equal (x : t) (y : t) = x = y
|
|
||||||
let hash (s : t) = Caml.Hashtbl.hash s
|
|
||||||
end
|
|
||||||
|
|
||||||
include Include
|
|
||||||
end
|
|
||||||
|
|
||||||
module Set = Set.Make(T)
|
|
||||||
module Map = Map.Make(T)
|
|
Loading…
Reference in New Issue