diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/.depend | 6 | ||||
| -rwxr-xr-x | stdlib/Makefile.shared | 5 | ||||
| -rw-r--r-- | stdlib/StdlibModules | 1 | ||||
| -rw-r--r-- | stdlib/camlinternalLazy.ml | 64 | ||||
| -rw-r--r-- | stdlib/camlinternalLazy.mli | 25 | ||||
| -rw-r--r-- | stdlib/lazy.ml | 40 | ||||
| -rw-r--r-- | stdlib/lazy.mli | 3 | ||||
| -rw-r--r-- | stdlib/stdlib.mllib | 1 |
8 files changed, 105 insertions, 40 deletions
diff --git a/stdlib/.depend b/stdlib/.depend index fc51ab117..a45db17de 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -1,3 +1,4 @@ +camlinternalLazy.cmi: obj.cmi camlinternalMod.cmi: obj.cmi camlinternalOO.cmi: obj.cmi format.cmi: buffer.cmi @@ -18,6 +19,7 @@ buffer.cmo: sys.cmi string.cmi buffer.cmi buffer.cmx: sys.cmx string.cmx buffer.cmi callback.cmo: obj.cmi callback.cmi callback.cmx: obj.cmx callback.cmi +camlinternalLazy.cmo: camlinternalLazy.cmi camlinternalMod.cmo: obj.cmi camlinternalOO.cmi array.cmi camlinternalMod.cmi camlinternalMod.cmx: obj.cmx camlinternalOO.cmx array.cmx camlinternalMod.cmi camlinternalOO.cmo: sys.cmi string.cmi obj.cmi map.cmi list.cmi char.cmi \ @@ -46,8 +48,8 @@ int32.cmo: pervasives.cmi int32.cmi int32.cmx: pervasives.cmx int32.cmi int64.cmo: pervasives.cmi int64.cmi int64.cmx: pervasives.cmx int64.cmi -lazy.cmo: obj.cmi lazy.cmi -lazy.cmx: obj.cmx lazy.cmi +lazy.cmo: obj.cmi camlinternalLazy.cmi lazy.cmi +lazy.cmx: obj.cmx camlinternalLazy.cmx lazy.cmi lexing.cmo: sys.cmi string.cmi array.cmi lexing.cmi lexing.cmx: sys.cmx string.cmx array.cmx lexing.cmi list.cmo: list.cmi diff --git a/stdlib/Makefile.shared b/stdlib/Makefile.shared index 02a986238..2440f1b9a 100755 --- a/stdlib/Makefile.shared +++ b/stdlib/Makefile.shared @@ -28,8 +28,9 @@ OTHERS=array.cmo list.cmo char.cmo string.cmo sys.cmo \ hashtbl.cmo sort.cmo marshal.cmo obj.cmo \ int32.cmo int64.cmo nativeint.cmo \ lexing.cmo parsing.cmo \ - set.cmo map.cmo stack.cmo queue.cmo lazy.cmo stream.cmo buffer.cmo \ - printf.cmo format.cmo scanf.cmo \ + set.cmo map.cmo stack.cmo queue.cmo \ + camlinternalLazy.cmo lazy.cmo stream.cmo \ + buffer.cmo printf.cmo format.cmo scanf.cmo \ arg.cmo printexc.cmo gc.cmo \ digest.cmo random.cmo callback.cmo \ camlinternalOO.cmo oo.cmo camlinternalMod.cmo \ diff --git a/stdlib/StdlibModules b/stdlib/StdlibModules index f9fec2d96..4f689f8c4 100644 --- a/stdlib/StdlibModules +++ b/stdlib/StdlibModules @@ -8,6 +8,7 @@ STDLIB_MODULES=\ arrayLabels \ buffer \ callback \ + camlinternalLazy \ camlinternalMod \ camlinternalOO \ char \ diff --git a/stdlib/camlinternalLazy.ml b/stdlib/camlinternalLazy.ml new file mode 100644 index 000000000..46cf42788 --- /dev/null +++ b/stdlib/camlinternalLazy.ml @@ -0,0 +1,64 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Damien Doligez, projet Para, INRIA Rocquencourt *) +(* *) +(* Copyright 1997 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file ../LICENSE. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Internals of forcing lazy values. *) + +exception Undefined;; + +let raise_undefined = Obj.repr (fun () -> raise Undefined);; + +(* Assume [blk] is a block with tag lazy *) +let force_lazy_block (blk : 'arg lazy_t) = + let closure = (Obj.obj (Obj.field (Obj.repr blk) 0) : unit -> 'arg) in + Obj.set_field (Obj.repr blk) 0 raise_undefined; + try + let result = closure () in + Obj.set_field (Obj.repr blk) 0 (Obj.repr result); (* do set_field BEFORE set_tag *) + Obj.set_tag (Obj.repr blk) Obj.forward_tag; + result + with e -> + Obj.set_field (Obj.repr blk) 0 (Obj.repr (fun () -> raise e)); + raise e +;; + +(* Assume [blk] is a block with tag lazy *) +let force_val_lazy_block (blk : 'arg lazy_t) = + let closure = (Obj.obj (Obj.field (Obj.repr blk) 0) : unit -> 'arg) in + Obj.set_field (Obj.repr blk) 0 raise_undefined; + let result = closure () in + Obj.set_field (Obj.repr blk) 0 (Obj.repr result); (* do set_field BEFORE set_tag *) + Obj.set_tag (Obj.repr blk) (Obj.forward_tag); + result +;; + +(* [force] is not used, since [Lazy.force] is declared as a primitive + whose code inlines the tag tests of its argument. This function is + here for the sake of completeness, and for debugging purpose. *) + +let force (lzv : 'arg lazy_t) = + let x = Obj.repr lzv in + let t = Obj.tag x in + if t = Obj.forward_tag then (Obj.obj (Obj.field x 0) : 'arg) else + if t <> Obj.lazy_tag then (Obj.obj x : 'arg) + else force_lazy_block lzv +;; + +let force_val (lzv : 'arg lazy_t) = + let x = Obj.repr lzv in + let t = Obj.tag x in + if t = Obj.forward_tag then (Obj.obj (Obj.field x 0) : 'arg) else + if t <> Obj.lazy_tag then (Obj.obj x : 'arg) + else force_val_lazy_block lzv +;; diff --git a/stdlib/camlinternalLazy.mli b/stdlib/camlinternalLazy.mli new file mode 100644 index 000000000..37b707d4f --- /dev/null +++ b/stdlib/camlinternalLazy.mli @@ -0,0 +1,25 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Damien Doligez, projet Para, INRIA Rocquencourt *) +(* *) +(* Copyright 1997 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file ../LICENSE. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Internals of forcing lazy values *) + +exception Undefined;; + +val force_lazy_block : 'a lazy_t -> 'a ;; + +val force_val_lazy_block : 'a lazy_t -> 'a ;; + +val force : 'a lazy_t -> 'a ;; +val force_val : 'a lazy_t -> 'a ;; 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 diff --git a/stdlib/lazy.mli b/stdlib/lazy.mli index afdb1e6d1..f0255c224 100644 --- a/stdlib/lazy.mli +++ b/stdlib/lazy.mli @@ -39,7 +39,8 @@ type 'a t = 'a lazy_t;; exception Undefined;; -val force : 'a t -> 'a;; +external force : 'a t -> 'a = "%lazy_force";; +(* val force : 'a t -> 'a ;; *) (** [force x] forces the suspension [x] and returns its result. If [x] has already been forced, [Lazy.force x] returns the same value again without recomputing it. If it raised an exception, diff --git a/stdlib/stdlib.mllib b/stdlib/stdlib.mllib index b3c6924f5..9f835c6fa 100644 --- a/stdlib/stdlib.mllib +++ b/stdlib/stdlib.mllib @@ -8,6 +8,7 @@ Array ArrayLabels Buffer Callback +CamlinternalLazy CamlinternalMod CamlinternalOO Char |