module GResult(Doc : sig val doc : Tree.t end) = struct
type bits
type elt = [` Tree] Tree.node
- external create_empty : int -> bits = "caml_result_set_create"
- external set : bits -> int -> unit = "caml_result_set_set"
- external next : bits -> int -> int = "caml_result_set_next"
- external count : bits -> int = "caml_result_set_count"
- external clear : bits -> elt -> elt -> unit = "caml_result_set_clear"
+ external create_empty : int -> bits = "caml_result_set_create" "noalloc"
+ external set : bits -> int -> unit = "caml_result_set_set" "noalloc"
+ external next : bits -> int -> int = "caml_result_set_next" "noalloc"
+ external count : bits -> int = "caml_result_set_count" "noalloc"
+ external clear : bits -> elt -> elt -> unit = "caml_result_set_clear" "noalloc"
- external set_tag_bits : bits -> Tag.t -> Tree.t -> elt -> elt = "caml_set_tag_bits"
+ external set_tag_bits : bits -> Tag.t -> Tree.t -> elt -> elt = "caml_set_tag_bits" "noalloc"
type t =
{ segments : elt list;
bits : bits;
(fun t _ -> eval_fold2_slist fl_list t (Tree.tag tree t) empty_res empty_res)
| _,`NIL -> (
match f_kind with
- |`TAG(tag') ->
+ (*|`TAG(tag') ->
let default = fun t _ -> eval_fold2_slist fl_list t (Tree.tag tree t) empty_res
(loop_tag tag' (first t) llist t )
- in
+ in default (*
let cf = SList.hd llist in
if (slot_size == 1) && StateSet.is_singleton cf
then
then
RS.mk_quick_tag_loop default llist 1 tree tag'
else default
- else default
+ else default *) *)
| _ ->
(fun t _ -> eval_fold2_slist fl_list t (Tree.tag tree t) empty_res
(loop (first t) llist t ))
| `NIL,_ -> (
match n_kind with
|`TAG(tag') ->
- (*if SList.equal rlist slist && tag == tag' then
+ if SList.equal rlist slist && tag == tag' then
let rec loop t ctx =
if t == Tree.nil then empty_res else
let res2 = loop (next t ctx) ctx in
eval_fold2_slist fl_list t tag res2 empty_res
in loop
- else *)
+ else
(fun t ctx -> eval_fold2_slist fl_list t (Tree.tag tree t)
(loop_tag tag' (next t ctx) rlist ctx ) empty_res)