diff --git a/hash_types/src/base_internalhash_types.ml b/hash_types/src/base_internalhash_types.ml
index 78aa622..df4eef6 100644
--- a/hash_types/src/base_internalhash_types.ml
+++ b/hash_types/src/base_internalhash_types.ml
@@ -6,7 +6,14 @@ type seed = int
 type hash_value = int
 
 external create_seeded : seed -> state = "%identity" [@@noalloc]
-external fold_int64 : state -> int64 -> state = "Base_internalhash_fold_int64" [@@noalloc]
+
+external fold_int64
+  :  state
+  -> (int64[@unboxed])
+  -> state
+  = "Base_internalhash_fold_int64" "Base_internalhash_fold_int64_unboxed"
+  [@@noalloc]
+
 external fold_int : state -> int -> state = "Base_internalhash_fold_int" [@@noalloc]
 
 external fold_float
diff --git a/hash_types/src/internalhash_stubs.c b/hash_types/src/internalhash_stubs.c
index ada892b..255525f 100644
--- a/hash_types/src/internalhash_stubs.c
+++ b/hash_types/src/internalhash_stubs.c
@@ -21,6 +21,11 @@ CAMLprim value Base_internalhash_fold_int64(value st, value i)
   return Val_long(caml_hash_mix_int64(Long_val(st), Int64_val(i)));
 }
 
+CAMLprim value Base_internalhash_fold_int64_unboxed(value st, int64_t i)
+{
+  return Val_long(caml_hash_mix_int64(Long_val(st), i));
+}
+
 CAMLprim value Base_internalhash_fold_int(value st, value i)
 {
   return Val_long(caml_hash_mix_intnat(Long_val(st), Long_val(i)));
diff --git a/src/avltree.ml b/src/avltree.ml
index bca3cc7..f89f2b0 100644
--- a/src/avltree.ml
+++ b/src/avltree.ml
@@ -177,72 +177,45 @@ let balance tree =
       tree)
 ;;
 
-(* @pre: tree is balanceable
-   @pre: abs (height (right node) - height (balance tree)) <= 3
-   @post: result is balanceable *)
-
-(* @pre: tree is balanceable
-   @pre: abs (height (right node) - height (balance tree)) <= 3
-   @post: result is balanceable *)
-let set_left node tree =
-  let tree = balance tree in
-  match node with
-  | Node ({ left; key = _; value = _; height = _; right = _ } as r) ->
-    if phys_equal left tree then () else r.left <- tree;
-    update_height node
-  | _ -> assert false
-;;
-
-(* @pre: tree is balanceable
-   @pre: abs (height (left node) - height (balance tree)) <= 3
-   @post: result is balanceable *)
-let set_right node tree =
-  let tree = balance tree in
-  match node with
-  | Node ({ left = _; key = _; value = _; height = _; right } as r) ->
-    if phys_equal right tree then () else r.right <- tree;
-    update_height node
-  | _ -> assert false
-;;
-
 (* @pre: t is balanced.
    @post: result is balanced, with new node inserted
    @post: !added = true iff the shape of the input tree changed.  *)
