/usr/x86_64-w64-mingw32/lib/ocaml/camlinternalLazy.ml is in ocaml-mingw-w64-x86-64 4.01.0~20140328-1build6.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | (***********************************************************************)
(* *)
(* OCaml *)
(* *)
(* 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. *)
(* *)
(***********************************************************************)
(* 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
(* do set_field BEFORE set_tag *)
Obj.set_field (Obj.repr blk) 0 (Obj.repr result);
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
(* do set_field BEFORE set_tag *)
Obj.set_field (Obj.repr blk) 0 (Obj.repr result);
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
;;
|