From ea5b09b877d0b9ea2822df91118845893a16d890 Mon Sep 17 00:00:00 2001 From: Takashi Suwa Date: Sun, 3 Jul 2022 01:57:34 +0900 Subject: [PATCH 1/3] specify a dependency version and an option for compiling sources Signed-off-by: Takashi Suwa --- base.opam | 2 +- src/dune | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/base.opam b/base.opam index 7e0a0d0c..72194ec0 100644 --- a/base.opam +++ b/base.opam @@ -11,7 +11,7 @@ build: [ ] depends: [ "ocaml" {>= "4.10.0"} - "sexplib0" + "sexplib0" {>= "v0.15.0"} "dune" {>= "2.0.0"} "dune-configurator" ] diff --git a/src/dune b/src/dune index 04f42d55..c5677e07 100644 --- a/src/dune +++ b/src/dune @@ -9,6 +9,7 @@ (library (name base) (public_name base) (libraries base_internalhash_types caml sexplib0 shadow_stdlib) + (flags :standard -w -55) (c_flags :standard -D_LARGEFILE64_SOURCE (:include mpopcnt.sexp)) (c_names exn_stubs int_math_stubs hash_stubs am_testing) (preprocess no_preprocessing) From b51c80bfa093f138b479692ee4f568bc9fc24187 Mon Sep 17 00:00:00 2001 From: Takashi Suwa Date: Sun, 3 Jul 2022 03:18:37 +0900 Subject: [PATCH 2/3] add `fold_list` to `Monad` Signed-off-by: Takashi Suwa --- src/list.ml | 1 + src/monad.ml | 8 ++++++++ src/monad_intf.ml | 7 +++++++ 3 files changed, 16 insertions(+) diff --git a/src/list.ml b/src/list.ml index 4ac462d9..2f448d84 100644 --- a/src/list.ml +++ b/src/list.ml @@ -763,6 +763,7 @@ module Cartesian_product = struct let all_unit = Monad.all_unit let ignore_m = Monad.ignore_m let join = Monad.join + let fold_list = Monad.fold_list module Monad_infix = struct let ( >>| ) = ( >>| ) diff --git a/src/monad.ml b/src/monad.ml index 3712ab0f..0df0fde2 100644 --- a/src/monad.ml +++ b/src/monad.ml @@ -66,6 +66,14 @@ module Make_general (M : Basic_general) = struct | [] -> return () | t :: ts -> t >>= fun () -> all_unit ts ;; + + let fold_list ~f ~init = + let rec loop acc = function + | [] -> return acc + | t :: ts -> f acc t >>= fun acc -> loop acc ts + in + loop init + end module Make_indexed (M : Basic_indexed) : diff --git a/src/monad_intf.ml b/src/monad_intf.ml index 30e1eda4..31b1bbe6 100644 --- a/src/monad_intf.ml +++ b/src/monad_intf.ml @@ -89,6 +89,10 @@ module type S_without_syntax = sig (** Like [all], but ensures that every monadic value in the list produces a unit value, all of which are discarded rather than being collected into a list. *) val all_unit : unit t list -> unit t + + (** [fold_list ~f ~init [v1; ...; vn]] folds over a list applying a monadic operation, + i.e., performs [f init v1 >>= fun acc -> f acc v2 >>= ... >>= fun acc -> f acc vn]. *) + val fold_list : f:('a -> 'b -> 'a t) -> init:'a -> 'b list -> 'a t end module type S = sig @@ -156,6 +160,7 @@ module type S2 = sig val ignore_m : (_, 'e) t -> (unit, 'e) t val all : ('a, 'e) t list -> ('a list, 'e) t val all_unit : (unit, 'e) t list -> (unit, 'e) t + val fold_list : f:('a -> 'b -> ('a, 'e) t) -> init:'a -> 'b list -> ('a, 'e) t end module type Basic3 = sig @@ -218,6 +223,7 @@ module type S3 = sig val ignore_m : (_, 'd, 'e) t -> (unit, 'd, 'e) t val all : ('a, 'd, 'e) t list -> ('a list, 'd, 'e) t val all_unit : (unit, 'd, 'e) t list -> (unit, 'd, 'e) t + val fold_list : f:('a -> 'b -> ('a, 'd, 'e) t) -> init:'a -> 'b list -> ('a, 'd, 'e) t end module type Basic_indexed = sig @@ -299,6 +305,7 @@ module type S_indexed = sig val ignore_m : (_, 'i, 'j) t -> (unit, 'i, 'j) t val all : ('a, 'i, 'i) t list -> ('a list, 'i, 'i) t val all_unit : (unit, 'i, 'i) t list -> (unit, 'i, 'i) t + val fold_list : f:('a -> 'b -> ('a, 'i, 'i) t) -> init:'a -> 'b list -> ('a, 'i, 'i) t end module S_to_S2 (X : S) : S2 with type ('a, 'e) t = 'a X.t = struct From ea20cd69b35346955d0fe15cc6f28191ef7f670a Mon Sep 17 00:00:00 2001 From: Takashi Suwa Date: Sun, 3 Jul 2022 03:57:27 +0900 Subject: [PATCH 3/3] add `map_list` to `Monad` Signed-off-by: Takashi Suwa --- src/list.ml | 1 + src/monad.ml | 7 +++++++ src/monad_intf.ml | 7 +++++++ 3 files changed, 15 insertions(+) diff --git a/src/list.ml b/src/list.ml index 2f448d84..f0e0b1b2 100644 --- a/src/list.ml +++ b/src/list.ml @@ -764,6 +764,7 @@ module Cartesian_product = struct let ignore_m = Monad.ignore_m let join = Monad.join let fold_list = Monad.fold_list + let map_list = Monad.map_list module Monad_infix = struct let ( >>| ) = ( >>| ) diff --git a/src/monad.ml b/src/monad.ml index 0df0fde2..768b9bcf 100644 --- a/src/monad.ml +++ b/src/monad.ml @@ -74,6 +74,13 @@ module Make_general (M : Basic_general) = struct in loop init + let map_list ~f = + let rec loop vs = function + | [] -> return (List.rev vs) + | t :: ts -> f t >>= fun v -> loop (v :: vs) ts + in + loop [] + end module Make_indexed (M : Basic_indexed) : diff --git a/src/monad_intf.ml b/src/monad_intf.ml index 31b1bbe6..b9b404ed 100644 --- a/src/monad_intf.ml +++ b/src/monad_intf.ml @@ -93,6 +93,10 @@ module type S_without_syntax = sig (** [fold_list ~f ~init [v1; ...; vn]] folds over a list applying a monadic operation, i.e., performs [f init v1 >>= fun acc -> f acc v2 >>= ... >>= fun acc -> f acc vn]. *) val fold_list : f:('a -> 'b -> 'a t) -> init:'a -> 'b list -> 'a t + + (** [map_list ~f [v1; ...; vn]] applies a monadic operation to each element of a list, + i.e., performs [f v1 >>= fun w1 -> f v2 >>= fun w2 -> ... f vn >>= fun wn -> return [w1; ...; wn]]. *) + val map_list : f:('a -> 'b t) -> 'a list -> 'b list t end module type S = sig @@ -161,6 +165,7 @@ module type S2 = sig val all : ('a, 'e) t list -> ('a list, 'e) t val all_unit : (unit, 'e) t list -> (unit, 'e) t val fold_list : f:('a -> 'b -> ('a, 'e) t) -> init:'a -> 'b list -> ('a, 'e) t + val map_list : f:('a -> ('b, 'e) t) -> 'a list -> ('b list, 'e) t end module type Basic3 = sig @@ -224,6 +229,7 @@ module type S3 = sig val all : ('a, 'd, 'e) t list -> ('a list, 'd, 'e) t val all_unit : (unit, 'd, 'e) t list -> (unit, 'd, 'e) t val fold_list : f:('a -> 'b -> ('a, 'd, 'e) t) -> init:'a -> 'b list -> ('a, 'd, 'e) t + val map_list : f:('a -> ('b, 'd, 'e) t) -> 'a list -> ('b list, 'd, 'e) t end module type Basic_indexed = sig @@ -306,6 +312,7 @@ module type S_indexed = sig val all : ('a, 'i, 'i) t list -> ('a list, 'i, 'i) t val all_unit : (unit, 'i, 'i) t list -> (unit, 'i, 'i) t val fold_list : f:('a -> 'b -> ('a, 'i, 'i) t) -> init:'a -> 'b list -> ('a, 'i, 'i) t + val map_list : f:('a -> ('b, 'i, 'i) t) -> 'a list -> ('b list, 'i, 'i) t end module S_to_S2 (X : S) : S2 with type ('a, 'e) t = 'a X.t = struct