Merge pull request #66 from CraigFe/allocation-microoptimisations

Add memory microoptimisations

src/repr/type_binary.ml

@@ -96,17 +96,30 @@ module Encode = struct
 
   let bytes boxed = if boxed then boxed_bytes else unboxed_bytes
 
-  let list l n =
-    let l = unstage l in
-    stage (fun x k ->
-        len n (List.length x) k;
-        List.iter (fun e -> l e k) x)
-
-  let array l n =
-    let l = unstage l in
-    stage (fun x k ->
-        len n (Array.length x) k;
-        Array.iter (fun e -> l e k) x)
+  let list =
+    let rec encode_elements encode_elt k = function
+      | [] -> ()
+      | x :: xs ->
+          encode_elt x k;
+          (encode_elements [@tailcall]) encode_elt k xs
+    in
+    fun l n ->
+      let l = unstage l in
+      stage (fun x k ->
+          len n (List.length x) k;
+          encode_elements l k x)
+
+  let array =
+    let encode_elements encode_elt k arr =
+      for i = 0 to Array.length arr - 1 do
+        encode_elt (Array.unsafe_get arr i) k
+      done
+    in
+    fun l n ->
+      let l = unstage l in
+      stage (fun x k ->
+          len n (Array.length x) k;
+          encode_elements l k x)
 
   let pair a b =
     let a = unstage a and b = unstage b in

src/repr/type_core.ml

@@ -132,8 +132,7 @@ let fold_variant :
           | _ -> assert false)
       | CV1 ({ ctag1; cwit1; _ }, v) -> (
           match cases.(ctag1) with
-          | Dispatch.Arrow { f; arg_wit } -> (
-              match Witness.cast cwit1 arg_wit v with
-              | Some v -> unstage f v
-              | None -> assert false)
+          | Dispatch.Arrow { f; arg_wit } ->
+              let v = Witness.cast_exn cwit1 arg_wit v in
+              unstage f v
           | _ -> assert false))

src/repr/witness.ml

@@ -35,5 +35,16 @@ let make : type a. unit -> a t =
 let eq : type a b. a t -> b t -> (a, b) eq option =
  fun (module A) (module B) -> match A.Eq with B.Eq -> Some Refl | _ -> None
 
+let eq_exn : type a b. a t -> b t -> (a, b) eq =
+ fun (module A) (module B) ->
+  match A.Eq with
+  | B.Eq -> Refl
+  | _ -> failwith "Repr.internal_error: unexpected runtime type inequality"
+
 let cast : type a b. a t -> b t -> a -> b option =
  fun awit bwit a -> match eq awit bwit with Some Refl -> Some a | None -> None
+
+let cast_exn : type a b. a t -> b t -> a -> b =
+ fun awit bwit a ->
+  let Refl = eq_exn awit bwit in
+  a

src/repr/witness.mli

@@ -19,4 +19,6 @@ type 'a t
 
 val make : unit -> 'a t
 val eq : 'a t -> 'b t -> ('a, 'b) eq option
+val eq_exn : 'a t -> 'b t -> ('a, 'b) eq
 val cast : 'a t -> 'b t -> 'a -> 'b option
+val cast_exn : 'a t -> 'b t -> 'a -> 'b