v0.18~preview.130.05+548

Author: public-release

core.opam

@@ -35,6 +35,7 @@ depends: [
   "stdio"
   "time_now"
   "typerep"
+  "univ_map"
   "variantslib"
   "dune"                {>= "3.11.0"}
 ]

core/src/date0.ml

@@ -642,6 +642,16 @@ let first_strictly_after t ~on:dow =
   add_days tplus1 diff
 ;;
 
+let last_date_in_month ~year ~month =
+  create_exn ~y:year ~m:month ~d:(days_in_month ~year ~month)
+;;
+
+let all_dates_in_month ~year ~month =
+  dates_between
+    ~min:(create_exn ~y:year ~m:month ~d:1)
+    ~max:(last_date_in_month ~year ~month)
+;;
+
 module For_quickcheck = struct
   open Quickcheck
 

core/src/date0_intf.ml

@@ -254,6 +254,12 @@ module type Date0 = sig
       Incorrect for September 1752. *)
   val days_in_month : year:int -> month:Month.t -> int
 
+  (** [last_date_in_month ~year ~month] returns the last date in [month] and [year]. *)
+  val last_date_in_month : year:int -> month:Month.t -> t
+
+  (** [all_dates_in_month ~year ~month] returns all dates in [month] and [year]. *)
+  val all_dates_in_month : year:int -> month:Month.t -> t list
+
   (** [is_leap_year ~year] returns true if [year] is considered a leap year *)
   val is_leap_year : year:int -> bool
 
@@ -301,7 +307,7 @@ module type Date0 = sig
 
   module Stable : sig
     module V1 : sig
-      type nonrec t = t [@@deriving equal, hash, sexp_grammar] [@@immediate]
+      type nonrec t = t [@@deriving equal, hash, sexp_grammar, string] [@@immediate]
 
       (** [to_int] and [of_int_exn] convert to/from the underlying integer
           representation. *)

core/src/dune

