diff --git a/base.opam b/base.opam index 7e0a0d0..72194ec 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 04f42d5..c5677e0 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) diff --git a/src/list.ml b/src/list.ml index 4ac462d..f0e0b1b 100644 --- a/src/list.ml +++ b/src/list.ml @@ -763,6 +763,8 @@ 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 + let map_list = Monad.map_list module Monad_infix = struct let ( >>| ) = ( >>| ) diff --git a/src/monad.ml b/src/monad.ml index 3712ab0..768b9bc 100644 --- a/src/monad.ml +++ b/src/monad.ml @@ -66,6 +66,21 @@ 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 + + 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 30e1eda..b9b404e 100644 --- a/src/monad_intf.ml +++ b/src/monad_intf.ml @@ -89,6 +89,14 @@ 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 + + (** [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 @@ -156,6 +164,8 @@ 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 + val map_list : f:('a -> ('b, 'e) t) -> 'a list -> ('b list, 'e) t end module type Basic3 = sig @@ -218,6 +228,8 @@ 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 + val map_list : f:('a -> ('b, 'd, 'e) t) -> 'a list -> ('b list, 'd, 'e) t end module type Basic_indexed = sig @@ -299,6 +311,8 @@ 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 + 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