(* CSE P505 Final Exam, Autumn 2016 *) (********* Provided Code (Do Not Change) **************) exception Unimplemented exception Not_found module List = let assoc key l = try List.pick (fun (k,v) -> if k = key then Some v else None) l with :? System.Collections.Generic.KeyNotFoundException -> raise Not_found let for_all2 = List.forall2 type coin = Quarter | Dime | Nickel | Penny (* (num_quarters, num_dimes, num_nickels, num_pennies) For example (3,4,0,2) represents "3 quarters, 4 dimes, and 2 pennies". *) type money = int * int * int * int let value_of_money (q,d,n,p) = 25 * q + 10 * d + 5 * n + p (* you don't need this anywhere, but it helps explains what a value of type money represents *) let rec money_of_coinlist coins = match coins with [] -> (0,0,0,0) | c::cs -> let (q,d,n,p) = money_of_coinlist cs in match c with Quarter -> (q+1,d,n,p) | Dime -> (q,d+1,n,p) | Nickel -> (q,d,n+1,p) | Penny -> (q,d,n,p+1) (* You can see how split_money is used in a provided case of Problem 2 *) let split_money v (q,d,n,p) = let f q1 = let v = v - 25 * q1 in let d1 = min d (v / 10) in let v = v - 10 * d1 in let n1 = min n (v / 5) in let v = v - 5 * n1 in let p1 = min p v in let v = v - p1 in if v = 0 then Some ((q1,d1,n1,p1), (q - q1, d - d1, n - n1, p - p1)) else None in match f (min q (v / 25)) with Some (m1,m2) -> Some (m1,m2) | None -> f (min q (v / 25 - 1)) (********** Problem 1 ***************) (* Put your function here *) (********** Problem 2 ***************) exception InterpFailure type coin_exp = MoneyConst of money | Var of string | CombineMoney of coin_exp * coin_exp | RemoveCoin of coin_exp * coin (* fail if none of coin present *) | HalfValue of coin_exp (* fail if cannot split by half *) | ReplacePennies of coin_exp (* never fails unless subexp fails *) type heap = (string * money) list let lookup h s = try List.assoc s h with Not_found -> raise InterpFailure (* they write most of this *) let rec interp_large_coin_exp heap exp = match exp with MoneyConst (q,d,n,p) -> if q<0 || d<0 || n<0 || p<0 then raise InterpFailure else (q,d,n,p) | Var s -> lookup heap s | HalfValue e -> let m = interp_large_coin_exp heap e in let v = value_of_money m in if v % 2 = 1 then raise InterpFailure else (match split_money (v / 2) m with Some (m1,m2) -> m1 | None -> raise InterpFailure) | _ -> raise Unimplemented (********** Problem 3 ***************) (* You say money doesn't grow on trees? Well what about this: :-) *) type money_tree = Leaf of coin | Node of coin * money_tree * money_tree let rec all_coins_tree f t = (* do not change *) match t with Leaf c -> f c | Node (c,t1,t2) -> f c && all_coins_tree f t1 && all_coins_tree f t2 let penniless : money_tree -> bool = raise Unimplemented let rec all_coins_tree_cps f t k = raise Unimplemented let penniless2 t = raise Unimplemented (************** Problem 4 **************) (* About formal semantics -- put your answers in another file *) (************** Problem 5 **************) exception DoesNotTypecheck type even = IsEven | MightNotBeEven type coin_type = even * even * even * even type env = (string * coin_type) list let rec typecheck env exp = let ifeven i = if i % 2 = 0 then IsEven else MightNotBeEven in let merge_evens e1 e2 = match (e1,e2) with (IsEven,IsEven) -> IsEven | _ -> MightNotBeEven in let nothing_known = (MightNotBeEven, MightNotBeEven, MightNotBeEven, MightNotBeEven) in match exp with MoneyConst (q,d,n,p) -> (ifeven q, ifeven d, ifeven n, ifeven p) | Var s -> (try List.assoc s env with Not_found -> raise DoesNotTypecheck) | CombineMoney (e1,e2) -> let (q1,d1,n1,p1) = typecheck env e1 in let (q2,d2,n2,p2) = typecheck env e2 in (merge_evens q1 q2, merge_evens d1 d2, merge_evens n1 n2, merge_evens p1 p2) | _ -> raise Unimplemented (************** Problem 6 **************) (* your solution should be in a text file or similar, but some of the code from the problem is repeated here in case that's convenient *) type coin_type' = MoneyType of coin_type | RefType of coin_type' | UnitType let rec subtype_proposed t1 t2 = let even_sub et1 et2 = (et1 = IsEven || et2 = MightNotBeEven) in match (t1,t2) with (MoneyType(qt1,dt1,nt1,pt1), MoneyType(qt2,dt2,nt2,pt2)) -> List.for_all2 even_sub [qt1;dt1;nt1;pt1] [qt2;dt2;nt2;pt2] | (RefType t1', RefType t2') -> subtype_proposed t1' t2' | (UnitType, UnitType) -> true | _ -> false