simplify CCFun_vec by removing transients, for now

This commit is contained in:
Simon Cruanes 2018-03-06 23:08:02 -06:00
parent be76d6bf91
commit fe88bafe77
2 changed files with 24 additions and 33 deletions

View file

@ -18,6 +18,7 @@ type 'a gen = unit -> 'a option
type 'a printer = Format.formatter -> 'a -> unit type 'a printer = Format.formatter -> 'a -> unit
type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list] type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list]
(* TODO
(** {2 Transient IDs} *) (** {2 Transient IDs} *)
module Transient = struct module Transient = struct
type state = { mutable frozen: bool } type state = { mutable frozen: bool }
@ -39,17 +40,11 @@ module Transient = struct
raise e raise e
exception Frozen exception Frozen
end end
*)
(* TODO: move transient from A.t to 'a t, as nodes can be owned by a transient,
not arrays.
Then do mutable push, and use it for append/filter/flatten/flat_map *)
(* function array *) (* function array *)
module A = struct module A = struct
type 'a t = { type 'a t = 'a array
arr: 'a array;
id: Transient.t;
}
let length_log = 5 let length_log = 5
let max_length = 32 let max_length = 32
@ -57,35 +52,33 @@ module A = struct
let () = assert (max_length = 1 lsl length_log) let () = assert (max_length = 1 lsl length_log)
let length a = Array.length a.arr let length = Array.length
let iteri = Array.iteri
let fold = Array.fold_left
let create ~id = { arr= [| |]; id; } let create () = [| |]
let empty = {arr=[| |]; id=Transient.empty} let empty = [| |]
let is_empty a = length a = 0 let is_empty a = length a = 0
let return x = { arr=[| x |]; id=Transient.empty} let return x = [| x |]
let owns ~id a =
Transient.active id && Transient.equal id a.id
let get a i = let get a i =
if i<0 || i >= length a then invalid_arg "A.get"; if i<0 || i >= length a then invalid_arg "A.get";
Array.unsafe_get a.arr i Array.unsafe_get a i
(* push at the back *) (* push at the back *)
let push x a = let push x a =
let n = length a in let n = length a in
if n = max_length then invalid_arg "A.push"; if n = max_length then invalid_arg "A.push";
let arr = Array.make (n+1) x in let arr = Array.make (n+1) x in
Array.blit a.arr 0 arr 0 n; Array.blit a 0 arr 0 n;
{a with arr;} arr
let pop a = let pop a =
let n = length a in let n = length a in
if n=0 then invalid_arg "A.pop"; if n=0 then invalid_arg "A.pop";
let arr = Array.sub a.arr 0 (n-1) in Array.sub a 0 (n-1)
{a with arr}
let append a b = let append a b =
let n_a = length a in let n_a = length a in
@ -94,10 +87,10 @@ module A = struct
if n_a = 0 then b if n_a = 0 then b
else if n_b = 0 then a else if n_b = 0 then a
else ( else (
let arr = Array.make (n_a+n_b) (a.arr.(0)) in let arr = Array.make (n_a+n_b) (a.(0)) in
Array.blit a.arr 0 arr 0 n_a; Array.blit a 0 arr 0 n_a;
Array.blit b.arr 0 arr n_a n_b; Array.blit b 0 arr n_a n_b;
{id=Transient.empty; arr} arr
) )
let set ~mut a i x = let set ~mut a i x =
@ -105,22 +98,18 @@ module A = struct
if i=length a then ( if i=length a then (
(* insert in a longer copy *) (* insert in a longer copy *)
let arr = Array.make (i+1) x in let arr = Array.make (i+1) x in
Array.blit a.arr 0 arr 0 i; Array.blit a 0 arr 0 i;
{a with arr} arr
) else if mut then ( ) else if mut then (
(* replace element at [i] in place *) (* replace element at [i] in place *)
a.arr.(i) <- x; a.(i) <- x;
a a
) else ( ) else (
(* replace element at [i] in copy *) (* replace element at [i] in copy *)
let arr = Array.copy a.arr in let arr = Array.copy a in
arr.(i) <- x; arr.(i) <- x;
{a with arr} arr
) )
let iteri f a = Array.iteri f a.arr
let fold f acc a = Array.fold_left f acc a.arr
end end
(** {2 Functors} *) (** {2 Functors} *)

View file

@ -15,6 +15,7 @@ type 'a gen = unit -> 'a option
type 'a printer = Format.formatter -> 'a -> unit type 'a printer = Format.formatter -> 'a -> unit
type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list] type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list]
(* TODO: restore this
(** {2 Transient Identifiers} *) (** {2 Transient Identifiers} *)
module Transient : sig module Transient : sig
type t type t
@ -46,6 +47,7 @@ module Transient : sig
exception Frozen exception Frozen
(** Raised when a frozen ID is used. *) (** Raised when a frozen ID is used. *)
end end
*)
(** {2 Signature} *) (** {2 Signature} *)