1(**************************************************************************) 2(* *) 3(* OCaml *) 4(* *) 5(* Damien Doligez, projet Para, INRIA Rocquencourt *) 6(* *) 7(* Copyright 1997 Institut National de Recherche en Informatique et *) 8(* en Automatique. *) 9(* *) 10(* All rights reserved. This file is distributed under the terms of *) 11(* the GNU Lesser General Public License version 2.1, with the *) 12(* special exception on linking described in the file LICENSE. *) 13(* *) 14(**************************************************************************) 15 16(* Module [Lazy]: deferred computations *) 17 18 19(* 20 WARNING: some purple magic is going on here. Do not take this file 21 as an example of how to program in OCaml. 22*) 23 24 25(* We make use of two special tags provided by the runtime: 26 [lazy_tag] and [forward_tag]. 27 28 A value of type ['a Lazy.t] can be one of three things: 29 1. A block of size 1 with tag [lazy_tag]. Its field is a closure of 30 type [unit -> 'a] that computes the value. 31 2. A block of size 1 with tag [forward_tag]. Its field is the value 32 of type ['a] that was computed. 33 3. Anything else except a float. This has type ['a] and is the value 34 that was computed. 35 Exceptions are stored in format (1). 36 The GC will magically change things from (2) to (3) according to its 37 fancy. 38 39 We cannot use representation (3) for a [float Lazy.t] because 40 [caml_make_array] assumes that only a [float] value can have tag 41 [Double_tag]. 42 43 We have to use the built-in type constructor [lazy_t] to 44 let the compiler implement the special typing and compilation 45 rules for the [lazy] keyword. 46*) 47 48type 'a t = 'a lazy_t 49 50exception Undefined = CamlinternalLazy.Undefined 51 52external make_forward : 'a -> 'a lazy_t = "caml_lazy_make_forward" 53 54external force : 'a t -> 'a = "%lazy_force" 55 56(* let force = force *) 57 58let force_val = CamlinternalLazy.force_val 59 60let from_fun (f : unit -> 'arg) = 61 let x = Obj.new_block Obj.lazy_tag 1 in 62 Obj.set_field x 0 (Obj.repr f); 63 (Obj.obj x : 'arg t) 64 65 66let from_val (v : 'arg) = 67 let t = Obj.tag (Obj.repr v) in 68 if t = Obj.forward_tag || t = Obj.lazy_tag || t = Obj.double_tag then begin 69 make_forward v 70 end else begin 71 (Obj.magic v : 'arg t) 72 end 73 74 75let is_val (l : 'arg t) = Obj.tag (Obj.repr l) <> Obj.lazy_tag 76 77let lazy_from_fun = from_fun 78 79let lazy_from_val = from_val 80 81let lazy_is_val = is_val 82