Implement Lazy.force as a primitive, and optimize its calls.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@8974 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 5 insertions, 35 deletions

diff --git a/stdlib/lazy.ml b/stdlib/lazy.ml
index 70acccd10..b1a9cbbda 100644
--- a/stdlib/lazy.ml
+++ b/stdlib/lazy.ml
@@ -46,46 +46,16 @@
 *)
 
 type 'a t = 'a lazy_t;;
-exception Undefined;;
 
-let raise_undefined = Obj.repr (fun () -> raise Undefined);;
+exception Undefined = CamlinternalLazy.Undefined;;
 
-external follow_forward : Obj.t -> 'a = "caml_lazy_follow_forward";;
 external make_forward : 'a -> 'a lazy_t = "caml_lazy_make_forward";;
 
-let force (l : 'arg t) =
-  let x = Obj.repr l in
-  let t = Obj.tag x in
-  if t = Obj.forward_tag then (follow_forward x : 'arg)
-  else if t <> Obj.lazy_tag then (Obj.obj x : 'arg)
-  else begin
-    let closure = (Obj.obj (Obj.field x 0) : unit -> 'arg) in
-    Obj.set_field x 0 raise_undefined;
-    try
-      let result = closure () in
-      Obj.set_field x 0 (Obj.repr result);  (* do set_field BEFORE set_tag *)
-      Obj.set_tag x Obj.forward_tag;
-      result
-    with e ->
-      Obj.set_field x 0 (Obj.repr (fun () -> raise e));
-      raise e
-  end
-;;
+external force : 'a t -> 'a = "%lazy_force";;
 
-let force_val (l : 'arg t) =
-  let x = Obj.repr l in
-  let t = Obj.tag x in
-  if t = Obj.forward_tag then (follow_forward x : 'arg)
-  else if t <> Obj.lazy_tag then (Obj.obj x : 'arg)
-  else begin
-    let closure = (Obj.obj (Obj.field x 0) : unit -> 'arg) in
-    Obj.set_field x 0 raise_undefined;
-    let result = closure () in
-    Obj.set_field x 0 (Obj.repr result);  (* do set_field BEFORE set_tag *)
-    Obj.set_tag x (Obj.forward_tag);
-    result
-  end
-;;
+(* let force = force;; *)
+
+let force_val = CamlinternalLazy.force_val;;
 
 let lazy_from_fun (f : unit -> 'arg) =
   let x = Obj.new_block Obj.lazy_tag 1 in