Source

ocaml-lazy-labelled / lazyLabelled.ml

(* License: GPL
   Author: Dmitry Grebeniuk gdsfh1 gmail com
*)

(* not thread-safe, like the original Lazy module. *)

module Make ( Label : sig type t; end )
 :
  sig

    type t 'a =
      { l : Label.t
      ; v : Lazy.t 'a
      }
    ;

    exception Cycle of list Label.t
    ;

    value force : t 'a -> 'a
    ;

    value rec_data : Label.t -> (t 'a -> 'a) -> 'a
    ;

  end
 =
  struct

    type t 'a =
      { l : Label.t
      ; v : Lazy.t 'a
      }
    ;

    exception Cycle of list Label.t
    ;

    value get_cycle ~vis =
      match vis with
      [ [] -> assert False
      | [now :: prevs] ->
          List.rev (inner ~acc:[now] ~prevs)
          where rec inner ~acc ~prevs =
            match prevs with
            [ [] -> assert False
            | [h :: t] ->
                if h == now
                then acc
                else inner ~acc:[h :: acc] ~prevs:t
            ]
      ]
(*
      (* for debugging: *)
      List.rev vis
*)
    ;

    value visited_labels_rev = ref []
    ;

    value force ll =
      let old_vis = visited_labels_rev.val in
      let () = visited_labels_rev.val :=
        [ll.l :: visited_labels_rev.val] in
      try
        let r = Lazy.force ll.v in
        ( visited_labels_rev.val := old_vis
        ; r
        )
      with
      [ CamlinternalLazy.Undefined ->
          let c = visited_labels_rev.val in
          ( visited_labels_rev.val := old_vis
          ; raise (Cycle (get_cycle ~vis:c))
          )
      | e ->
          ( visited_labels_rev.val := old_vis
          ; raise e
          )
      ]
    ;

    value (rec_data : Label.t -> (t 'a -> 'a) -> 'a) l func =
      let rec lazy_self = { l = l ; v = lazy (func lazy_self) }
      in
        force lazy_self
    ;

  end
;