359 lines
10 KiB
OCaml
359 lines
10 KiB
OCaml
type variable = string
|
|
|
|
module VariableMap = Map.Make(String)
|
|
|
|
type t_exp =
|
|
Integer of int
|
|
| Boolean of bool
|
|
| Variable of variable
|
|
| Function of variable list * t_exp
|
|
| Application of t_exp * t_exp list
|
|
| Plus of t_exp * t_exp
|
|
| Minus of t_exp * t_exp
|
|
| Times of t_exp * t_exp
|
|
| Division of t_exp * t_exp
|
|
| Modulo of t_exp * t_exp
|
|
| Power of t_exp * t_exp
|
|
| PowerMod of t_exp * t_exp * t_exp
|
|
| Rand of t_exp
|
|
| BAnd of t_exp * t_exp
|
|
| BOr of t_exp * t_exp
|
|
| BNot of t_exp
|
|
| Cmp of t_exp * t_exp
|
|
| CmpLess of t_exp * t_exp
|
|
| CmpLessEq of t_exp * t_exp
|
|
| CmpGreater of t_exp * t_exp
|
|
| CmpGreaterEq of t_exp * t_exp
|
|
| IfThenElse of t_exp * t_exp * t_exp
|
|
| LetIn of variable * t_exp * t_exp
|
|
| LetFun of variable * variable list * t_exp * t_exp
|
|
|
|
type permittedValues =
|
|
IntegerPermitted of int
|
|
| BooleanPermitted of bool
|
|
| FunctionPermitted of closure
|
|
and closure = {
|
|
inputList: variable list;
|
|
body: t_exp;
|
|
assignments: permittedValues VariableMap.t;
|
|
recursiveness: variable option
|
|
}
|
|
|
|
type memory = {
|
|
assignments: permittedValues VariableMap.t
|
|
}
|
|
|
|
exception AbsentAssignment of string
|
|
exception WrongType of string
|
|
exception DivisionByZero of string
|
|
exception WrongAriety of string
|
|
|
|
module Utility = Utility;;
|
|
|
|
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 (WrongAriety ("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"))
|