mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 11:15:31 -05:00
remove unlabel, remove all traces of Result
This commit is contained in:
parent
30251e9426
commit
1b5b23a8f1
27 changed files with 160 additions and 361 deletions
|
|
@ -709,3 +709,20 @@ module Infix = struct
|
||||||
let (--) = (--)
|
let (--) = (--)
|
||||||
let (--^) = (--^)
|
let (--^) = (--^)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
(* test consistency of interfaces *)
|
||||||
|
(*$inject
|
||||||
|
module FA = CCShims_.Stdlib.Array.Floatarray
|
||||||
|
module type L = module type of CCArray with module Floatarray := FA
|
||||||
|
module type LL = module type of CCArrayLabels with module Floatarray := FA
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*$R
|
||||||
|
ignore (module CCArrayLabels : L)
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*$R
|
||||||
|
ignore (module CCArray : LL)
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -418,3 +418,19 @@ let to_seq a k = iter k a
|
||||||
let to_gen a = _to_gen a.arr a.i a.j
|
let to_gen a = _to_gen a.arr a.i a.j
|
||||||
|
|
||||||
let to_klist a = _to_klist a.arr a.i a.j
|
let to_klist a = _to_klist a.arr a.i a.j
|
||||||
|
|
||||||
|
|
||||||
|
(* test consistency of interfaces *)
|
||||||
|
(*$inject
|
||||||
|
module type L = module type of CCArray_slice
|
||||||
|
module type LL = module type of CCArray_sliceLabels
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*$R
|
||||||
|
ignore (module CCArray_sliceLabels : L)
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*$R
|
||||||
|
ignore (module CCArray_slice : LL)
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -42,3 +42,18 @@ module Infix : sig
|
||||||
end
|
end
|
||||||
|
|
||||||
include module type of Infix
|
include module type of Infix
|
||||||
|
|
||||||
|
(* test consistency of interfaces *)
|
||||||
|
(*$inject
|
||||||
|
module type L = module type of CCEqual
|
||||||
|
module type LL = module type of CCEqualLabels
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*$R
|
||||||
|
ignore (module CCEqualLabels : L)
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*$R
|
||||||
|
ignore (module CCEqual : LL)
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -418,8 +418,8 @@ module Dump = struct
|
||||||
let triple p1 p2 p3 = within "(" ")" (hovbox (triple p1 p2 p3))
|
let triple p1 p2 p3 = within "(" ")" (hovbox (triple p1 p2 p3))
|
||||||
let quad p1 p2 p3 p4 = within "(" ")" (hovbox (quad p1 p2 p3 p4))
|
let quad p1 p2 p3 p4 = within "(" ")" (hovbox (quad p1 p2 p3 p4))
|
||||||
let result' pok perror out = function
|
let result' pok perror out = function
|
||||||
| Result.Ok x -> Format.fprintf out "(@[Ok %a@])" pok x
|
| Ok x -> Format.fprintf out "(@[Ok %a@])" pok x
|
||||||
| Result.Error e -> Format.fprintf out "(@[Error %a@])" perror e
|
| Error e -> Format.fprintf out "(@[Error %a@])" perror e
|
||||||
let result pok = result' pok string
|
let result pok = result' pok string
|
||||||
let to_string = to_string
|
let to_string = to_string
|
||||||
end
|
end
|
||||||
|
|
@ -429,5 +429,5 @@ end
|
||||||
"Some 1" (to_string Dump.(option int) (Some 1))
|
"Some 1" (to_string Dump.(option int) (Some 1))
|
||||||
"[None;Some \"a b\"]" (to_string Dump.(list (option string)) [None; Some "a b"])
|
"[None;Some \"a b\"]" (to_string Dump.(list (option string)) [None; Some "a b"])
|
||||||
"[(Ok \"a b c\");(Error \"nope\")]" \
|
"[(Ok \"a b c\");(Error \"nope\")]" \
|
||||||
(to_string Dump.(list (result string)) [Result.Ok "a b c"; Result.Error "nope"])
|
(to_string Dump.(list (result string)) [Ok "a b c"; Error "nope"])
|
||||||
*)
|
*)
|
||||||
|
|
|
||||||
|
|
@ -329,8 +329,8 @@ module Dump : sig
|
||||||
val quad :
|
val quad :
|
||||||
'a t -> 'b t -> 'c t -> 'd t ->
|
'a t -> 'b t -> 'c t -> 'd t ->
|
||||||
('a * 'b * 'c * 'd) t
|
('a * 'b * 'c * 'd) t
|
||||||
val result : 'a t -> ('a, string) Result.result t
|
val result : 'a t -> ('a, string) result t
|
||||||
val result' : 'a t -> 'e t -> ('a, 'e) Result.result t
|
val result' : 'a t -> 'e t -> ('a, 'e) result t
|
||||||
val to_string : 'a t -> 'a -> string
|
val to_string : 'a t -> 'a -> string
|
||||||
(** Alias to {!CCFormat.to_string}. *)
|
(** Alias to {!CCFormat.to_string}. *)
|
||||||
end
|
end
|
||||||
|
|
|
||||||
|
|
@ -3,7 +3,7 @@
|
||||||
|
|
||||||
(** {1 IO Utils} *)
|
(** {1 IO Utils} *)
|
||||||
|
|
||||||
type 'a or_error = ('a, string) Result.result
|
type 'a or_error = ('a, string) result
|
||||||
type 'a gen = unit -> 'a option
|
type 'a gen = unit -> 'a option
|
||||||
|
|
||||||
let gen_empty () = None
|
let gen_empty () = None
|
||||||
|
|
@ -256,28 +256,28 @@ module File = struct
|
||||||
let remove_exn f = Sys.remove f
|
let remove_exn f = Sys.remove f
|
||||||
|
|
||||||
let remove f =
|
let remove f =
|
||||||
try Result.Ok (Sys.remove f)
|
try Ok (Sys.remove f)
|
||||||
with exn ->
|
with exn ->
|
||||||
Result.Error (Printexc.to_string exn)
|
Error (Printexc.to_string exn)
|
||||||
|
|
||||||
let read_exn f = with_in f (read_all_ ~op:Ret_string ~size:4096)
|
let read_exn f = with_in f (read_all_ ~op:Ret_string ~size:4096)
|
||||||
|
|
||||||
let read f =
|
let read f =
|
||||||
try Result.Ok (read_exn f) with e -> Result.Error (Printexc.to_string e)
|
try Ok (read_exn f) with e -> Error (Printexc.to_string e)
|
||||||
|
|
||||||
let append_exn f x =
|
let append_exn f x =
|
||||||
with_out ~flags:[Open_append; Open_creat; Open_text] f
|
with_out ~flags:[Open_append; Open_creat; Open_text] f
|
||||||
(fun oc -> output_string oc x; flush oc)
|
(fun oc -> output_string oc x; flush oc)
|
||||||
|
|
||||||
let append f x =
|
let append f x =
|
||||||
try Result.Ok (append_exn f x) with e -> Result.Error (Printexc.to_string e)
|
try Ok (append_exn f x) with e -> Error (Printexc.to_string e)
|
||||||
|
|
||||||
let write_exn f x =
|
let write_exn f x =
|
||||||
with_out f
|
with_out f
|
||||||
(fun oc -> output_string oc x; flush oc)
|
(fun oc -> output_string oc x; flush oc)
|
||||||
|
|
||||||
let write f x =
|
let write f x =
|
||||||
try Result.Ok (write_exn f x) with e -> Result.Error (Printexc.to_string e)
|
try Ok (write_exn f x) with e -> Error (Printexc.to_string e)
|
||||||
|
|
||||||
let remove_noerr f = try Sys.remove f with _ -> ()
|
let remove_noerr f = try Sys.remove f with _ -> ()
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -52,7 +52,7 @@
|
||||||
|
|
||||||
*)
|
*)
|
||||||
|
|
||||||
type 'a or_error = ('a, string) Result.result
|
type 'a or_error = ('a, string) result
|
||||||
type 'a gen = unit -> 'a option
|
type 'a gen = unit -> 'a option
|
||||||
(** See [Gen] in the {{: https://github.com/c-cube/gen} gen library}. *)
|
(** See [Gen] in the {{: https://github.com/c-cube/gen} gen library}. *)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1027,8 +1027,8 @@ let keep_some l = filter_map (fun x->x) l
|
||||||
let keep_ok l =
|
let keep_ok l =
|
||||||
filter_map
|
filter_map
|
||||||
(function
|
(function
|
||||||
| Result.Ok x -> Some x
|
| Ok x -> Some x
|
||||||
| Result.Error _ -> None)
|
| Error _ -> None)
|
||||||
l
|
l
|
||||||
|
|
||||||
let all_some l =
|
let all_some l =
|
||||||
|
|
@ -1044,14 +1044,14 @@ let all_some l =
|
||||||
let all_ok l =
|
let all_ok l =
|
||||||
let err = ref None in
|
let err = ref None in
|
||||||
try
|
try
|
||||||
Result.Ok
|
Ok
|
||||||
(map
|
(map
|
||||||
(function Result.Ok x -> x | Result.Error e -> err := Some e; raise Exit)
|
(function Ok x -> x | Error e -> err := Some e; raise Exit)
|
||||||
l)
|
l)
|
||||||
with Exit ->
|
with Exit ->
|
||||||
begin match !err with
|
begin match !err with
|
||||||
| None -> assert false
|
| None -> assert false
|
||||||
| Some e -> Result.Error e
|
| Some e -> Error e
|
||||||
end
|
end
|
||||||
|
|
||||||
let group_by (type k) ?(hash=Hashtbl.hash) ?(eq=Stdlib.(=)) l =
|
let group_by (type k) ?(hash=Hashtbl.hash) ?(eq=Stdlib.(=)) l =
|
||||||
|
|
@ -1158,10 +1158,6 @@ let group_join_by (type a) ?(eq=Stdlib.(=)) ?(hash=Hashtbl.hash) f c1 c2 =
|
||||||
|> sort Stdlib.compare)
|
|> sort Stdlib.compare)
|
||||||
*)
|
*)
|
||||||
|
|
||||||
(*$inject
|
|
||||||
open Result
|
|
||||||
*)
|
|
||||||
|
|
||||||
(*$=
|
(*$=
|
||||||
(Ok []) (all_ok [])
|
(Ok []) (all_ok [])
|
||||||
(Ok [1;2;3]) (all_ok [Ok 1; Ok 2; Ok 3])
|
(Ok [1;2;3]) (all_ok [Ok 1; Ok 2; Ok 3])
|
||||||
|
|
@ -1746,3 +1742,18 @@ let pp ?(start="") ?(stop="") ?(sep=", ") pp_item fmt l =
|
||||||
[1;2;3])
|
[1;2;3])
|
||||||
*)
|
*)
|
||||||
|
|
||||||
|
|
||||||
|
(* test consistency of interfaces *)
|
||||||
|
(*$inject
|
||||||
|
module type L = module type of CCList
|
||||||
|
module type LL = module type of CCListLabels
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*$R
|
||||||
|
ignore (module CCListLabels : L)
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*$R
|
||||||
|
ignore (module CCList : LL)
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -394,7 +394,7 @@ val keep_some : 'a option t -> 'a t
|
||||||
@since 1.3, but only
|
@since 1.3, but only
|
||||||
@since 2.2 with labels *)
|
@since 2.2 with labels *)
|
||||||
|
|
||||||
val keep_ok : ('a, _) Result.result t -> 'a t
|
val keep_ok : ('a, _) result t -> 'a t
|
||||||
(** [keep_ok l] retains only elements of the form [Ok x].
|
(** [keep_ok l] retains only elements of the form [Ok x].
|
||||||
@since 1.3, but only
|
@since 1.3, but only
|
||||||
@since 2.2 with labels *)
|
@since 2.2 with labels *)
|
||||||
|
|
@ -405,7 +405,7 @@ val all_some : 'a option t -> 'a t option
|
||||||
@since 1.3, but only
|
@since 1.3, but only
|
||||||
@since 2.2 with labels *)
|
@since 2.2 with labels *)
|
||||||
|
|
||||||
val all_ok : ('a, 'err) Result.result t -> ('a t, 'err) Result.result
|
val all_ok : ('a, 'err) result t -> ('a t, 'err) result
|
||||||
(** [all_ok l] returns [Ok l'] if all elements of [l] are of the form [Ok x],
|
(** [all_ok l] returns [Ok l'] if all elements of [l] are of the form [Ok x],
|
||||||
or [Error e] otherwise (with the first error met).
|
or [Error e] otherwise (with the first error met).
|
||||||
@since 1.3, but only
|
@since 1.3, but only
|
||||||
|
|
|
||||||
|
|
@ -392,7 +392,7 @@ val keep_some : 'a option t -> 'a t
|
||||||
@since 1.3, but only
|
@since 1.3, but only
|
||||||
@since 2.2 with labels *)
|
@since 2.2 with labels *)
|
||||||
|
|
||||||
val keep_ok : ('a, _) Result.result t -> 'a t
|
val keep_ok : ('a, _) result t -> 'a t
|
||||||
(** [keep_ok l] retains only elements of the form [Ok x].
|
(** [keep_ok l] retains only elements of the form [Ok x].
|
||||||
@since 1.3, but only
|
@since 1.3, but only
|
||||||
@since 2.2 with labels *)
|
@since 2.2 with labels *)
|
||||||
|
|
@ -403,7 +403,7 @@ val all_some : 'a option t -> 'a t option
|
||||||
@since 1.3, but only
|
@since 1.3, but only
|
||||||
@since 2.2 with labels *)
|
@since 2.2 with labels *)
|
||||||
|
|
||||||
val all_ok : ('a, 'err) Result.result t -> ('a t, 'err) Result.result
|
val all_ok : ('a, 'err) result t -> ('a t, 'err) result
|
||||||
(** [all_ok l] returns [Ok l'] if all elements of [l] are of the form [Ok x],
|
(** [all_ok l] returns [Ok l'] if all elements of [l] are of the form [Ok x],
|
||||||
or [Error e] otherwise (with the first error met).
|
or [Error e] otherwise (with the first error met).
|
||||||
@since 1.3, but only
|
@since 1.3, but only
|
||||||
|
|
|
||||||
|
|
@ -150,16 +150,16 @@ let of_list = function
|
||||||
| [] -> None
|
| [] -> None
|
||||||
|
|
||||||
let to_result err = function
|
let to_result err = function
|
||||||
| None -> Result.Error err
|
| None -> Error err
|
||||||
| Some x -> Result.Ok x
|
| Some x -> Ok x
|
||||||
|
|
||||||
let to_result_lazy err_fn = function
|
let to_result_lazy err_fn = function
|
||||||
| None -> Result.Error (err_fn ())
|
| None -> Error (err_fn ())
|
||||||
| Some x -> Result.Ok x
|
| Some x -> Ok x
|
||||||
|
|
||||||
let of_result = function
|
let of_result = function
|
||||||
| Result.Error _ -> None
|
| Error _ -> None
|
||||||
| Result.Ok x -> Some x
|
| Ok x -> Some x
|
||||||
|
|
||||||
module Infix = struct
|
module Infix = struct
|
||||||
let (>|=) = (>|=)
|
let (>|=) = (>|=)
|
||||||
|
|
|
||||||
|
|
@ -163,13 +163,13 @@ val to_list : 'a t -> 'a list
|
||||||
val of_list : 'a list -> 'a t
|
val of_list : 'a list -> 'a t
|
||||||
(** Head of list, or [None]. *)
|
(** Head of list, or [None]. *)
|
||||||
|
|
||||||
val to_result : 'e -> 'a t -> ('a, 'e) Result.result
|
val to_result : 'e -> 'a t -> ('a, 'e) result
|
||||||
(** @since 1.2 *)
|
(** @since 1.2 *)
|
||||||
|
|
||||||
val to_result_lazy : (unit -> 'e) -> 'a t -> ('a, 'e) Result.result
|
val to_result_lazy : (unit -> 'e) -> 'a t -> ('a, 'e) result
|
||||||
(** @since 1.2 *)
|
(** @since 1.2 *)
|
||||||
|
|
||||||
val of_result : ('a, _) Result.result -> 'a t
|
val of_result : ('a, _) result -> 'a t
|
||||||
(** @since 1.2 *)
|
(** @since 1.2 *)
|
||||||
|
|
||||||
type 'a sequence = ('a -> unit) -> unit
|
type 'a sequence = ('a -> unit) -> unit
|
||||||
|
|
|
||||||
|
|
@ -100,7 +100,7 @@ open CCShims_
|
||||||
()
|
()
|
||||||
*)
|
*)
|
||||||
|
|
||||||
type 'a or_error = ('a, string) Result.result
|
type 'a or_error = ('a, string) result
|
||||||
|
|
||||||
type line_num = int
|
type line_num = int
|
||||||
type col_num = int
|
type col_num = int
|
||||||
|
|
@ -443,10 +443,10 @@ let parse_exn p st =
|
||||||
| None -> assert false
|
| None -> assert false
|
||||||
| Some x -> x
|
| Some x -> x
|
||||||
|
|
||||||
let exn_to_err e =Result.Error (Printexc.to_string e)
|
let exn_to_err e = Error (Printexc.to_string e)
|
||||||
|
|
||||||
let parse p st =
|
let parse p st =
|
||||||
try Result.Ok (parse_exn p st)
|
try Ok (parse_exn p st)
|
||||||
with e -> exn_to_err e
|
with e -> exn_to_err e
|
||||||
|
|
||||||
let parse_string_exn p s = parse_exn p (state_of_string s)
|
let parse_string_exn p s = parse_exn p (state_of_string s)
|
||||||
|
|
@ -479,7 +479,7 @@ let parse_file_exn p file =
|
||||||
raise e
|
raise e
|
||||||
|
|
||||||
let parse_file p file =
|
let parse_file p file =
|
||||||
try Result.Ok (parse_file_exn p file)
|
try Ok (parse_file_exn p file)
|
||||||
with e -> exn_to_err e
|
with e -> exn_to_err e
|
||||||
|
|
||||||
module Infix = struct
|
module Infix = struct
|
||||||
|
|
|
||||||
|
|
@ -48,7 +48,7 @@
|
||||||
|
|
||||||
*)
|
*)
|
||||||
|
|
||||||
type 'a or_error = ('a, string) Result.result
|
type 'a or_error = ('a, string) result
|
||||||
|
|
||||||
type line_num = int
|
type line_num = int
|
||||||
type col_num = int
|
type col_num = int
|
||||||
|
|
|
||||||
|
|
@ -9,9 +9,7 @@ type 'a printer = Format.formatter -> 'a -> unit
|
||||||
|
|
||||||
(** {2 Basics} *)
|
(** {2 Basics} *)
|
||||||
|
|
||||||
include Result
|
type (+'good, +'bad) t = ('good, 'bad) result =
|
||||||
|
|
||||||
type (+'good, +'bad) t = ('good, 'bad) Result.result =
|
|
||||||
| Ok of 'good
|
| Ok of 'good
|
||||||
| Error of 'bad
|
| Error of 'bad
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -13,10 +13,7 @@ type 'a printer = Format.formatter -> 'a -> unit
|
||||||
|
|
||||||
(** {2 Basics} *)
|
(** {2 Basics} *)
|
||||||
|
|
||||||
include module type of struct include Result end
|
type (+'good, +'bad) t = ('good, 'bad) result =
|
||||||
(** @since 1.5 *)
|
|
||||||
|
|
||||||
type (+'good, +'bad) t = ('good, 'bad) Result.result =
|
|
||||||
| Ok of 'good
|
| Ok of 'good
|
||||||
| Error of 'bad
|
| Error of 'bad
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1162,3 +1162,18 @@ module Sub = struct
|
||||||
let pp fmt s =
|
let pp fmt s =
|
||||||
Format.fprintf fmt "\"%s\"" (copy s)
|
Format.fprintf fmt "\"%s\"" (copy s)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
(* test consistency of interfaces *)
|
||||||
|
(*$inject
|
||||||
|
module type L = module type of CCString
|
||||||
|
module type LL = module type of CCStringLabels
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*$R
|
||||||
|
ignore (module CCStringLabels : L)
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*$R
|
||||||
|
ignore (module CCString : LL)
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,42 +1,3 @@
|
||||||
(alias
|
|
||||||
(name unlabel)
|
|
||||||
(deps
|
|
||||||
(:mli CCArrayLabels.mli)
|
|
||||||
../unlabel.exe)
|
|
||||||
(action
|
|
||||||
(run ../unlabel.exe %{mli} CCArray.mli)))
|
|
||||||
|
|
||||||
(alias
|
|
||||||
(name unlabel)
|
|
||||||
(deps
|
|
||||||
(:mli CCArray_sliceLabels.mli)
|
|
||||||
../unlabel.exe)
|
|
||||||
(action
|
|
||||||
(run ../unlabel.exe %{mli} CCArray_slice.mli)))
|
|
||||||
|
|
||||||
(alias
|
|
||||||
(name unlabel)
|
|
||||||
(deps
|
|
||||||
(:mli CCEqualLabels.mli)
|
|
||||||
../unlabel.exe)
|
|
||||||
(action
|
|
||||||
(run ../unlabel.exe %{mli} CCEqual.mli)))
|
|
||||||
|
|
||||||
(alias
|
|
||||||
(name unlabel)
|
|
||||||
(deps
|
|
||||||
(:mli CCListLabels.mli)
|
|
||||||
../unlabel.exe)
|
|
||||||
(action
|
|
||||||
(run ../unlabel.exe %{mli} CCList.mli)))
|
|
||||||
|
|
||||||
(alias
|
|
||||||
(name unlabel)
|
|
||||||
(deps
|
|
||||||
(:mli CCStringLabels.mli)
|
|
||||||
../unlabel.exe)
|
|
||||||
(action
|
|
||||||
(run ../unlabel.exe %{mli} CCString.mli)))
|
|
||||||
|
|
||||||
(executable
|
(executable
|
||||||
(name mkshims)
|
(name mkshims)
|
||||||
|
|
|
||||||
|
|
@ -80,6 +80,24 @@ let shims_array_pre_408 = "
|
||||||
"
|
"
|
||||||
let shims_array_post_408 = "include Array"
|
let shims_array_post_408 = "include Array"
|
||||||
|
|
||||||
|
let shims_let_op_pre_408 =
|
||||||
|
"module Make_let_applicative(X:sig end) = struct end
|
||||||
|
module Make_let_functor(X:sig end) = struct end
|
||||||
|
"
|
||||||
|
let shims_let_op_post_408 =
|
||||||
|
"module Make_let_applicative(X:sig
|
||||||
|
type 'a t
|
||||||
|
val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
|
||||||
|
val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
|
||||||
|
end) = struct
|
||||||
|
end
|
||||||
|
module Make_let_functor(X:sig
|
||||||
|
type 'a t
|
||||||
|
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
|
||||||
|
end) = struct
|
||||||
|
end
|
||||||
|
"
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
C.main ~name:"mkshims" (fun c ->
|
C.main ~name:"mkshims" (fun c ->
|
||||||
let version = C.ocaml_config_var_exn c "version" in
|
let version = C.ocaml_config_var_exn c "version" in
|
||||||
|
|
|
||||||
5
src/dune
5
src/dune
|
|
@ -3,11 +3,6 @@
|
||||||
(modules mkflags)
|
(modules mkflags)
|
||||||
(libraries dune.configurator))
|
(libraries dune.configurator))
|
||||||
|
|
||||||
(executable
|
|
||||||
(name unlabel)
|
|
||||||
(modules unlabel)
|
|
||||||
(libraries compiler-libs.common))
|
|
||||||
|
|
||||||
(env
|
(env
|
||||||
(_ (flags :standard -warn-error -3)))
|
(_ (flags :standard -warn-error -3)))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -4,6 +4,4 @@
|
||||||
(public_name containers.iter)
|
(public_name containers.iter)
|
||||||
(wrapped false)
|
(wrapped false)
|
||||||
(flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string)
|
(flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string)
|
||||||
(ocamlopt_flags :standard (:include ../flambda.flags))
|
(ocamlopt_flags :standard (:include ../flambda.flags)))
|
||||||
(libraries dune)
|
|
||||||
)
|
|
||||||
|
|
|
||||||
|
|
@ -4,7 +4,7 @@
|
||||||
|
|
||||||
open CCShims_
|
open CCShims_
|
||||||
|
|
||||||
type 'a or_error = ('a, string) Result.result
|
type 'a or_error = ('a, string) result
|
||||||
type 'a sequence = ('a -> unit) -> unit
|
type 'a sequence = ('a -> unit) -> unit
|
||||||
type 'a gen = unit -> 'a option
|
type 'a gen = unit -> 'a option
|
||||||
|
|
||||||
|
|
@ -134,7 +134,7 @@ module Make(Sexp : SEXP) = struct
|
||||||
x
|
x
|
||||||
with e ->
|
with e ->
|
||||||
close_in ic;
|
close_in ic;
|
||||||
Result.Error (Printexc.to_string e)
|
Error (Printexc.to_string e)
|
||||||
|
|
||||||
(** A parser of ['a] can return [Yield x] when it parsed a value,
|
(** A parser of ['a] can return [Yield x] when it parsed a value,
|
||||||
or [Fail e] when a parse error was encountered, or
|
or [Fail e] when a parse error was encountered, or
|
||||||
|
|
@ -234,9 +234,9 @@ module Make(Sexp : SEXP) = struct
|
||||||
|
|
||||||
let to_list (d:t) : _ or_error =
|
let to_list (d:t) : _ or_error =
|
||||||
let rec iter acc = match next d with
|
let rec iter acc = match next d with
|
||||||
| End -> Result.Ok (List.rev acc)
|
| End -> Ok (List.rev acc)
|
||||||
| Yield x -> iter (x::acc)
|
| Yield x -> iter (x::acc)
|
||||||
| Fail e -> Result.Error e
|
| Fail e -> Error e
|
||||||
in
|
in
|
||||||
try iter []
|
try iter []
|
||||||
with e -> Error (Printexc.to_string e)
|
with e -> Error (Printexc.to_string e)
|
||||||
|
|
@ -244,9 +244,9 @@ module Make(Sexp : SEXP) = struct
|
||||||
|
|
||||||
let dec_next_ (d:Decoder.t) : _ or_error =
|
let dec_next_ (d:Decoder.t) : _ or_error =
|
||||||
match Decoder.next d with
|
match Decoder.next d with
|
||||||
| End -> Result.Error "unexpected end of file"
|
| End -> Error "unexpected end of file"
|
||||||
| Yield x -> Result.Ok x
|
| Yield x -> Ok x
|
||||||
| Fail s -> Result.Error s
|
| Fail s -> Error s
|
||||||
|
|
||||||
let parse_string s : t or_error =
|
let parse_string s : t or_error =
|
||||||
let buf = Lexing.from_string s in
|
let buf = Lexing.from_string s in
|
||||||
|
|
@ -284,8 +284,8 @@ module Make(Sexp : SEXP) = struct
|
||||||
let d = Decoder.of_lexbuf buf in
|
let d = Decoder.of_lexbuf buf in
|
||||||
fun () -> match Decoder.next d with
|
fun () -> match Decoder.next d with
|
||||||
| End -> None
|
| End -> None
|
||||||
| Fail e -> Some (Result.Error e)
|
| Fail e -> Some (Error e)
|
||||||
| Yield x -> Some (Result.Ok x)
|
| Yield x -> Some (Ok x)
|
||||||
|
|
||||||
let parse_file filename = _with_in filename (parse_chan_ ~file:filename)
|
let parse_file filename = _with_in filename (parse_chan_ ~file:filename)
|
||||||
|
|
||||||
|
|
@ -341,20 +341,20 @@ include (Make(struct
|
||||||
CCResult.to_opt (parse_string "\"\123\bcoucou\"") <> None
|
CCResult.to_opt (parse_string "\"\123\bcoucou\"") <> None
|
||||||
*)
|
*)
|
||||||
|
|
||||||
(*$= & ~printer:(function Result.Ok x -> to_string x | Result.Error e -> "error " ^ e)
|
(*$= & ~printer:(function Ok x -> to_string x | Error e -> "error " ^ e)
|
||||||
(parse_string "(a b)") (Result.Ok (`List [`Atom "a"; `Atom "b"]))
|
(parse_string "(a b)") (Ok (`List [`Atom "a"; `Atom "b"]))
|
||||||
(parse_string "(a\n ;coucou\n b)") (Result.Ok (`List [`Atom "a"; `Atom "b"]))
|
(parse_string "(a\n ;coucou\n b)") (Ok (`List [`Atom "a"; `Atom "b"]))
|
||||||
(parse_string "(a #; (foo bar\n (1 2 3)) b)") (Result.Ok (`List [`Atom "a"; `Atom "b"]))
|
(parse_string "(a #; (foo bar\n (1 2 3)) b)") (Ok (`List [`Atom "a"; `Atom "b"]))
|
||||||
(parse_string "#; (a b) (c d)") (Result.Ok (`List [`Atom "c"; `Atom "d"]))
|
(parse_string "#; (a b) (c d)") (Ok (`List [`Atom "c"; `Atom "d"]))
|
||||||
(parse_string "#; (a b) 1") (Result.Ok (`Atom "1"))
|
(parse_string "#; (a b) 1") (Ok (`Atom "1"))
|
||||||
*)
|
*)
|
||||||
|
|
||||||
(*$= & ~printer:(function Result.Ok x -> String.concat ";" @@ List.map to_string x | Result.Error e -> "error " ^ e)
|
(*$= & ~printer:(function Ok x -> String.concat ";" @@ List.map to_string x | Error e -> "error " ^ e)
|
||||||
(parse_string_list "(a b)(c)") (Result.Ok [`List [`Atom "a"; `Atom "b"]; `List [`Atom "c"]])
|
(parse_string_list "(a b)(c)") (Ok [`List [`Atom "a"; `Atom "b"]; `List [`Atom "c"]])
|
||||||
(parse_string_list " ") (Result.Ok [])
|
(parse_string_list " ") (Ok [])
|
||||||
(parse_string_list "(a\n ;coucou\n b)") (Result.Ok [`List [`Atom "a"; `Atom "b"]])
|
(parse_string_list "(a\n ;coucou\n b)") (Ok [`List [`Atom "a"; `Atom "b"]])
|
||||||
(parse_string_list "#; (a b) (c d) e ") (Result.Ok [`List [`Atom "c"; `Atom "d"]; `Atom "e"])
|
(parse_string_list "#; (a b) (c d) e ") (Ok [`List [`Atom "c"; `Atom "d"]; `Atom "e"])
|
||||||
(parse_string_list "#; (a b) 1") (Result.Ok [`Atom "1"])
|
(parse_string_list "#; (a b) 1") (Ok [`Atom "1"])
|
||||||
*)
|
*)
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -392,7 +392,7 @@ include (Make(struct
|
||||||
*)
|
*)
|
||||||
|
|
||||||
(*$Q & ~count:100
|
(*$Q & ~count:100
|
||||||
sexp_gen (fun s -> sexp_valid s ==> (to_string s |> parse_string = Result.Ok s))
|
sexp_gen (fun s -> sexp_valid s ==> (to_string s |> parse_string = Ok s))
|
||||||
*)
|
*)
|
||||||
|
|
||||||
let atom s : t = `Atom s
|
let atom s : t = `Atom s
|
||||||
|
|
|
||||||
|
|
@ -2,7 +2,7 @@
|
||||||
|
|
||||||
(** {1 Handling S-expressions} *)
|
(** {1 Handling S-expressions} *)
|
||||||
|
|
||||||
type 'a or_error = ('a, string) Result.result
|
type 'a or_error = ('a, string) result
|
||||||
type 'a sequence = ('a -> unit) -> unit
|
type 'a sequence = ('a -> unit) -> unit
|
||||||
type 'a gen = unit -> 'a option
|
type 'a gen = unit -> 'a option
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
|
|
||||||
type 'a or_error = ('a, string) Result.result
|
type 'a or_error = ('a, string) result
|
||||||
type 'a sequence = ('a -> unit) -> unit
|
type 'a sequence = ('a -> unit) -> unit
|
||||||
type 'a gen = unit -> 'a option
|
type 'a gen = unit -> 'a option
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -3,7 +3,7 @@
|
||||||
|
|
||||||
(** {1 High-level Functions on top of Unix} *)
|
(** {1 High-level Functions on top of Unix} *)
|
||||||
|
|
||||||
type 'a or_error = ('a, string) Result.result
|
type 'a or_error = ('a, string) result
|
||||||
type 'a gen = unit -> 'a option
|
type 'a gen = unit -> 'a option
|
||||||
|
|
||||||
(** {2 Calling Commands} *)
|
(** {2 Calling Commands} *)
|
||||||
|
|
|
||||||
|
|
@ -8,7 +8,7 @@
|
||||||
{b status: unstable}
|
{b status: unstable}
|
||||||
@since 0.10 *)
|
@since 0.10 *)
|
||||||
|
|
||||||
type 'a or_error = ('a, string) Result.result
|
type 'a or_error = ('a, string) result
|
||||||
type 'a gen = unit -> 'a option
|
type 'a gen = unit -> 'a option
|
||||||
|
|
||||||
(** {2 Calling Commands} *)
|
(** {2 Calling Commands} *)
|
||||||
|
|
|
||||||
242
src/unlabel.ml
242
src/unlabel.ml
|
|
@ -1,242 +0,0 @@
|
||||||
(* search for first occurrence of pat in s *)
|
|
||||||
let rec search pat s pos =
|
|
||||||
let rec compare i =
|
|
||||||
if i >= String.length pat
|
|
||||||
then true
|
|
||||||
else if pat.[i] = s.[pos+i]
|
|
||||||
then compare (i+1)
|
|
||||||
else false
|
|
||||||
in
|
|
||||||
if pos > String.length s - String.length pat
|
|
||||||
then raise Not_found
|
|
||||||
else if compare 0
|
|
||||||
then pos
|
|
||||||
else search pat s (pos+1)
|
|
||||||
;;
|
|
||||||
|
|
||||||
(* search all non-overlapping occurrences of pat in s *)
|
|
||||||
let search_all pat s =
|
|
||||||
let rec search_rest acc pos =
|
|
||||||
let next =
|
|
||||||
try Some (search pat s pos) with
|
|
||||||
Not_found -> None
|
|
||||||
in
|
|
||||||
match next with
|
|
||||||
| None -> acc
|
|
||||||
| Some pos -> search_rest (pos::acc) (pos + String.length pat)
|
|
||||||
in
|
|
||||||
List.rev (search_rest [] 0)
|
|
||||||
;;
|
|
||||||
|
|
||||||
(* replace first occurrence of pat with subst in s *)
|
|
||||||
let replace_first pat subst s =
|
|
||||||
let pos = search pat s 0 in
|
|
||||||
let patl = String.length pat
|
|
||||||
and substl = String.length subst in
|
|
||||||
let buf = Bytes.create (String.length s - patl + substl) in
|
|
||||||
Bytes.blit_string s 0 buf 0 pos;
|
|
||||||
Bytes.blit_string subst 0 buf pos substl;
|
|
||||||
Bytes.blit_string
|
|
||||||
s (pos + patl)
|
|
||||||
buf (pos + substl)
|
|
||||||
(String.length s - pos - patl);
|
|
||||||
Bytes.unsafe_to_string buf
|
|
||||||
;;
|
|
||||||
|
|
||||||
(* replace all occurrences of pat with subst in s *)
|
|
||||||
let replace_all pat subst s =
|
|
||||||
let pos = search_all pat s in
|
|
||||||
let patl = String.length pat
|
|
||||||
and substl = String.length subst in
|
|
||||||
let len = String.length s + List.length pos * (substl - patl) in
|
|
||||||
let buf = Bytes.create len in
|
|
||||||
let rec loop src_pos dst_pos = function
|
|
||||||
| [] ->
|
|
||||||
Bytes.blit_string s src_pos buf dst_pos (String.length s - src_pos)
|
|
||||||
| pat_pos :: tail ->
|
|
||||||
let headl = pat_pos - src_pos in
|
|
||||||
Bytes.blit_string s src_pos buf dst_pos headl;
|
|
||||||
Bytes.blit_string subst 0 buf (dst_pos + headl) substl;
|
|
||||||
loop
|
|
||||||
(src_pos + headl + patl)
|
|
||||||
(dst_pos + headl + substl)
|
|
||||||
tail
|
|
||||||
in loop 0 0 pos;
|
|
||||||
Bytes.unsafe_to_string buf
|
|
||||||
;;
|
|
||||||
|
|
||||||
let match_closeparen s i =
|
|
||||||
assert (s.[i] = ')');
|
|
||||||
let rec loop i count =
|
|
||||||
match s.[i] with
|
|
||||||
| '(' when count = 0 -> i
|
|
||||||
| '(' -> loop (i-1) (count-1)
|
|
||||||
| ')' -> loop (i-1) (count+1)
|
|
||||||
| _ -> loop (i-1) count
|
|
||||||
in loop (i-1) 0
|
|
||||||
;;
|
|
||||||
|
|
||||||
let slurp_file file =
|
|
||||||
let ch = open_in file in
|
|
||||||
let buf = Buffer.create (min 1024 (in_channel_length ch)) in
|
|
||||||
try
|
|
||||||
while true do Buffer.add_channel buf ch 4096 done;
|
|
||||||
assert false
|
|
||||||
with
|
|
||||||
| End_of_file ->
|
|
||||||
close_in ch;
|
|
||||||
Bytes.unsafe_to_string (Buffer.to_bytes buf)
|
|
||||||
;;
|
|
||||||
|
|
||||||
let () =
|
|
||||||
assert (Array.length Sys.argv = 3);
|
|
||||||
let labelled_filename = Sys.argv.(1) in (* CCArrayLabels.mli *)
|
|
||||||
let unlabelled_filename = Sys.argv.(2) in (* CCArray.ml *)
|
|
||||||
let labelled_name = (* ArrayLabels *)
|
|
||||||
assert (labelled_filename.[0] = 'C' && labelled_filename.[1] = 'C');
|
|
||||||
let dot = String.rindex labelled_filename '.' in
|
|
||||||
String.sub labelled_filename 2 (dot - 2)
|
|
||||||
in
|
|
||||||
let unlabelled_name = (* Array *)
|
|
||||||
replace_first "Labels" "" labelled_name
|
|
||||||
in
|
|
||||||
let labelled_text = slurp_file labelled_filename in
|
|
||||||
let lexbuf = Lexing.from_string labelled_text in
|
|
||||||
Location.init lexbuf labelled_filename;
|
|
||||||
let labelled_ast = Parse.interface lexbuf in
|
|
||||||
(* stack of replacements to perform on the labelled_text.
|
|
||||||
* perform them in one run later so that the character counts
|
|
||||||
* won't be affected by earlier replacements. *)
|
|
||||||
let replacements = ref [] in
|
|
||||||
(* function removing '~' from docstring attributes where appropriate. *)
|
|
||||||
let strip_attributes labels attributes =
|
|
||||||
List.iter
|
|
||||||
begin function
|
|
||||||
| ({ Asttypes.txt = "ocaml.doc"; _ },
|
|
||||||
Parsetree.PStr [{pstr_loc =
|
|
||||||
{ loc_start = {pos_cnum = start; _}
|
|
||||||
; loc_end = {pos_cnum = stop; _}
|
|
||||||
; _}
|
|
||||||
; _
|
|
||||||
}]) ->
|
|
||||||
let docstring =
|
|
||||||
List.fold_left
|
|
||||||
(fun docstring label ->
|
|
||||||
replace_all ("~" ^ label) label docstring)
|
|
||||||
(String.sub labelled_text start (stop-start))
|
|
||||||
labels
|
|
||||||
in
|
|
||||||
replacements := (start, stop-start, docstring) :: !replacements
|
|
||||||
| _ -> ()
|
|
||||||
end
|
|
||||||
attributes
|
|
||||||
in
|
|
||||||
let iterator =
|
|
||||||
let open Ast_iterator in
|
|
||||||
let open Parsetree in
|
|
||||||
{ Ast_iterator.default_iterator with
|
|
||||||
value_description = begin fun iterator
|
|
||||||
{ pval_name = { txt = _name; _ }
|
|
||||||
; pval_type
|
|
||||||
; pval_prim = _
|
|
||||||
; pval_attributes
|
|
||||||
; pval_loc
|
|
||||||
} ->
|
|
||||||
let rec loop = function
|
|
||||||
(* match function type with label *)
|
|
||||||
| { ptyp_desc = Ptyp_arrow (Labelled label, left, right)
|
|
||||||
; ptyp_loc = {loc_start = {Lexing.pos_cnum = start; _}; _}
|
|
||||||
; ptyp_attributes
|
|
||||||
; _}
|
|
||||||
when
|
|
||||||
(* check that the argument type is not marked with [@keep_label] *)
|
|
||||||
List.for_all
|
|
||||||
(fun ({Asttypes.txt; _}, _) -> txt <> "keep_label")
|
|
||||||
left.ptyp_attributes
|
|
||||||
->
|
|
||||||
assert (label = String.sub labelled_text start (String.length label));
|
|
||||||
let colon = String.index_from labelled_text start ':' in
|
|
||||||
(* remove label *)
|
|
||||||
replacements := (start, colon+1-start, "") :: !replacements;
|
|
||||||
(* remove labels from associated docstrings *)
|
|
||||||
strip_attributes [label] ptyp_attributes;
|
|
||||||
label :: loop right
|
|
||||||
| { ptyp_desc = Ptyp_arrow (_, _left, right); _} ->
|
|
||||||
loop right
|
|
||||||
| _ -> []
|
|
||||||
in
|
|
||||||
let labels = loop pval_type in
|
|
||||||
strip_attributes labels pval_attributes;
|
|
||||||
iterator.attributes iterator pval_attributes;
|
|
||||||
iterator.location iterator pval_loc;
|
|
||||||
iterator.typ iterator pval_type;
|
|
||||||
end
|
|
||||||
; attribute = begin fun iterator
|
|
||||||
({Asttypes.txt
|
|
||||||
; loc =
|
|
||||||
{ loc_start = {pos_cnum = start; _}
|
|
||||||
; loc_end = {pos_cnum = stop; _}
|
|
||||||
; _} as loc
|
|
||||||
}, _) ->
|
|
||||||
if txt = "keep_label"
|
|
||||||
then begin
|
|
||||||
(* start and stop positions mark the location of only the label name.
|
|
||||||
* Therefore search for enclosing brackets. *)
|
|
||||||
let start = String.rindex_from labelled_text start '['
|
|
||||||
and stop = String. index_from labelled_text stop ']' in
|
|
||||||
(* remove leading ' ', too *)
|
|
||||||
let start =
|
|
||||||
if labelled_text.[start-1] = ' ' then start-1 else start
|
|
||||||
in
|
|
||||||
(* if a closing paren follows, remove this and the matching paren,
|
|
||||||
* this will hopefully be the right thing to do. *)
|
|
||||||
let stop =
|
|
||||||
if labelled_text.[stop+1] = ')'
|
|
||||||
then
|
|
||||||
let openp = match_closeparen labelled_text (stop+1) in
|
|
||||||
replacements := (openp, 1, "") :: !replacements;
|
|
||||||
stop+1
|
|
||||||
else
|
|
||||||
stop
|
|
||||||
in
|
|
||||||
replacements := (start, stop-start+1, "") :: !replacements;
|
|
||||||
end;
|
|
||||||
iterator.location iterator loc
|
|
||||||
end
|
|
||||||
}
|
|
||||||
in
|
|
||||||
iterator.signature iterator labelled_ast;
|
|
||||||
|
|
||||||
(* sort replacements in ascending order. *)
|
|
||||||
let replacements =
|
|
||||||
List.sort (fun (p1,_,_) (p2,_,_) -> compare p1 p2) !replacements
|
|
||||||
in
|
|
||||||
|
|
||||||
(* perform the replacements by blitting to a buffer. *)
|
|
||||||
let unlabelled_text = Buffer.create (String.length labelled_text) in
|
|
||||||
List.fold_left begin fun start (pos,len,subst) ->
|
|
||||||
assert (pos >= start);
|
|
||||||
Buffer.add_substring unlabelled_text labelled_text start (pos - start);
|
|
||||||
Buffer.add_string unlabelled_text subst;
|
|
||||||
pos+len
|
|
||||||
end
|
|
||||||
0
|
|
||||||
replacements
|
|
||||||
|> fun start ->
|
|
||||||
Buffer.add_substring unlabelled_text
|
|
||||||
labelled_text start (String.length labelled_text - start);
|
|
||||||
|
|
||||||
let unlabelled_text =
|
|
||||||
Buffer.contents unlabelled_text
|
|
||||||
(* ArrayLabels -> Array *)
|
|
||||||
|> replace_all labelled_name unlabelled_name
|
|
||||||
in
|
|
||||||
|
|
||||||
let out = open_out unlabelled_filename in
|
|
||||||
output_string out (
|
|
||||||
"(* AUTOGENERATED FROM " ^
|
|
||||||
labelled_filename
|
|
||||||
^ " *)\n\n");
|
|
||||||
output_string out unlabelled_text;
|
|
||||||
close_out out;
|
|
||||||
;;
|
|
||||||
Loading…
Add table
Reference in a new issue