-let add =
-  let rec add t replace added compare k v =
-    match t with
-    | Empty ->
+let rec add t ~replace ~compare ~added ~key:k ~data:v =
+  match t with
+  | Empty ->
+    added := true;
+    Leaf { key = k; value = v }
+  | Leaf ({ key = k'; value = _ } as r) ->
+    let c = compare k' k in
+    (* This compare is reversed on purpose, we are pretending
+       that the leaf was just inserted instead of the other way
+       round, that way we only allocate one node. *)
+    if c = 0
+    then (
+      added := false;
+      if replace then r.value <- v;
+      t)
+    else (
       added := true;
-      Leaf { key = k; value = v }
-    | Leaf ({ key = k'; value = _ } as r) ->
-      let c = compare k' k in
-      (* This compare is reversed on purpose, we are pretending
-         that the leaf was just inserted instead of the other way
-         round, that way we only allocate one node. *)
-      if c = 0
+      if c < 0
+      then Node { left = t; key = k; value = v; height = 2; right = Empty }
+      else Node { left = Empty; key = k; value = v; height = 2; right = t })
+  | Node ({ left; key = k'; value = _; height = _; right } as r) ->
+    let c = compare k k' in
+    if c = 0
+    then (
+      added := false;
+      if replace then r.value <- v;
+      t)
+    else (
+      if c < 0
       then (
-        added := false;
-        if replace then r.value <- v;
-        t)
+        let left' = add left ~replace ~added ~compare ~key:k ~data:v in
+        if not (phys_equal left' left) then r.left <- left')
       else (
-        added := true;
-        if c < 0
-        then Node { left = t; key = k; value = v; height = 2; right = Empty }
-        else Node { left = Empty; key = k; value = v; height = 2; right = t })
-    | Node ({ left; key = k'; value = _; height = _; right } as r) ->
-      let c = compare k k' in
-      if c = 0
-      then (
-        added := false;
-        if replace then r.value <- v)
-      else if c < 0
-      then set_left t (add left replace added compare k v)
-      else set_right t (add right replace added compare k v);
-      t
-  in
-  fun t ~replace ~compare ~added ~key ~data ->
-    let t = add t replace added compare key data in
-    if !added then balance t else t
+        let right' = add right ~replace ~added ~compare ~key:k ~data:v in
+        if not (phys_equal right' right) then r.right <- right');
+      if !added then balance t else t)
 ;;
 
 let rec first t =
@@ -403,7 +376,7 @@ let mem =
   fun t ~compare k -> find_and_call t ~compare k ~if_found ~if_not_found
 ;;
 
-let remove =
+let rec remove =
   let rec min_elt tree =
     match tree with
     | Empty -> Empty
@@ -414,16 +387,13 @@ let remove =
   let rec remove_min_elt tree =
     match tree with
     | Empty -> assert false
-    | Leaf _ -> Empty (* This must be the root *)
+    | Leaf _ -> Empty
     | Node { left = Empty; key = _; value = _; height = _; right } -> right
     | Node { left = Leaf _; key = k; value = v; height = _; right = Empty } ->
       Leaf { key = k; value = v }
-    | Node { left = Leaf _; key = _; value = _; height = _; right = _ } as node ->
-      set_left node Empty;
-      tree
-    | Node { left; key = _; value = _; height = _; right = _ } as node ->
-      set_left node (remove_min_elt left);
-      tree
+    | Node ({ left; key = _; value = _; height = _; right = _ } as r) ->
+      r.left <- remove_min_elt left;
+      balance tree
   in
   let merge t1 t2 =
     match t1, t2 with
@@ -431,23 +401,24 @@ let remove =
     | t, Empty -> t
     | _, _ ->
       let tree = min_elt t2 in
-      (match tree with
-       | Empty -> assert false
-       | Leaf { key = k; value = v } ->
-         let t2 = balance (remove_min_elt t2) in
-         Node
-           { left = t1
-           ; key = k
-           ; value = v
-           ; height = Int.max (height t1) (height t2) + 1
-           ; right = t2
-           }
-       | Node _ as node ->
-         set_right node (remove_min_elt t2);
-         set_left node t1;
-         node)
+      balance
+        (match tree with
+         | Empty -> assert false
+         | Leaf { key = k; value = v } ->
+           let t2 = remove_min_elt t2 in
+           Node
+             { left = t1
+             ; key = k
+             ; value = v
+             ; height = Int.max (height t1) (height t2) + 1
+             ; right = t2
+             }
+         | Node r ->
+           r.right <- remove_min_elt t2;
+           r.left <- t1;
+           tree)
   in
-  let rec remove t removed compare k =
+  fun t ~removed ~compare k ->
     match t with
     | Empty ->
       removed := false;
@@ -460,21 +431,21 @@ let remove =
       else (
         removed := false;
         t)
-    | Node { left; key = k'; value = _; height = _; right } ->
+    | Node ({ left; key = k'; value = _; height = _; right } as r) ->
       let c = compare k k' in
       if c = 0
       then (
         removed := true;
         merge left right)
-      else if c < 0
-      then (
-        set_left t (remove left removed compare k);
-        t)
       else (
-        set_right t (remove right removed compare k);
-        t)
-  in
-  fun t ~removed ~compare k -> balance (remove t removed compare k)
+        if c < 0
+        then (
+          let left' = remove left ~removed ~compare k in
+          if not (phys_equal left' left) then r.left <- left')
+        else (
+          let right' = remove right ~removed ~compare k in
+          if not (phys_equal right' right) then r.right <- right');
+        if !removed then balance t else t)
 ;;
 
 let rec fold t ~init ~f =
diff --git a/src/dune b/src/dune
index 0b93568..fb97bc7 100644
--- a/src/dune
+++ b/src/dune
@@ -12,7 +12,7 @@
  (libraries base_internalhash_types sexplib0 shadow_stdlib)
  (c_flags :standard -D_LARGEFILE64_SOURCE (:include mpopcnt.sexp))
  (c_names bytes_stubs exn_stubs float_stubs int_math_stubs hash_stubs
-  am_testing)
+  obj_stubs am_testing)
  (preprocess no_preprocessing)
  (lint
   (pps ppx_base ppx_base_lint -check-doc-comments -type-conv-keep-w32=both
diff --git a/src/hash.ml b/src/hash.ml
index 407f003..cb194fb 100644
--- a/src/hash.ml
+++ b/src/hash.ml
@@ -144,7 +144,11 @@ module Internalhash : sig
        and type seed = Base_internalhash_types.seed
        and type hash_value = Base_internalhash_types.hash_value
 
-  external fold_int64 : state -> int64 -> state = "Base_internalhash_fold_int64"
+  external fold_int64
+    :  state
+    -> (int64[@unboxed])
+    -> state
+    = "Base_internalhash_fold_int64" "Base_internalhash_fold_int64_unboxed"
     [@@noalloc]
 
   external fold_int : state -> int -> state = "Base_internalhash_fold_int" [@@noalloc]
diff --git a/src/hashtbl.ml b/src/hashtbl.ml
index cf5253d..81eb369 100644
--- a/src/hashtbl.ml
+++ b/src/hashtbl.ml
@@ -234,12 +234,10 @@ let remove t key =
   ensure_mutation_allowed t;
   let i = slot t key in
   let root = t.table.(i) in
-  let added_or_removed =  (ref false) in
-  let new_root =
-    Avltree.remove root ~removed:added_or_removed ~compare:(compare_key t) key
-  in
+  let removed =  (ref false) in
+  let new_root = Avltree.remove root ~removed ~compare:(compare_key t) key in
   if not (phys_equal root new_root) then t.table.(i) <- new_root;
-  if !added_or_removed then t.length <- t.length - 1
+  if !removed then t.length <- t.length - 1
 ;;
 
 let length t = t.length
diff --git a/src/int63.ml b/src/int63.ml
index a880f5c..efa5d79 100644
--- a/src/int63.ml
+++ b/src/int63.ml
@@ -3,58 +3,7 @@ open! Import
 let raise_s = Error.raise_s
 
 module Repr = Int63_emul.Repr
-
-(* In a world where the compiler would understand [@@immediate64] attributes on type
-   declarations, this module is how one would produce a [type t] with this attribute. *)
-module Immediate64 : sig
-  module type Non_immediate = sig
-    type t
-  end
-
-  module type Immediate = sig
-    type t [@@immediate]
-  end
-
-  module Make (Immediate : Immediate) (Non_immediate : Non_immediate) : sig
-    type t [@@immediate64]
-
-    type 'a repr =
-      | Immediate : Immediate.t repr
-      | Non_immediate : Non_immediate.t repr
-
-    val repr : t repr
-  end
-end = struct
-  module type Non_immediate = sig
-    type t
-  end
-
-  module type Immediate = sig
-    type t [@@immediate]
-  end
-
-  module Make (Immediate : Immediate) (Non_immediate : Non_immediate) = struct
-    type t [@@immediate64]
-
-    type 'a repr =
-      | Immediate : Immediate.t repr
-      | Non_immediate : Non_immediate.t repr
-
-    external transparent_magic : ('a[@local_opt]) -> ('b[@local_opt]) = "%identity"
-
-    let repr =
-      (* [Obj.magic] involves opaqueness under Flambda 2 which will inhibit
-         availability of functions defined in this module for later inlining
-         (e.g. into float.ml). As such we explicitly use %identity here. *)
-      match Word_size.word_size with
-      | W64 -> (transparent_magic Immediate : t repr)
-      | W32 -> (transparent_magic Non_immediate : t repr)
-    ;;
-  end
-  [@@inline always]
-end
-
-include Immediate64.Make (Int) (Int63_emul)
+include Sys0.Make_immediate64 (Int) (Int63_emul)
 
 module Backend = struct
   module type S = sig
diff --git a/src/list.ml b/src/list.ml
index 6c02a15..cb9e927 100644
--- a/src/list.ml
+++ b/src/list.ml
@@ -1275,10 +1275,10 @@ module Assoc = struct
 
   let find_exn =
     let not_found = Not_found_s (Atom "List.Assoc.find_exn: not found") in
-    let find_exn t ~equal key =
-      match find t key ~equal with
-      | None -> raise not_found
-      | Some value -> value
+    let rec find_exn t ~equal key =
+      match t with
+      | [] -> raise not_found
+      | (key', value) :: t -> if equal key key' then value else find_exn t ~equal key
     in
     (* named to preserve symbol in compiled binary *)
     find_exn
diff --git a/src/map.ml b/src/map.ml
index e9ab691..0a05874 100644
--- a/src/map.ml
+++ b/src/map.ml
@@ -750,33 +750,30 @@ module Tree0 = struct
       join t1 x d (remove_min_elt t2)
   ;;
 
-  let remove t x ~length ~compare_key =
-    let rec remove_loop t x ~length ~compare_key =
-      match t with
-      | Empty ->  (with_length t length)
-      | Leaf (v, _) ->
-        if compare_key x v = 0
-        then  (with_length Empty (length - 1))
-        else  (with_length t length)
-      | Node (l, v, d, r, _) ->
-        let c = compare_key x v in
-        if c = 0
-        then  (with_length (concat_unchecked l r) (length - 1))
-        else (
-          let l, r, length' =
-            if c < 0
-            then (
-              let { tree = l; length = length' } = remove_loop l x ~length ~compare_key in
-              l, r, length')
-            else (
-              let { tree = r; length = length' } = remove_loop r x ~length ~compare_key in
-              l, r, length')
-          in
-          if length = length'
-          then  (with_length t length)
-          else  (with_length (bal l v d r) length'))
-    in
-     (remove_loop t x ~length ~compare_key)
+  let rec remove t x ~length ~compare_key =
+    match t with
+    | Empty ->  (with_length t length)
+    | Leaf (v, _) ->
+      if compare_key x v = 0
+      then  (with_length Empty (length - 1))
+      else  (with_length t length)
+    | Node (l, v, d, r, _) ->
+      let c = compare_key x v in
+      if c = 0
+      then  (with_length (concat_unchecked l r) (length - 1))
+      else (
+        let l, r, length' =
+          if c < 0
+          then (
+            let { tree = l; length = length' } = remove l x ~length ~compare_key in
+            l, r, length')
+          else (
+            let { tree = r; length = length' } = remove r x ~length ~compare_key in
+            l, r, length')
+        in
+        if length = length'
+        then  (with_length t length)
+        else  (with_length (bal l v d r) length'))
   ;;
 
   let rec change t key ~f ~length ~compare_key =
@@ -1555,6 +1552,24 @@ module Tree0 = struct
        |> globalize) [@nontail]) [@nontail]
   ;;
 
+  let of_list_with_key_fold list ~get_key ~init ~f ~compare_key =
+    List.fold list ~init:(with_length_global empty 0) ~f:(fun { tree = t; length } data ->
+      let key = get_key data in
+      (update t key ~length ~compare_key ~f:(function
+         | None -> f init data
+         | Some prev -> f prev data)
+       |> globalize) [@nontail]) [@nontail]
+  ;;
+
+  let of_list_with_key_reduce list ~get_key ~f ~compare_key =
+    List.fold list ~init:(with_length_global empty 0) ~f:(fun { tree = t; length } data ->
+      let key = get_key data in
+      (update t key ~length ~compare_key ~f:(function
+         | None -> data
+         | Some prev -> f prev data)
+       |> globalize) [@nontail]) [@nontail]
+  ;;
+
   let for_all t ~f =
     with_return (fun r ->
       iter t ~f:(fun data -> if not (f data) then r.return false);
@@ -2499,6 +2514,25 @@ module Tree = struct
       .tree
   ;;
 
+  let of_list_with_key_fold ~comparator list ~get_key ~init ~f =
+    (Tree0.of_list_with_key_fold
+       list
+       ~get_key
+       ~init
+       ~f
+       ~compare_key:comparator.Comparator.compare)
+      .tree
+  ;;
+
+  let of_list_with_key_reduce ~comparator list ~get_key ~f =
+    (Tree0.of_list_with_key_reduce
+       list
+       ~get_key
+       ~f
+       ~compare_key:comparator.Comparator.compare)
+      .tree
+  ;;
+
   let to_tree t = t
 
   let invariants ~comparator t =
@@ -2930,6 +2964,25 @@ module Using_comparator = struct
     |> of_tree0 ~comparator
   ;;
 
+  let of_list_with_key_fold ~comparator list ~get_key ~init ~f =
+    Tree0.of_list_with_key_fold
+      list
+      ~get_key
+      ~init
+      ~f
+      ~compare_key:comparator.Comparator.compare
+    |> of_tree0 ~comparator
+  ;;
+
+  let of_list_with_key_reduce ~comparator list ~get_key ~f =
+    Tree0.of_list_with_key_reduce
+      list
+      ~get_key
+      ~f
+      ~compare_key:comparator.Comparator.compare
+    |> of_tree0 ~comparator
+  ;;
+
   let t_of_sexp_direct ~comparator k_of_sexp v_of_sexp sexp =
     of_tree0 ~comparator (Tree0.t_of_sexp_direct k_of_sexp v_of_sexp sexp ~comparator)
   ;;
@@ -3052,6 +3105,14 @@ let of_list_with_key_multi m l ~get_key =
   Using_comparator.of_list_with_key_multi ~comparator:(to_comparator m) l ~get_key
 ;;
 
+let of_list_with_key_fold m l ~get_key ~init ~f =
+  Using_comparator.of_list_with_key_fold ~comparator:(to_comparator m) l ~get_key ~init ~f
+;;
+
+let of_list_with_key_reduce m l ~get_key ~f =
+  Using_comparator.of_list_with_key_reduce ~comparator:(to_comparator m) l ~get_key ~f
+;;
+
 let map_keys m t ~f = Using_comparator.map_keys ~comparator:(to_comparator m) t ~f
 let map_keys_exn m t ~f = Using_comparator.map_keys_exn ~comparator:(to_comparator m) t ~f
 let transpose_keys m t = Using_comparator.transpose_keys ~comparator:(to_comparator m) t
@@ -3205,6 +3266,14 @@ module Poly = struct
     Using_comparator.of_list_with_key_multi ~comparator l ~get_key
   ;;
 
+  let of_list_with_key_fold l ~get_key ~init ~f =
+    Using_comparator.of_list_with_key_fold ~comparator l ~get_key ~init ~f
+  ;;
+
+  let of_list_with_key_reduce l ~get_key ~f =
+    Using_comparator.of_list_with_key_reduce ~comparator l ~get_key ~f
+  ;;
+
   let map_keys t ~f = Using_comparator.map_keys ~comparator t ~f
   let map_keys_exn t ~f = Using_comparator.map_keys_exn ~comparator t ~f
   let transpose_keys t = Using_comparator.transpose_keys ~comparator t
diff --git a/src/map_intf.ml b/src/map_intf.ml
index 8f50a5f..c76c391 100644
--- a/src/map_intf.ml
+++ b/src/map_intf.ml
@@ -899,6 +899,25 @@ module type Creators_generic = sig
       , 'v list -> get_key:(('v -> 'k key)[@local]) -> ('k, 'v list, 'cmp) t )
       create_options
 
+  val of_list_with_key_fold
+    : ( 'k
+      , 'cmp
+      , 'v list
+        -> get_key:(('v -> 'k key)[@local])
+        -> init:'acc
+        -> f:('acc -> 'v -> 'acc)
+        -> ('k, 'acc, 'cmp) t )
+      create_options
+
+  val of_list_with_key_reduce
+    : ( 'k
+      , 'cmp
+      , 'v list
+        -> get_key:(('v -> 'k key)[@local])
+        -> f:('v -> 'v -> 'v)
+        -> ('k, 'v, 'cmp) t )
+      create_options
+
   val of_iteri
     : ( 'k
       , 'cmp
@@ -1326,6 +1345,23 @@ module type Map = sig
     -> get_key:(('v -> 'k)[@local])
     -> ('k, 'v list, 'cmp) t
 
+  (** Like [of_list_with_key]; resolves duplicate keys the same way [of_alist_fold] does. *)
+  val of_list_with_key_fold
+    :  ('k, 'cmp) Comparator.Module.t
+    -> 'v list
+    -> get_key:(('v -> 'k)[@local])
+    -> init:'acc
+    -> f:('acc -> 'v -> 'acc)
+    -> ('k, 'acc, 'cmp) t
+
+  (** Like [of_list_with_key]; resolves duplicate keys the same way [of_alist_reduce] does. *)
+  val of_list_with_key_reduce
+    :  ('k, 'cmp) Comparator.Module.t
+    -> 'v list
+    -> get_key:(('v -> 'k)[@local])
+    -> f:('v -> 'v -> 'v)
+    -> ('k, 'v, 'cmp) t
+
   (** Tests whether a map is empty. *)
   val is_empty : (_, _, _) t -> bool
 
diff --git a/src/nothing.ml b/src/nothing.ml
index c71474d..ec60404 100644
--- a/src/nothing.ml
+++ b/src/nothing.ml
@@ -29,3 +29,33 @@ include Identifiable.Make (struct
 
   let module_name = "Base.Nothing"
 end)
+
+let must_be_none : t option -> unit = function
+  | None -> ()
+  | Some _ -> .
+;;
+
+let must_be_empty : t list -> unit = function
+  | [] -> ()
+  | _ :: _ -> .
+;;
+
+let must_be_ok : ('ok, t) Result.t -> 'ok = function
+  | Ok ok -> ok
+  | Error _ -> .
+;;
+
+let must_be_error : (t, 'err) Result.t -> 'err = function
+  | Ok _ -> .
+  | Error error -> error
+;;
+
+let must_be_first : ('first, t) Either.t -> 'first = function
+  | First first -> first
+  | Second _ -> .
+;;
+
+let must_be_second : (t, 'second) Either.t -> 'second = function
+  | First _ -> .
+  | Second second -> second
+;;
diff --git a/src/nothing.mli b/src/nothing.mli
index 94e2361..6ea891d 100644
--- a/src/nothing.mli
+++ b/src/nothing.mli
@@ -66,3 +66,23 @@ include Identifiable.S with type t := t
 
 include Ppx_compare_lib.Equal.S_local with type t := t
 include Ppx_compare_lib.Comparable.S_local with type t := t
+
+(** Ignores [None] and guarantees there is no [Some _]. A better replacement for
+    [ignore]. *)
+val must_be_none : t option -> unit
+
+(** Ignores [ [] ] and guarantees there is no [_ :: _]. A better replacement for
+    [ignore]. *)
+val must_be_empty : t list -> unit
+
+(** Returns [ok] from [Ok ok] and guarantees there is no [Error _]. *)
+val must_be_ok : ('ok, t) Result.t -> 'ok
+
+(** Returns [err] from [Error err] and guarantees there is no [Ok _]. *)
+val must_be_error : (t, 'err) Result.t -> 'err
+
+(** Returns [fst] from [First fst] and guarantees there is no [Second _]. *)
+val must_be_first : ('fst, t) Either.t -> 'fst
+
+(** Returns [snd] from [Second snd] and guarantees there is no [First _]. *)
+val must_be_second : (t, 'snd) Either.t -> 'snd
diff --git a/src/obj_local.ml b/src/obj_local.ml
index 6c1b86f..fcfdf05 100644
--- a/src/obj_local.ml
+++ b/src/obj_local.ml
@@ -7,6 +7,7 @@ external magic : (_[@local_opt]) -> (_[@local_opt]) = "%identity"
 external repr : (_[@local_opt]) -> (t[@local_opt]) = "%identity"
 external obj : (t[@local_opt]) -> (_[@local_opt]) = "%identity"
 external size : (t[@local_opt]) -> int = "%obj_size"
+external is_int : (t[@local_opt]) -> bool = "%obj_is_int"
 
 (* The result doesn't need to be marked local because the data is copied into a fresh
    nativeint block regardless. *)
@@ -20,3 +21,64 @@ external set_raw_field
   = "caml_obj_set_raw_field"
 
 external tag : (t[@local_opt]) -> int = "caml_obj_tag" [@@noalloc]
+
+(* This is unsafe in several ways:
+   - This cannot be called on an immediate
+   - This cannot be called on Javascript platform *)
+external get_header_unsafe : (t[@local_opt]) -> nativeint = "caml_get_header0"
+
+let color_of_header hd =
+  0x3 land Stdlib.Nativeint.to_int (Stdlib.Nativeint.shift_right_logical hd 8)
+;;
+
+type stack_or_heap =
+  | Immediate
+  | Stack
+  | Heap
+[@@deriving_inline sexp, compare]
+
+let stack_or_heap_of_sexp =
+  (let error_source__003_ = "obj_local.ml.stack_or_heap" in
+   function
+   | Sexplib0.Sexp.Atom ("immediate" | "Immediate") -> Immediate
+   | Sexplib0.Sexp.Atom ("stack" | "Stack") -> Stack
+   | Sexplib0.Sexp.Atom ("heap" | "Heap") -> Heap
+   | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("immediate" | "Immediate") :: _) as
+     sexp__004_ -> Sexplib0.Sexp_conv_error.stag_no_args error_source__003_ sexp__004_
+   | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("stack" | "Stack") :: _) as sexp__004_ ->
+     Sexplib0.Sexp_conv_error.stag_no_args error_source__003_ sexp__004_
+   | Sexplib0.Sexp.List (Sexplib0.Sexp.Atom ("heap" | "Heap") :: _) as sexp__004_ ->
+     Sexplib0.Sexp_conv_error.stag_no_args error_source__003_ sexp__004_
+   | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__002_ ->
+     Sexplib0.Sexp_conv_error.nested_list_invalid_sum error_source__003_ sexp__002_
+   | Sexplib0.Sexp.List [] as sexp__002_ ->
+     Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__003_ sexp__002_
+   | sexp__002_ -> Sexplib0.Sexp_conv_error.unexpected_stag error_source__003_ sexp__002_
+    : Sexplib0.Sexp.t -> stack_or_heap)
+;;
+
+let sexp_of_stack_or_heap =
+  (function
+   | Immediate -> Sexplib0.Sexp.Atom "Immediate"
+   | Stack -> Sexplib0.Sexp.Atom "Stack"
+   | Heap -> Sexplib0.Sexp.Atom "Heap"
+    : stack_or_heap -> Sexplib0.Sexp.t)
+;;
+
+let compare_stack_or_heap = (Stdlib.compare : stack_or_heap -> stack_or_heap -> int)
+
+[@@@end]
+
+let local_unmarked = 0x2
+
+let stack_or_heap repr =
+  if is_int repr
+  then Immediate
+  else (
+    match Sys.backend_type with
+    | Sys.Native ->
+      let hd = get_header_unsafe repr in
+      if color_of_header hd = local_unmarked then Stack else Heap
+    | Sys.Bytecode -> Heap
+    | Sys.Other _ -> Heap)
+;;
diff --git a/src/obj_local.mli b/src/obj_local.mli
index 1466d15..02fadb2 100644
--- a/src/obj_local.mli
+++ b/src/obj_local.mli
@@ -10,6 +10,7 @@ external repr : (_[@local_opt]) -> (t[@local_opt]) = "%identity"
 external obj : (t[@local_opt]) -> (_[@local_opt]) = "%identity"
 external raw_field : (t[@local_opt]) -> int -> raw_data = "caml_obj_raw_field"
 external size : (t[@local_opt]) -> int = "%obj_size"
+external is_int : (t[@local_opt]) -> bool = "%obj_is_int"
 
 external set_raw_field
   :  (t[@local_opt])
@@ -19,3 +20,18 @@ external set_raw_field
   = "caml_obj_set_raw_field"
 
 external tag : (t[@local_opt]) -> int = "caml_obj_tag" [@@noalloc]
+
+type stack_or_heap =
+  | Immediate
+  | Stack
+  | Heap
+[@@deriving_inline sexp, compare]
+
+val sexp_of_stack_or_heap : stack_or_heap -> Sexplib0.Sexp.t
+val stack_or_heap_of_sexp : Sexplib0.Sexp.t -> stack_or_heap
+val compare_stack_or_heap : stack_or_heap -> stack_or_heap -> int
+
+[@@@end]
+
+(** Checks if a value is immediate, stack-allocated, or heap-allocated. *)
+val stack_or_heap : (t[@local]) -> stack_or_heap
diff --git a/src/obj_stubs.c b/src/obj_stubs.c
new file mode 100644
index 0000000..5b400ef
--- /dev/null
+++ b/src/obj_stubs.c
@@ -0,0 +1,9 @@
+#include <caml/alloc.h>
+#include <caml/mlvalues.h>
+// only used for public release;
+// internally this is implemented as a compiler primitive
+CAMLprim value caml_get_header0(value blk) {
+  // undefined behaviour if blk is not a block
+  intnat r = Hd_val(blk);
+  return caml_copy_nativeint(r);
+}
diff --git a/src/runtime.js b/src/runtime.js
index dedd96e..bd1c8bd 100644
--- a/src/runtime.js
+++ b/src/runtime.js
@@ -19,7 +19,7 @@ function Base_caml_exn_is_most_recent_exn(x) {
 function Base_int_math_int32_clz(x) {
   var n = 32;
   var y;
-  y = x >>16; if (y != 0) { n = n -16; x = y; }
+  y = x >> 16; if (y != 0) { n = n - 16; x = y; }
   y = x >> 8; if (y != 0) { n = n - 8; x = y; }
   y = x >> 4; if (y != 0) { n = n - 4; x = y; }
   y = x >> 2; if (y != 0) { n = n - 2; x = y; }
@@ -41,9 +41,9 @@ function Base_int_math_int64_clz(x) {
   var n = 64;
   var y;
   y = caml_int64_shift_right_unsigned(x, 32);
-  if (!caml_int64_is_zero(y)) { n = n -32; x = y; }
+  if (!caml_int64_is_zero(y)) { n = n - 32; x = y; }
   y = caml_int64_shift_right_unsigned(x, 16);
-  if (!caml_int64_is_zero(y)) { n = n -16; x = y; }
+  if (!caml_int64_is_zero(y)) { n = n - 16; x = y; }
   y = caml_int64_shift_right_unsigned(x, 8);
   if (!caml_int64_is_zero(y)) { n = n - 8; x = y; }
   y = caml_int64_shift_right_unsigned(x, 4);
@@ -59,10 +59,10 @@ function Base_int_math_int64_clz(x) {
 function Base_int_math_int32_ctz(x) {
   if (x === 0) { return 32; }
   var n = 1;
-  if ( (x & 0x0000FFFF) === 0) { n = n + 16; x = x >> 16; }
-  if ( (x & 0x000000FF) === 0) { n = n +  8; x = x >>  8; }
-  if ( (x & 0x0000000F) === 0) { n = n +  4; x = x >>  4; }
-  if ( (x & 0x00000003) === 0) { n = n +  2; x = x >>  2; }
+  if ((x & 0x0000FFFF) === 0) { n = n + 16; x = x >> 16; }
+  if ((x & 0x000000FF) === 0) { n = n + 8; x = x >> 8; }
+  if ((x & 0x0000000F) === 0) { n = n + 4; x = x >> 4; }
+  if ((x & 0x00000003) === 0) { n = n + 2; x = x >> 2; }
   return n - (x & 1);
 }
 
@@ -80,9 +80,9 @@ function Base_int_math_nativeint_ctz(x) { return Base_int_math_int32_ctz(x); }
 function Base_int_math_int64_ctz(x) {
   if (caml_int64_is_zero(x)) { return 64; }
   var n = 1;
-  function is_zero (x)    { return caml_int64_is_zero(x); }
-  function land (x,y)     { return caml_int64_and(x, y); }
-  function small_int64(x) { return caml_int64_create_lo_mi_hi(x,0,0); }
+  function is_zero(x) { return caml_int64_is_zero(x); }
+  function land(x, y) { return caml_int64_and(x, y); }
+  function small_int64(x) { return caml_int64_create_lo_mi_hi(x, 0, 0); }
   if (is_zero(land(x, caml_int64_create_lo_mi_hi(0xFFFFFF, 0x0000FF, 0x0000)))) {
     n = n + 32; x = caml_int64_shift_right_unsigned(x, 32);
   }
@@ -90,13 +90,13 @@ function Base_int_math_int64_ctz(x) {
     n = n + 16; x = caml_int64_shift_right_unsigned(x, 16);
   }
   if (is_zero(land(x, small_int64(0x0000FF)))) {
-    n = n +  8; x = caml_int64_shift_right_unsigned(x, 8);
+    n = n + 8; x = caml_int64_shift_right_unsigned(x, 8);
   }
   if (is_zero(land(x, small_int64(0x00000F)))) {
-    n = n +  4; x = caml_int64_shift_right_unsigned(x, 4);
+    n = n + 4; x = caml_int64_shift_right_unsigned(x, 4);
   }
   if (is_zero(land(x, small_int64(0x000003)))) {
-    n = n +  2; x = caml_int64_shift_right_unsigned(x, 2);
+    n = n + 2; x = caml_int64_shift_right_unsigned(x, 2);
   }
   return n - (caml_int64_to_int32(caml_int64_and(x, small_int64(0x000001))));
 }
@@ -106,7 +106,7 @@ function Base_int_math_int_pow_stub(base, exponent) {
   var one = 1;
   var mul = [one, base, one, one];
   var res = one;
-  while (!exponent==0) {
+  while (!exponent == 0) {
     mul[1] = (mul[1] * mul[3]) | 0;
     mul[2] = (mul[1] * mul[1]) | 0;
     mul[3] = (mul[2] * mul[1]) | 0;
@@ -120,7 +120,7 @@ function Base_int_math_int_pow_stub(base, exponent) {
 //Requires: caml_int64_mul, caml_int64_is_zero, caml_int64_shift_right_unsigned
 //Requires: caml_int64_create_lo_hi, caml_int64_lo32
 function Base_int_math_int64_pow_stub(base, exponent) {
-  var one = caml_int64_create_lo_hi(1,0);
+  var one = caml_int64_create_lo_hi(1, 0);
   var mul = [one, base, one, one];
   var res = one;
   while (!caml_int64_is_zero(exponent)) {
@@ -136,12 +136,12 @@ function Base_int_math_int64_pow_stub(base, exponent) {
 //Provides: Base_hash_string mutable
 //Requires: caml_hash
 function Base_hash_string(s) {
-  return caml_hash(1,1,0,s)
+  return caml_hash(1, 1, 0, s)
 }
 //Provides: Base_hash_double const
 //Requires: caml_hash
 function Base_hash_double(d) {
-  return caml_hash(1,1,0,d);
+  return caml_hash(1, 1, 0, d);
 }
 
 //Provides: Base_am_testing const
@@ -152,34 +152,44 @@ function Base_am_testing(x) {
 
 //Provides: caml_csel_value
 function caml_csel_value(v_cond, v_true, v_false) {
-    if (v_cond)
-        return v_true;
-    else
-        return v_false;
+  if (v_cond)
+    return v_true;
+  else
+    return v_false;
 }
 
 //Provides: Base_unsafe_create_local_bytes
 //Requires: caml_create_bytes
 function Base_unsafe_create_local_bytes(v_len) {
-    // This does a redundant bounds check and (since this is
-    // javascript) doesn't allocate locally, but that's fine.
-    return caml_create_bytes(v_len);
+  // This does a redundant bounds check and (since this is
+  // javascript) doesn't allocate locally, but that's fine.
+  return caml_create_bytes(v_len);
 }
 
 //Provides: caml_make_local_vect
 //Requires: caml_make_vect
 function caml_make_local_vect(v_len, v_elt) {
-    // In javascript there's no local allocation.
-    return caml_make_vect (v_len, v_elt);
+  // In javascript there's no local allocation.
+  return caml_make_vect(v_len, v_elt);
 }
 
 
 //Provides: caml_float_min
-function caml_float_min(x,y) {
-    return x < y ? x : y;
+function caml_float_min(x, y) {
+  return x < y ? x : y;
 }
 
 //Provides: caml_float_max
 function caml_float_max(x, y) {
-    return x > y ? x : y;
+  return x > y ? x : y;
+}
+
+//Provides: caml_get_header0
+function caml_get_header0(x) {
+  throw new Error(`BUG: this function should be unreachable; please report to compiler or base devs.`);
+}
+
+//Provides: caml_get_header
+function caml_get_header(x) {
+  throw new Error(`BUG: this function should be unreachable; please report to compiler or base devs.`);
 }
diff --git a/src/sys0.ml b/src/sys0.ml
index 8fcb203..7d4b5d5 100644
--- a/src/sys0.ml
+++ b/src/sys0.ml
@@ -33,6 +33,11 @@ let ocaml_version = Stdlib.Sys.ocaml_version
 let enable_runtime_warnings = Stdlib.Sys.enable_runtime_warnings
 let runtime_warnings_enabled = Stdlib.Sys.runtime_warnings_enabled
 
+module Make_immediate64
+  (Imm : Stdlib.Sys.Immediate64.Immediate)
+  (Non_imm : Stdlib.Sys.Immediate64.Non_immediate) =
+  Stdlib.Sys.Immediate64.Make (Imm) (Non_imm)
+
 let getenv_exn var =
   try Stdlib.Sys.getenv var with
   | Stdlib.Not_found ->
diff --git a/test/test_map_comprehensive.ml b/test/test_map_comprehensive.ml
index 783f928..6702a2e 100644
--- a/test/test_map_comprehensive.ml
+++ b/test/test_map_comprehensive.ml
@@ -414,6 +414,8 @@ module Test_creators_and_accessors
   let of_list_with_key_or_error = of_list_with_key_or_error
   let of_list_with_key_exn = of_list_with_key_exn
   let of_list_with_key_multi = of_list_with_key_multi
+  let of_list_with_key_fold = of_list_with_key_fold
+  let of_list_with_key_reduce = of_list_with_key_reduce
 
   let%expect_test _ =
     quickcheck_m
@@ -440,6 +442,22 @@ module Test_creators_and_accessors
           [%here]
           (module Key_and_data_inst_multi)
           (create of_list_with_key_multi list ~get_key:fst)
+          (create of_alist_multi alist);
+        require_equal
+          [%here]
+          (module Key_and_data_inst_multi)
+          (create of_list_with_key_fold list ~get_key:fst ~init:[] ~f:(fun acc x ->
+             x :: acc)
+           |> map ~f:List.rev)
+          (create of_alist_multi alist);
+        require_equal
+          [%here]
+          (module Key_and_data_inst_multi)
+          (create
+             of_list_with_key_reduce
+             (List.map list ~f:List.return)
+             ~get_key:(fun x -> x |> List.hd_exn |> fst)
+             ~f:(fun x y -> x @ y))
           (create of_alist_multi alist));
     [%expect {| |}]
   ;;
diff --git a/test/test_obj_local.ml b/test/test_obj_local.ml
new file mode 100644
index 0000000..416a030
--- /dev/null
+++ b/test/test_obj_local.ml
@@ -0,0 +1,36 @@
+open! Import
+open! Exported_for_specific_uses.Obj_local
+
+(* immediate *)
+let%test_unit _ =
+  [%test_result: stack_or_heap]
+    (let x = 42 in
+     stack_or_heap (repr x))
+    ~expect:Immediate
+;;
+
+(* global*)
+let%test_unit _ =
+  [%test_result: stack_or_heap]
+    (let s = "hello" in
+     let _r = ref s in
+     stack_or_heap (repr s))
+    ~expect:Heap
+;;
+
+let stack_enabled =
+  match Sys.backend_type with
+  | Sys.Native -> true
+  | _ -> false
+;;
+
+(* local *)
+let%test_unit _ =
+  [%test_result: stack_or_heap]
+    (let foo x =
+       let s =  (ref x) in
+       stack_or_heap (repr s) [@nontail]
+     in
+     foo 42)
+    ~expect:(if stack_enabled then Stack else Heap)
+;;
diff --git a/test/test_obj_local.mli b/test/test_obj_local.mli
new file mode 100644
index 0000000..74bb729
--- /dev/null
+++ b/test/test_obj_local.mli
@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)