(********* Exercice 1 *********) type 'a frozen_flow = | End of 'a | Step of (unit -> 'a frozen_flow);; let ppcm x y = let rec ppcm_rec x y mul = if (y > x) then (ppcm_rec y x mul) else (* Ensures x >= y *) if (x = 0) then 0 else (* Ensures both are positive *) let r = (x mod y) in if (r = 0) then (mul/y) else ppcm_rec y r mul in ppcm_rec x y (x*y);; type ('key,'data) frozen_data_flow = | End of 'data | Step of (unit -> (('key*'data) list) * ('key,'data) frozen_data_flow);; (********* Exercice 2 *********) let f = lazy ( 1/0 );; (* int lazy_t = *) Lazy.force f;; (********* Exercice 3 *********) type 'a stm = | StmEmpty | StmCons of ('a * 'a stm) lazy_t let rec length_evaluated stm = match stm with | StmEmpty -> 0 | StmCons(x) -> if not(Lazy.is_val x) then 0 else let (_,v) = Lazy.force x in 1 + length_evaluated v;; (********* Exercice 4 *********) type 'a tree = TmEmpty | TmCons of ('a * 'a tree list) (* Builds the list of integers [a,a+1,..,b-1] *) let rec list_build a b = if (a>=b) then [] else a::(list_build (a+1) b);; (* Builds a tree with a generating function f, depth n and top node start *) (* tree_build : ('a -> 'a list) -> int -> 'a -> 'a tree *) let rec tree_build f n start = let nodel = f start in let treel = if (n<=0) then [] else List.map (tree_build f (n-1)) nodel in TmCons (start, treel);; (* Builds a tree of integers of depth d and branching k *) let tree_interv k d = tree_build (fun x -> list_build (k*x-k+2) (k*x+2)) d 1;; let rec tree_to_string t = match t with | TmEmpty -> "" | TmCons(x,xs) -> if (xs = []) then string_of_int x else let ss = String.concat "," (List.map tree_to_string xs) in (string_of_int x)^"["^ss^"]";; tree_to_string (tree_interv 2 3);; type 'a stm = StmEmpty | StmCons of ('a * 'a stm) lazy_t type 'a lazytree = LTEmpty | LTCons of ('a lazy_t) * (('a lazytree) stm) let rec fun_to_stream_bounded f x n = if (n=0) then StmEmpty else StmCons (lazy (x, fun_to_stream_bounded f (f x) (n-1)));; let rec stm_map f stm = match stm with | StmEmpty -> StmEmpty | StmCons(x) -> StmCons(lazy( let (u,v) = Lazy.force x in (f u, stm_map f v)));; let rec stm_to_list stm = match stm with | StmEmpty -> [] | StmCons(lazy(u,s)) -> u::(stm_to_list s);;