Source

ocaml-lazy-labelled / tests.ml

Full commit
open Ops
;

open Printf
;

value (lazy_rec_data : (Lazy.t 'a -> 'a) -> 'a) func =
  let rec lazy_self = lazy (func lazy_self)
  in
    try
      Lazy.force lazy_self
    with
    [ CamlinternalLazy.Undefined -> failwith
        "lazy_rec_data: reference to not constructed yet 'self'"
    ]
;

module StdLazy = Lazy
;

module Lazy = LazyLabelled.Make(struct type t = string; end)
;


type node_val =
  { name : string
  ; int_val : int
  }
;


type node 'a =
  { node_val : 'a
  ; links : list int
  }
and nodes 'a = array (node 'a)
;


value recdata construct =
  let res_ref = ref None in
  let get_res () =
    match res_ref.val with
    [ None -> failwith "recdata: not inited yet"
    | Some r -> r
    ]
  in
  let res = construct get_res in
  ( res_ref.val := Some res
  ; res
  )
;


value _closure_old func nodes =
  recdata
    (fun get_self ->
       Array.map
         (fun n ->
            lazy
              (
              let self = get_self () in
              List.fold_left
                (fun acc link ->
                   func acc (StdLazy.force self.(link))
                )
                n.node_val
                n.links
              )
         )
         nodes
    )
  >>
  Array.map StdLazy.force
;


value _closure_recdata_old func nodes =
  let lazyres =
  recdata
    (fun get_self ->
       Array.map
         (fun n ->
           { Lazy.l = n.node_val.name
           ; v = lazy
              (
              let self = get_self () in
              List.fold_left
                (fun acc link ->
                   func acc (Lazy.force self.(link))
                )
                n.node_val
                n.links
              )
           }
         )
         nodes
    )
  in
    Array.map Lazy.force lazyres
;


(* todo: lazy_rec_data -- to functor maybe. *)

value closure func nodes =
  let lazy_res =
    lazy_rec_data
      (fun lazy_self ->
         Array.map
           (fun n ->
             { Lazy.l = n.node_val.name
             ; v = lazy
                (
                let self = StdLazy.force lazy_self in
                List.fold_left
                  (fun acc link ->
                     func acc (Lazy.force self.(link))
                  )
                  n.node_val
                  n.links
                )
             }
           )
           nodes
      )
  in
    Array.map Lazy.force lazy_res
;


value sum nodes = closure
  (fun a b ->
     { int_val = a.int_val + b.int_val
     ; name = a.name ^ "+" ^ b.name
     }
  )
  nodes
;


value print_array a =
  printf "[| %s |]\n" &
    String.concat "; " &
    Array.to_list &
    Array.map (fun nv -> sprintf "%s=%i" nv.name nv.int_val) a
;

value do_test nodes =
  try
    print_array & sum nodes
  with
  [ Lazy.Cycle lst -> printf "cycle contains: %s.\n" &
      String.concat ", " lst
  ]
;


value test_gen testfunc arg exp =
  ( printf "Expected: %s\nGot     : %!" exp
  ; testfunc arg
  ; printf "\n%!"
  )
;


value test nodes exp =
  test_gen do_test nodes exp
;

value good_nodes =
  [| { node_val = { name = "A"; int_val = 1 }; links = [1; 2] }
   ; { node_val = { name = "B"; int_val = 2 }; links = [2] }
   ; { node_val = { name = "C"; int_val = 3 }; links = [] }
   |]
;

value bad_nodes =
  [| { node_val = { name = "A"; int_val = 1 }; links = [1; 2] }
   ; { node_val = { name = "B"; int_val = 2 }; links = [2] }
   ; { node_val = { name = "C"; int_val = 3 }; links = [1] }
   |]
;

value () = test good_nodes "[| A+B+C+C=9; B+C=5; C=3 |]"
;

value () = test bad_nodes "cycle contains: B, C."
;

(***********************************************************)

module Lstr = LazyLabelled.Make(struct type t = string; end);

value rec x = { Lstr.l = "X"; v = lazy (1 + Lstr.force x) }
;

value force_and_ignore x =
  try
    ignore & Lstr.force x
  with
  [ Lstr.Cycle c ->
      printf "cycle contains: %s.\n%!" &
        String.concat ", " c
  ]
;


value () = test_gen force_and_ignore x "cycle contains: X."
;