diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/future.ml | 14 | ||||
| -rw-r--r-- | lib/future.mli | 5 |
2 files changed, 17 insertions, 2 deletions
diff --git a/lib/future.ml b/lib/future.ml index 1e878ac32c..1f68061efe 100644 --- a/lib/future.ml +++ b/lib/future.ml @@ -191,3 +191,17 @@ let map2 ?greedy f x l = with Failure _ | Invalid_argument _ -> Errors.anomaly (Pp.str "Future.map2 length mismatch")) in f xi y) 0 l + +let print f kx = + let open Pp in + let (uid, _, x) = get kx in + let uid = + if UUID.equal uid UUID.invalid then str "[#]" + else str "[" ++ int uid ++ str "]" + in + match !x with + | Delegated _ -> str "Delegated" ++ uid + | Closure _ -> str "Closure" ++ uid + | Val (x, None) -> str "PureVal" ++ uid ++ spc () ++ hov 0 (f x) + | Val (x, Some _) -> str "StateVal" ++ uid ++ spc () ++ hov 0 (f x) + | Exn e -> str "Exn" ++ uid ++ spc () ++ hov 0 (str (Printexc.to_string e)) diff --git a/lib/future.mli b/lib/future.mli index 785b2df531..09d18ff269 100644 --- a/lib/future.mli +++ b/lib/future.mli @@ -143,9 +143,10 @@ val purify : ('a -> 'b) -> 'a -> 'b (* And also let a function alter the state but backtrack if it raises exn *) val transactify : ('a -> 'b) -> 'a -> 'b +(** Debug: print a computation given an inner printing function. *) +val print : ('a -> Pp.std_ppcmds) -> 'a computation -> Pp.std_ppcmds + (* These functions are needed to get rid of side effects. Thy are set for the outermos layer of the system, since they have to deal with the whole system state. *) val set_freeze : (unit -> Dyn.t) -> (Dyn.t -> unit) -> unit - - |