1997-10-14 06:29:58 -07:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* Objective Caml *)
|
|
|
|
(* *)
|
|
|
|
(* Damien Doligez, projet Para, INRIA Rocquencourt *)
|
|
|
|
(* *)
|
1997-10-22 06:26:05 -07:00
|
|
|
(* Copyright 1997 Institut National de Recherche en Informatique et *)
|
1999-11-17 10:59:06 -08:00
|
|
|
(* en Automatique. All rights reserved. This file is distributed *)
|
2001-12-07 05:41:02 -08:00
|
|
|
(* under the terms of the GNU Library General Public License, with *)
|
|
|
|
(* the special exception on linking described in file ../LICENSE. *)
|
1997-10-14 06:29:58 -07:00
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
(* $Id$ *)
|
|
|
|
|
2001-10-26 15:38:48 -07:00
|
|
|
(** Deferred computations. *)
|
1997-10-14 06:29:58 -07:00
|
|
|
|
2001-12-03 14:01:28 -08:00
|
|
|
type 'a status =
|
|
|
|
Delayed of (unit -> 'a)
|
|
|
|
| Value of 'a
|
1997-10-22 06:26:05 -07:00
|
|
|
| Exception of exn
|
1997-10-14 06:29:58 -07:00
|
|
|
|
2001-12-03 14:01:28 -08:00
|
|
|
type 'a t = 'a status ref
|
2001-10-26 15:38:48 -07:00
|
|
|
(** A value of type ['a Lazy.t] is a deferred computation (also called a
|
1997-10-22 06:26:05 -07:00
|
|
|
suspension) that computes a result of type ['a]. The expression
|
2001-10-26 15:38:48 -07:00
|
|
|
[lazy (expr)] returns a suspension that computes [expr]. **)
|
|
|
|
|
1997-10-14 06:29:58 -07:00
|
|
|
|
2001-12-03 14:01:28 -08:00
|
|
|
exception Undefined
|
2000-01-07 11:18:34 -08:00
|
|
|
|
2001-12-03 14:01:28 -08:00
|
|
|
val force : 'a t -> 'a
|
2001-10-26 15:38:48 -07:00
|
|
|
(** [Lazy.force x] computes the suspension [x] and returns its result.
|
1997-10-22 06:26:05 -07:00
|
|
|
If the suspension was already computed, [Lazy.force x] returns the
|
|
|
|
same value again. If it raised an exception, the same exception is
|
|
|
|
raised again.
|
2000-01-07 11:18:34 -08:00
|
|
|
Raise [Undefined] if the evaluation of the suspension requires its
|
|
|
|
own result.
|
1997-10-14 06:29:58 -07:00
|
|
|
*)
|
2001-10-26 15:38:48 -07:00
|
|
|
|