module Utility = Utility open Types;; Random.self_init () let rec evaluate (mem: memory) (command: t_exp) = match command with Integer n -> (IntegerPermitted n) | Boolean b -> (BooleanPermitted b) | Variable v -> ( match VariableMap.find_opt v mem.assignments with None -> raise (AbsentAssignment ("The variable " ^ v ^ " is not defined.")) | Some a -> a ) | Function (xs, _, f) -> (FunctionPermitted {inputList = xs; body = f; assignments = mem.assignments; recursiveness = None} ) | Application (f, xs) -> ( let funcClosure = ( match (evaluate mem f) with FunctionPermitted ff -> ff | IntegerPermitted _ -> raise (WrongType ("Function is not a function, " ^ "it's an integer")) | BooleanPermitted _ -> raise (WrongType ("Function is not a function, " ^ "it's a boolean")) ) in let parmList = List.map (fun k -> evaluate mem k) xs in let rec helper m params values = match (params, values) with (_, []) -> (m, params) | ([], _) -> raise (WrongArity ("Function application has arity " ^ (List.length funcClosure.inputList |> string_of_int) ^ ", but was applied to " ^ (List.length xs |> string_of_int) ^ " parameters")) | (p::tlparams, v::tlvalues) -> helper (VariableMap.add p v m) tlparams tlvalues in let (mem2assignments, params) = helper funcClosure.assignments funcClosure.inputList parmList in (* helper funcClosure or helper mem ??? *) let mem2 = ( match funcClosure.recursiveness with None -> {assignments = mem2assignments} | Some nameF -> { assignments = VariableMap.add nameF (FunctionPermitted funcClosure) mem2assignments } ) in match params with [] -> evaluate mem2 funcClosure.body | _ -> ( FunctionPermitted {funcClosure with inputList = params; assignments = mem2assignments}) ) | Plus (a, b) -> let aval = ( match evaluate mem a with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) ) in let bval = ( match evaluate mem b with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) ) in (IntegerPermitted (aval + bval)) | Minus (a, b) -> let aval = ( match evaluate mem a with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) ) in let bval = ( match evaluate mem b with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) ) in (IntegerPermitted (aval - bval)) | Times (a, b) -> let aval = ( match evaluate mem a with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) ) in let bval = ( match evaluate mem b with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) ) in (IntegerPermitted (aval * bval)) | Division (a, b) -> let aval = ( match evaluate mem a with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) ) in let bval = ( match evaluate mem b with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) ) in ( try (IntegerPermitted (aval / bval)) with Division_by_zero -> raise (DivisionByZero "Dividing by zero") ) | Modulo (a, b) -> let aval = ( match evaluate mem a with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) ) in let bval = ( match evaluate mem b with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) ) in (IntegerPermitted (aval mod bval)) | Power (a, b) -> let aval = ( match evaluate mem a with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) ) in let bval = ( match evaluate mem b with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) ) in (IntegerPermitted (Utility.pow aval bval)) | PowerMod (a, b, c) -> let aval = ( match evaluate mem a with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) ) in let bval = ( match evaluate mem b with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) ) in let cval = ( match evaluate mem c with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) ) in (IntegerPermitted (Utility.powmod aval bval cval)) | Rand (a) -> let aval = ( match evaluate mem a with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) ) in IntegerPermitted (Random.int aval) | BAnd (a, b) -> let aval = ( match evaluate mem a with BooleanPermitted x -> x | _ -> raise (WrongType ("Value is not an boolean")) ) in let bval = ( match evaluate mem b with BooleanPermitted x -> x | _ -> raise (WrongType ("Value is not an boolean")) ) in (BooleanPermitted (aval && bval)) | BOr (a, b) -> let aval = ( match evaluate mem a with BooleanPermitted x -> x | _ -> raise (WrongType ("Value is not an boolean")) ) in let bval = ( match evaluate mem b with BooleanPermitted x -> x | _ -> raise (WrongType ("Value is not an boolean")) ) in (BooleanPermitted (aval || bval)) | BNot a -> let aval = ( match evaluate mem a with BooleanPermitted x -> x | _ -> raise (WrongType ("Value is not an boolean")) ) in (BooleanPermitted (not aval)) | Cmp (exp_1, exp_2) -> ( let exp_1val = match evaluate mem exp_1 with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) in let exp_2val = match evaluate mem exp_2 with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) in BooleanPermitted (exp_1val = exp_2val) ) | CmpLess (exp_1, exp_2) -> ( let exp_1val = match evaluate mem exp_1 with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) in let exp_2val = match evaluate mem exp_2 with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) in BooleanPermitted (exp_1val < exp_2val) ) | CmpLessEq (exp_1, exp_2) -> ( let exp_1val = match evaluate mem exp_1 with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) in let exp_2val = match evaluate mem exp_2 with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) in BooleanPermitted (exp_1val <= exp_2val) ) | CmpGreater (exp_1, exp_2) -> ( let exp_1val = match evaluate mem exp_1 with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) in let exp_2val = match evaluate mem exp_2 with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) in BooleanPermitted (exp_1val > exp_2val) ) | CmpGreaterEq (exp_1, exp_2) -> ( let exp_1val = match evaluate mem exp_1 with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) in let exp_2val = match evaluate mem exp_2 with IntegerPermitted x -> x | _ -> raise (WrongType ("Value is not an integer")) in BooleanPermitted (exp_1val >= exp_2val) ) | IfThenElse (guard, if_exp, else_exp) -> let bguard = ( match evaluate mem guard with BooleanPermitted b -> b | _ -> raise (WrongType ("Value in if guard is not a boolean")) ) in if bguard then evaluate mem if_exp else evaluate mem else_exp | LetIn (x, xval, rest) -> let evalxval = evaluate mem xval in let mem2 = {assignments = VariableMap.add x evalxval mem.assignments} in evaluate mem2 rest | LetFun (f, xs, _, fbody, rest) -> let mem2 = { assignments = VariableMap.add f (FunctionPermitted { inputList = xs; body = fbody; assignments = mem.assignments; recursiveness = Some f}) mem.assignments} in evaluate mem2 rest let reduce (program: t_exp) (iin : int) = let program' = (Application (program, [(Integer iin)])) in let mem : memory = {assignments = VariableMap.empty} in match (evaluate mem program') with IntegerPermitted a -> a | _ -> raise (WrongType ("Main function doesn't return an integer"))