@@ -7,12 +7,11 @@
 (library
  (foreign_stubs
   (language c)
-  (names bigstring_stubs md5_stubs array_stubs gc_stubs time_ns_stubs
+  (names bigstring_stubs md5_stubs array_stubs gc_stubs
     timezone_js_loader_stubs)
   (flags :standard -D_LARGEFILE64_SOURCE))
  (name core)
  (public_name core)
- (install_c_headers time_ns_stubs)
  (libraries base base_bigstring base_for_tests base_quickcheck bin_prot
    command fieldslib filename_base heap_block bin_prot.shape
    ppx_diff.diffable ppx_expect.config_types jane-street-headers base.md5

core/src/error.ml

@@ -1,8 +1,9 @@
 include Base.Error
 include Info.Extend (Base.Error)
 
-let failwiths ?strict ~here message a sexp_of_a =
-  raise (create ?strict ~here message a sexp_of_a)
+let failwiths ?strict ?(here = Stdlib.Lexing.dummy_pos) message a sexp_of_a =
+  let here = if Source_code_position0.is_dummy here then None else Some here in
+  raise (create ?strict ?here message a sexp_of_a)
 ;;
 
 let failwithp ?strict here message a sexp_of_a =

core/src/error.mli

@@ -29,7 +29,7 @@ include Info_intf.Extension with type t := t
    [~here:Source_code_position.t] to avoid a circular dependency. *)
 val failwiths
   :  ?strict:unit
-  -> here:Lexing.position
+  -> ?here:Stdlib.Lexing.position
   -> string
   -> 'a
   -> ('a -> Base.Sexp.t)

core/src/gc.ml

@@ -496,15 +496,20 @@ module Expert = struct
       ()
   ;;
 
-  (* [add_finalizer_exn] is the same as [add_finalizer].  However, their types in
+  (* [add_finalizer_ignore] is the same as [add_finalizer].  However, their types in
      core_gc.mli are different, and the type of [add_finalizer] guarantees that it always
      receives a heap block, which ensures that it will not raise, while
      [add_finalizer_exn] accepts any type, and so may raise. *)
+  let add_finalizer_ignore x f =
+    try Stdlib.Gc.finalise (fun x -> Exn.handle_uncaught_and_exit (fun () -> f x)) x with
+    | Invalid_argument _ -> ()
+  ;;
+
   let add_finalizer_exn x f =
     try Stdlib.Gc.finalise (fun x -> Exn.handle_uncaught_and_exit (fun () -> f x)) x with
     | Invalid_argument _ ->
-      ignore (Heap_block.create x : _ Heap_block.t option);
-      (* If [Heap_block.create] succeeds then [x] is static data and so
+      ignore (Heap_block.create_exn x : _ Heap_block.t);
+      (* If [Heap_block.create_exn] succeeds then [x] is static data and so
          we can simply drop the finaliser. *)
       ()
   ;;
@@ -519,11 +524,16 @@ module Expert = struct
       ()
   ;;
 
+  let add_finalizer_last_ignore x f =
+    try Stdlib.Gc.finalise_last (fun () -> Exn.handle_uncaught_and_exit f) x with
+    | Invalid_argument _ -> ()
+  ;;
+
   let add_finalizer_last_exn x f =
     try Stdlib.Gc.finalise_last (fun () -> Exn.handle_uncaught_and_exit f) x with
     | Invalid_argument _ ->
-      ignore (Heap_block.create x : _ Heap_block.t option);
-      (* If [Heap_block.create] succeeds then [x] is static data and so
+      ignore (Heap_block.create_exn x : _ Heap_block.t);
+      (* If [Heap_block.create_exn] succeeds then [x] is static data and so
          we can simply drop the finaliser. *)
       ()
   ;;
@@ -546,6 +556,11 @@ module Expert = struct
       let f = protect_finalizer x f in
       add_finalizer_exn x f
     ;;
+
+    let add_finalizer_ignore x f =
+      let f = protect_finalizer x f in
+      add_finalizer_ignore x f
+    ;;
   end
 
   let finalize_release = Stdlib.Gc.finalise_release

core/src/gc.mli

@@ -647,10 +647,14 @@ module Expert : sig
 
       [add_finalizer_exn b f] is like [add_finalizer], but will raise if [b] is not a heap
       block.
+
+      [add_finalizer_ignore b f] is like [add_finalizer], but will ignore the error, if
+      any. This means that the finalizer may not ever run.
   *)
   val add_finalizer : 'a Heap_block.t -> ('a Heap_block.t -> unit) -> unit
 
   val add_finalizer_exn : 'a -> ('a -> unit) -> unit
+  val add_finalizer_ignore : 'a -> ('a -> unit) -> unit
 
   (** Same as {!add_finalizer} except that the function is not called until the value has
       become unreachable for the last time.  This means that the finalization function
@@ -660,6 +664,7 @@ module Expert : sig
   val add_finalizer_last : 'a Heap_block.t -> (unit -> unit) -> unit
 
   val add_finalizer_last_exn : 'a -> (unit -> unit) -> unit
+  val add_finalizer_last_ignore : 'a -> (unit -> unit) -> unit
 
   module With_leak_protection : sig
     (** The versions of [add_finalizer] that protect against memory leaks on circular
@@ -673,6 +678,7 @@ module Expert : sig
 
     val add_finalizer : 'a Heap_block.t -> ('a Heap_block.t -> unit) -> unit
     val add_finalizer_exn : 'a -> ('a -> unit) -> unit
+    val add_finalizer_ignore : 'a -> ('a -> unit) -> unit
 
     (** Make a function [f] safe to use with [Stdlib.Gc.finalise f' x], despite [f]
         potentially containing references back to [x].

core/src/map.ml

@@ -353,6 +353,7 @@ module Make_tree_S1 (Key : Comparator.S1) = struct
   let find_multi a b = find_multi a b ~comparator
   let change a b ~f = change a b ~f ~comparator
   let update a b ~f = update a b ~f ~comparator
+  let update_and_return a b ~f = update_and_return a b ~f ~comparator
   let find_exn a b = find_exn a b ~comparator
   let find a b = find a b ~comparator
   let remove a b = remove a b ~comparator

core/src/map.mli

@@ -352,6 +352,14 @@ val change : ('k, 'v, 'cmp) t -> 'k -> f:('v option -> 'v option) -> ('k, 'v, 'c
 (** [update t key ~f] is [change t key ~f:(fun o -> Some (f o))]. *)
 val update : ('k, 'v, 'cmp) t -> 'k -> f:('v option -> 'v) -> ('k, 'v, 'cmp) t
 
+(** [update_and_return t key ~f] is like [update t key ~f], but also returns the new
+    value. *)
+val update_and_return
+  :  ('k, 'v, 'cmp) t
+  -> 'k
+  -> f:('v option -> 'v)
+  -> 'v * ('k, 'v, 'cmp) t
+
 (** Returns the value bound to the given key if it exists, and [None] otherwise. *)
 val find : ('k, 'v, 'cmp) t -> 'k -> 'v option