lesson6.ml

(** Compilation *)
let showdir () =
  let entries = Sys.readdir (Sys.getcwd ()) in
  Array.sort compare entries ;

  Array.iter (fun name -> Printf.printf " - %s\n" name) entries ;
  Printf.printf "\n%!" ;
  ()

let () = showdir ()

(** Exceptions *)

let call f arg =
  try f arg
  with e ->
    Printf.printf "Oh ! An exception : %s\n%!" (Printexc.to_string e) ;
    raise e

let test_call () = call (fun x -> 5 / x) 0

type 'a result = Ok of 'a | Error of exn

let eval f arg = try Ok (f arg) with e -> Error e

let rec check_all f = function
  | [] -> true
  | (arg, res) :: others ->
    res = eval f arg && check_all f others


  
(** Effects *)
let calc x =
  Printf.printf "Computing x*x with x = %d\n%!" x ;
  x * x
    
(* Caching *)
let cache f =
  let memory = Hashtbl.create 20 in
  fun arg ->
    if Hashtbl.mem memory arg then Hashtbl.find memory arg
    else
      begin
        let res = f arg in
        Hashtbl.add memory arg res ;
        res
      end


let test_cache () =

  (* The "computing..." message is printed ten times. *)
  Printf.printf "\n I define l1:\n%!" ;  
  let l1 = List.map calc [ 3 ; 2 ; 2 ; 3 ; 1 ; 2 ; 3 ; 2 ; 2 ; 1 ] in

  (* The "computing..." message should be printed only three times. *)
  Printf.printf "\n I define l2:\n%!" ;  
  let l2 = List.map (cache calc) [ 3 ; 2 ; 2 ; 3 ; 1 ; 2 ; 3 ; 2 ; 2 ; 1 ] in

  (* Check that l1 equals l2 *)
  Printf.printf "l1 = l2 ? %b\n%!" (l1 = l2) ;
  ()
  
let () = test_cache ()
    
  
(* Laziness *)
type 'a tlazy =
  { mutable value: 'a option ;
    compute: (unit -> 'a) }

let flazy f = { value = None ;
                compute = f }

let arglazy f arg = flazy (fun () -> f arg)

let get_value laz =
  match laz.value with
  | Some v -> v
  | None ->
    let res = laz.compute () in
    laz.value <- Some res ;
    res

let intshow l = Printf.printf "Result = %d\n%!" (get_value l)

let test_lazy () =
  let laz1 = arglazy calc 1
  and laz2 = arglazy calc 2 in

  (* Only the first invocation prints the "computing..." message. *)
  intshow laz1 ;
  intshow laz1 ;
  intshow laz1 ;

  (* Only the first invocation prints the "computing..." message. *)
  intshow laz2 ;
  intshow laz2 ;
  intshow laz2 ;

  ()

let () = test_lazy ()


let rec mklazylist acu n =
  if n = 0 then acu
  else mklazylist ((n, arglazy calc n) :: acu) (n-1)

let lazylist = mklazylist [] 100

let choose n biglist = get_value (List.assoc n biglist)