Caml1999I0378(,Stdlib__Lazy!t ;!a@@A@A0CamlinternalLazy!t@@@ޠY@@@@@(lazy.mliRVVRVw@@@@@@A@ )Undefined!##exnG@@@A&_none_@@A@*A@B@%force"@1!a@@@@@@+%lazy_forceAA @@@'A X X(A X @@CB@@#map#@@!a@!b@@@@% @@@) @@@@@@@@FL  GL  @@bC@@&is_val$@8!a@@@@$boolE@@@@@@_W`W@@{D@@(from_val%@!a@U@@@@@@r\LLs\Le@@E@@'map_val&@@!a@!b@@@@p @@@t @@@@@@@@cjjcj@@F@@(from_fun'@@$unitF@@@!a@@@@@@@@@yqqyq@@G@@)force_val(@!a@@@@@@@@@H@@@N>,Stdlib__Lazy0* -S$.)"0D&Stdlib0Lku]8_٠0CamlinternalLazy0&͂7 Pˆ8CamlinternalFormatBasics0%FU(Q/Tu@@@Caml1999T037BaC,Stdlib__Lazy*ocaml.text&_none_@@A8 Deferred computations. (lazy.mliP77P7T@@@@@@3@@@@@@#intA;@@@A@@@@@:@A@$charB;@@A@@@@@>@A@&stringQ;@@ A@@@@@B@@@%bytesC;@@ A@@@@@F@@@%floatD;@@A@@@@@J@@@$boolE;@@%falsec@@T@$trued@@Z@@@A@@@@@[@A@$unitF;@@"()e@@e@@@A@@@@@f@A@ #exnG;@@@A@@@@@j@@@#effH;@@O@A@A@@@@@@s@@@,continuationI;@@Q@@P@B@A@nY@@@@@@@@@%arrayJ;@@R@A@A@@@@@@@@@ $listK;@@S@A"[]f@@@"::g@@@T@@@ @@A@Y@@@@@@@@&optionL;@@V@A$Noneh@@@$Somei@@@@@A@Y@@@@@@@@)nativeintM;@@A@@@@@@@@%int32N;@@A@@@@@@@@%int64O;@@A@@@@@@@@&lazy_tP;@@X@AJA@Y@@@@@@@@5extension_constructorR;@@A@@@@@@@@*floatarrayS;@@A@@@@@@@@&iarrayT;@@Y@A[A@Y@@@@@@@@*atomic_locU;@@Z@AdA@@@@@@@@@.Assert_failure`#@@@@@J@@@@@@@@[@@A=ocaml.warn_on_literal_pattern @ @0Division_by_zero]#@@@A  @+End_of_file\#$@@@A@'FailureY#,@'@@A!$$@0Invalid_argumentX#5@0@@A*$-#-@-Match_failureV#>@@=@9@;@@a@@A;5>4>@)Not_foundZ#O@@@AC=F<F@-Out_of_memoryW#W@@@AKENDN@.Stack_overflow^#_@@@ASMVLV@.Sys_blocked_io_#g@@@A[U^T^@)Sys_error[#o@j@@Ad^g]g@:Undefined_recursive_modulea#x@@w@s@u@@h@@Auoxnx@:Continuation_already_takenb#@@@A}wv@&Stdlib@AxA+!tARV^RV_@А!a@3@;@@@A@A@@@@@@G@B@@@RVVRVw@)ocaml.doc  A value of type ['a Lazy.t] is a deferred computation, called a suspension, that has a result of type ['a]. The special expression syntax [lazy (expr)] makes a suspension of the computation of [expr], without computing [expr] itself yet. "Forcing" the suspension will then compute [expr] and return its result. Matching a suspension with the special pattern syntax [lazy(pattern)] also computes the underlying expression and tries to bind it to [pattern]: {[ let lazy_option_map f x = match x with | lazy (Some x) -> Some (Lazy.force f x) | _ -> None ]} Note: If lazy patterns appear in multiple cases in a pattern-matching, lazy expressions may be forced even outside of the case ultimately selected by the pattern matching. In the example above, the suspension [x] is always computed. Note: [lazy_t] is the built-in type constructor used by the compiler for the [lazy] keyword. You should not use it directly. Always use [Lazy.t] instead. Note: [Lazy.force] is not concurrency-safe. If you use this module with multiple fibers, systhreads or domains, then you will need to add some locks. The module however ensures memory-safety, and hence, concurrently accessing this module will not lead to a crash but the behaviour is unspecified. Note: if the program is compiled with the [-rectypes] option, ill-founded recursive definitions of the form [let rec x = lazy x] or [let rec x = lazy(lazy(...(lazy x)))] are accepted by the type-checker and lead, when forced, to ill-formed values that trigger infinite loops in the garbage collector and other parts of the run-time system. Without the [-rectypes] option, such ill-founded recursive definitions are rejected by the type-checker. Sxxx  @@@@@@@@@@@@ARV[RV]@@BA@;0@A@A0CamlinternalLazy!t@@@=퐠<;@;;@@@;@;@@KJ@)UndefinedB{  {  @#@@@A{  @X Raised when forcing a suspension concurrently from multiple fibers, systhreads or domains, or when the suspension tries to force itself recursively. |   T V@@@@@@@A@@@@i@@@@@@@3@a@A $@%forceA X a A X f@б@г!t*A X l+A X m@А!a@C@321122222@"IC@A8A X i9A X k@@@ @@@ @@А!a CA X qDA X s@@@ @@@@+%lazy_forceAA @@@OA X XPA X @  [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, the same exception is raised again. @raise Undefined (see {!Undefined}). ]B  ^H  @@@@@@@vB@@@r@@@@@@8/ {1 Iterators} |J  }J  @@@@@@3{zz{{{{{@Je8@A#mapL  L  @б@б@А!a@C@L  L  @@А!b@C@#L  L  @@@ @@(@@б@г0!tL  L  @А!a%8L  L  @@@+@@@? @@гE!tL  L  @А!b/ML  L  @@@5@@@T @@@@@W@@@4@@ZL  @@@L  @= [map f x] returns a suspension that, when forced, forces [x] and applies [f] to its value. It is equivalent to [lazy (f (Lazy.force x))]. @since 4.13 M  S@@@@@@@C@@'@M@@@@@@z  - {1 Reasoning on already-forced suspensions} UU@@@@@@3@1@A&is_valWW@б@г!tWW@А!a@C@ *W+W@@@ @@@'@@г$bool8W9W@@ @@@4@@@@@7@@@CW @ n [is_val x] returns [true] if [x] has already been forced and did not raise an exception. @since 4.00 PXQZ8J@@@@@@@iD@@@d@@@@@@V(from_valg\LPh\LX@б@А!a@C@3pooppppp@kf4@Av\L[w\L]@@г!t\Ld\Le@А!a\La\Lc@@@@@@ @@@!@@@@@\LL@󐠠 [from_val v] evaluates [v] first (as any function would) and returns an already-forced suspension of its result. It is the same as [let x = v in lazy x], but uses dynamic tests to optimize suspension creation in some cases. @since 4.00 ]ffaVh@@@@@@@E@@#@@@@@@@;'map_valcjncju@б@б@А!a@ C@3@Rc6@Acjycj{@@А!b@ C@ cjcj@@@ @@@@б@г`!tcjcj@А!a'"cjcj@@@-@@@) @@гu!tcjcj@А!b/7cjcj@@@5@@@> @@@@@A@@@4@@D cjx@@@ cjj@m 0 [map_val f x] applies [f] directly if [x] is already forced, otherwise it behaves as [map f x]. When [x] is already forced, this behavior saves the construction of a suspension, but on the other hand it performs more work eagerly that may not be useful if you never force the function result. If [f] raises an exception, it will be raised immediately when [is_val x], or raised only when forcing the thunk otherwise. If [map_val f x] does not raise an exception, then [is_val (map_val f x)] is equal to [is_val x]. @since 4.13 dq@@@@@@@2F@@'@}-@@@@@@d;: {1 Advanced} The following definitions are for advanced uses only; they require familiarity with the lazy compilation scheme to be used appropriately. 7t8w#o@@@@@@365566666@v1@A(from_funCyquDyq}@б@б@г$unitPyqQyq@@ @@@ @@А!a@C@%_yq`yq@@@ @@*@@г렐!tkyqlyq@А!a8ryqsyq@@@@@@? @@@@@B|yq@@@yqq@  [from_fun f] is the same as [lazy (f ())] but slightly more efficient. It should only be used if the function [f] is already defined. In particular it is always less efficient to write [from_fun (fun () -> expr)] than [lazy expr]. @since 4.00 z@@@@@@@G@@$@@@@@@@b)force_val@б@г.!t@А!a@C@3@|>@A@@@ @@@ @@А!a @@@ @@@@@@/  [force_val x] forces the suspension [x] and returns its result. If [x] has already been forced, [force_val x] returns the same value again without recomputing it. If the computation of [x] raises an exception, it is unspecified whether [force_val x] raises the same exception or {!Undefined}. @raise Undefined if the forcing of [x] tries to force [x] itself recursively. @raise Undefined (see {!Undefined}). xz@@@@@@@H@@@?@@@@@@1@p7A@B@@n@@f@F@}@]0@@3@D_2@A@ H************************************************************************A@@A@L@ H BMM BM@ H OCaml CC@ H DD3@ H Damien Doligez, projet Para, INRIA Rocquencourt E44E4@ H  F!F@ H Copyright 1997 Institut National de Recherche en Informatique et &G'G@ H en Automatique. ,H-Hg@ H 2Ihh3Ih@ H All rights reserved. This file is distributed under the terms of 8J9J@ H the GNU Lesser General Public License version 2.1, with the >K?KN@ H special exception on linking described in the file LICENSE. DLOOELO@ H JMKM@ H************************************************************************PNQN5@9* Deferred computations. V  * A value of type ['a Lazy.t] is a deferred computation, called a suspension, that has a result of type ['a]. The special expression syntax [lazy (expr)] makes a suspension of the computation of [expr], without computing [expr] itself yet. "Forcing" the suspension will then compute [expr] and return its result. Matching a suspension with the special pattern syntax [lazy(pattern)] also computes the underlying expression and tries to bind it to [pattern]: {[ let lazy_option_map f x = match x with | lazy (Some x) -> Some (Lazy.force f x) | _ -> None ]} Note: If lazy patterns appear in multiple cases in a pattern-matching, lazy expressions may be forced even outside of the case ultimately selected by the pattern matching. In the example above, the suspension [x] is always computed. Note: [lazy_t] is the built-in type constructor used by the compiler for the [lazy] keyword. You should not use it directly. Always use [Lazy.t] instead. Note: [Lazy.force] is not concurrency-safe. If you use this module with multiple fibers, systhreads or domains, then you will need to add some locks. The module however ensures memory-safety, and hence, concurrently accessing this module will not lead to a crash but the behaviour is unspecified. Note: if the program is compiled with the [-rectypes] option, ill-founded recursive definitions of the form [let rec x = lazy x] or [let rec x = lazy(lazy(...(lazy x)))] are accepted by the type-checker and lead, when forced, to ill-formed values that trigger infinite loops in the garbage collector and other parts of the run-time system. Without the [-rectypes] option, such ill-founded recursive definitions are rejected by the type-checker.  * Raised when forcing a suspension concurrently from multiple fibers, systhreads or domains, or when the suspension tries to force itself recursively. X * [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, the same exception is raised again. @raise Undefined (see {!Undefined}). 0* {1 Iterators} 栠 * [map f x] returns a suspension that, when forced, forces [x] and applies [f] to its value. It is equivalent to [lazy (f (Lazy.force x))]. @since 4.13 | .* {1 Reasoning on already-forced suspensions} a o* [is_val x] returns [true] if [x] has already been forced and did not raise an exception. @since 4.00  * [from_val v] evaluates [v] first (as any function would) and returns an already-forced suspension of its result. It is the same as [let x = v in lazy x], but uses dynamic tests to optimize suspension creation in some cases. @since 4.00 Ϡ 1* [map_val f x] applies [f] directly if [x] is already forced, otherwise it behaves as [map f x]. When [x] is already forced, this behavior saves the construction of a suspension, but on the other hand it performs more work eagerly that may not be useful if you never force the function result. If [f] raises an exception, it will be raised immediately when [is_val x], or raised only when forcing the thunk otherwise. If [map_val f x] does not raise an exception, then [is_val (map_val f x)] is equal to [is_val x]. @since 4.13 X * {1 Advanced} The following definitions are for advanced uses only; they require familiarity with the lazy compilation scheme to be used appropriately. = * [from_fun f] is the same as [lazy (f ())] but slightly more efficient. It should only be used if the function [f] is already defined. In particular it is always less efficient to write [from_fun (fun () -> expr)] than [lazy expr]. @since 4.00 렠 * [force_val x] forces the suspension [x] and returns its result. If [x] has already been forced, [force_val x] returns the same value again without recomputing it. If the computation of [x] raises an exception, it is unspecified whether [force_val x] raises the same exception or {!Undefined}. @raise Undefined if the forcing of [x] tries to force [x] itself recursively. @raise Undefined (see {!Undefined}). @?)../ocamlc0-strict-sequence(-absname"-w5+a-4-9-41-42-44-45-48"-g+-warn-error"+A*-bin-annot)-nostdlib*-principal"-o0stdlib__Lazy.cmi"-c D/builds/workspace/precheck/flambda/false/label/ocaml-linux-32/stdlib @@0{Nтc<