elvis/lci
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Refactoring, errors are not thrown anymore

Browse Source
This commit is contained in:
elvis
2024-10-26 01:47:30 +02:00
parent 8427133fd7
commit 3e4e1615d2
11 changed files with 413 additions and 339 deletions
Download Patch File Download Diff File Expand all files Collapse all files

335
lib/miniFun/Semantics.ml
View File

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

2
lib/miniFun/Semantics.mli
View File

@ -1 +1 @@
val reduce : Types.t_exp -> int -> int val reduce : Types.t_exp -> int -> (int, Types.error) result

151
lib/miniFun/TypeChecker.ml
View File

@ -3,48 +3,55 @@ open Types;;
Random.self_init () Random.self_init ()
let rec evaluate_type (program: t_exp) context = let (let*) = Result.bind
let rec evaluate_type (program: t_exp) (context: ftype VariableMap.t) : (ftype, error) result =
match program with match program with
Integer _ -> IntegerType Integer _ -> Ok IntegerType
| Boolean _ -> BooleanType | Boolean _ -> Ok BooleanType
| Variable x -> (match VariableMap.find_opt x context with | Variable x -> (
None -> raise (AbsentAssignment ("The variable " ^ x ^ " is not defined.")) match VariableMap.find_opt x context with
| Some t -> t) None -> Error (`AbsentAssignment ("The variable " ^ x ^ " is not defined."))
| Some t -> Ok t
)
| Function (xs, typef, fbody) -> ( | Function (xs, typef, fbody) -> (
match typef with match typef with
FunctionType (tin, tout) -> ( FunctionType (tin, tout) -> (
if List.length xs != List.length tin then if List.length xs <> List.length tin then
raise (WrongTypeSpecification "Type specification for function has wrong arity.") Error (`WrongTypeSpecification "Type specification for function has wrong arity.")
else else
let context1 = List.fold_left2 (fun acc x t -> VariableMap.add x t acc) context xs tin in let context1 = List.fold_left2 (fun acc x t -> VariableMap.add x t acc) context xs tin in
match (evaluate_type fbody context1 = tout) with let* typefbody = evaluate_type fbody context1 in
(false) -> raise (WrongTypeSpecification "Function does not return specified type.") match (typefbody = tout) with
| (true) -> typef (false) -> Error (`WrongTypeSpecification "Function does not return specified type.")
| (true) -> Ok typef
) )
| _ -> raise (WrongTypeSpecification "Specification of function is not a function type.") | _ -> Error (`WrongTypeSpecification "Specification of function is not a function type.")
) )
| Application (f, xs) -> ( | Application (f, xs) -> (
match evaluate_type f context with let* evalf = evaluate_type f context in
match evalf with
FunctionType (tin, tout) -> ( FunctionType (tin, tout) -> (
let rec helper params typeparams = let rec helper params typeparams =
match (params, typeparams) with match (params, typeparams) with
([], _) -> typeparams ([], _) -> Ok typeparams
| (_, []) -> raise (WrongArity ("Function application has arity " ^ | (_, []) -> Error (`WrongArity ("Function application has arity " ^
(List.length tin |> string_of_int) ^ (List.length tin |> string_of_int) ^
", but was applied to " ^ ", but was applied to " ^
(List.length xs |> string_of_int) ^ (List.length xs |> string_of_int) ^
" parameters")) " parameters"))
| (p::tlparams, v::tltypeparams) -> | (p::tlparams, v::tltypeparams) ->
if evaluate_type p context = v then if evaluate_type p context = Ok v then
helper tlparams tltypeparams helper tlparams tltypeparams
else else
raise (WrongType "Argument with wrong type.") Error (`WrongType "Argument with wrong type.")
in in
match helper xs tin with let* typesremaining = helper xs tin in
[] -> tout match typesremaining with
| t -> FunctionType (t, tout) [] -> Ok tout
| t -> Ok (FunctionType (t, tout))
) )
| _ -> raise (WrongType "Applying to a non function type") | _ -> Error (`WrongType "Applying to a non function type")
) )
| Plus (x, y) | Plus (x, y)
| Minus (x, y) | Minus (x, y)
@ -52,74 +59,90 @@ let rec evaluate_type (program: t_exp) context =
| Division (x, y) | Division (x, y)
| Modulo (x, y) | Modulo (x, y)
| Power (x, y) -> ( | Power (x, y) -> (
match (evaluate_type x context, evaluate_type y context) with let* typex = evaluate_type x context in
| (IntegerType, IntegerType) -> IntegerType let* typey = evaluate_type y context in
| (IntegerType, _) -> raise (WrongType "Second term is not an integer.") match typex, typey with
| (_, _) -> raise (WrongType "First term is not an integer.") | (IntegerType, IntegerType) -> Ok IntegerType
| (IntegerType, _) -> Error (`WrongType "Second term is not an integer.")
| (_, _) -> Error (`WrongType "First term is not an integer.")
) )
| PowerMod (x, y, z) -> ( | PowerMod (x, y, z) -> (
match (evaluate_type x context, evaluate_type y context, evaluate_type z context) with let* typex = evaluate_type x context in
| (IntegerType, IntegerType, IntegerType) -> IntegerType let* typey = evaluate_type y context in
| (IntegerType, IntegerType, _) -> raise (WrongType "Third term is not an integer.") let* typez = evaluate_type z context in
| (IntegerType, _, _) -> raise (WrongType "Second term is not an integer.") match typex, typey, typez with
| (_, _, _) -> raise (WrongType "First term is not an integer.") | (IntegerType, IntegerType, IntegerType) -> Ok IntegerType
| (IntegerType, IntegerType, _) -> Error (`WrongType "Third term is not an integer.")
| (IntegerType, _, _) -> Error (`WrongType "Second term is not an integer.")
| (_, _, _) -> Error (`WrongType "First term is not an integer.")
) )
| Rand (x) -> ( | Rand (x) -> (
match (evaluate_type x context) with let* typex = evaluate_type x context in
| (IntegerType) -> IntegerType match typex with
| (_) -> raise (WrongType "Term is not an integer.") | (IntegerType) -> Ok IntegerType
| (_) -> Error (`WrongType "Term is not an integer.")
) )
| BAnd (x, y) | BAnd (x, y)
| BOr (x, y) -> ( | BOr (x, y) -> (
match (evaluate_type x context, evaluate_type y context) with let* typex = evaluate_type x context in
| (BooleanType, BooleanType) -> BooleanType let* typey = evaluate_type y context in
| (BooleanType, _) -> raise (WrongType "Second term is not a boolean.") match typex, typey with
| (_, _) -> raise (WrongType "First term is not a boolean.") | (BooleanType, BooleanType) -> Ok BooleanType
| (BooleanType, _) -> Error (`WrongType "Second term is not a boolean.")
| (_, _) -> Error (`WrongType "First term is not a boolean.")
) )
| BNot (x) -> ( | BNot (x) -> (
match (evaluate_type x context) with let* typex = evaluate_type x context in
| (BooleanType) -> BooleanType match typex with
| (_) -> raise (WrongType "Term is not a boolean.") | (BooleanType) -> Ok BooleanType
| (_) -> Error (`WrongType "Term is not a boolean.")
) )
| Cmp (x, y) | Cmp (x, y)
| CmpLess (x, y) | CmpLess (x, y)
| CmpLessEq (x, y) | CmpLessEq (x, y)
| CmpGreater (x, y) | CmpGreater (x, y)
| CmpGreaterEq (x, y) -> ( | CmpGreaterEq (x, y) -> (
match (evaluate_type x context, evaluate_type y context) with let* typex = evaluate_type x context in
| (IntegerType, IntegerType) -> BooleanType let* typey = evaluate_type y context in
| (IntegerType, _) -> raise (WrongType "Second term is not an integer.") match typex, typey with
| (_, _) -> raise (WrongType "First term is not an integer.") | (IntegerType, IntegerType) -> Ok BooleanType
| (IntegerType, _) -> Error (`WrongType "Second term is not an integer.")
| (_, _) -> Error (`WrongType "First term is not an integer.")
) )
| IfThenElse (guard, if_exp, else_exp) -> ( | IfThenElse (guard, if_exp, else_exp) -> (
match (evaluate_type guard context, evaluate_type if_exp context, evaluate_type else_exp context) with let* typeguard = evaluate_type guard context in
let* typeif_exp = evaluate_type if_exp context in
let* typeelse_exp = evaluate_type else_exp context in
match typeguard, typeif_exp, typeelse_exp with
(BooleanType, t1, t2) -> ( (BooleanType, t1, t2) -> (
if t1 = t2 then if t1 = t2 then
t1 Ok t1
else else
raise (WrongType "If branches do not have the same type.") Error (`WrongType "If branches do not have the same type.")
) )
| (_, _, _) -> raise (WrongType "If guard is not a boolean.") | (_, _, _) -> Error (`WrongType "If guard is not a boolean.")
) )
| LetIn (x, xval, rest) -> | LetIn (x, xval, rest) ->
let typex = evaluate_type xval context in let* typex = evaluate_type xval context in
evaluate_type rest (VariableMap.add x typex context) evaluate_type rest (VariableMap.add x typex context)
| LetFun (f, xs, typef, fbody, rest) -> | LetFun (f, xs, typef, fbody, rest) ->
match typef with match typef with
FunctionType (tin, tout) -> ( FunctionType (tin, tout) -> (
if List.length xs != List.length tin then if List.length xs <> List.length tin then
raise (WrongArity "Type specification for function has wrong arity.") Error (`WrongArity "Type specification for function has wrong arity.")
else else
let context1 = VariableMap.add f typef context in let context1 = VariableMap.add f typef context in
let context2 = List.fold_left2 (fun acc x t -> VariableMap.add x t acc) context1 xs tin in let context2 = List.fold_left2 (fun acc x t -> VariableMap.add x t acc) context1 xs tin in
match (evaluate_type fbody context2 = tout, evaluate_type rest context1) with let* typefbody = evaluate_type fbody context2 in
(false, _) -> raise (WrongTypeSpecification "Function does not return specified type." let* typerest = evaluate_type rest context1 in
) match (typefbody = tout, typerest) with
| (true, t) -> t (false, _) -> Error (`WrongTypeSpecification "Function does not return specified type.")
| (true, t) -> Ok t
) )
| _ -> raise (WrongTypeSpecification "Specification of function is not a function type.") | _ -> Error (`WrongTypeSpecification "Specification of function is not a function type.")
let typecheck (program: t_exp) = let typecheck (program: t_exp) : (ftype, error) result =
match evaluate_type program VariableMap.empty with let* typeprogram = evaluate_type program VariableMap.empty in
FunctionType ([IntegerType], IntegerType) -> true match typeprogram with
| _ -> raise (WrongType "Program is not a function from int to int.") FunctionType ([IntegerType], IntegerType) -> Ok (FunctionType ([IntegerType], IntegerType))
| _ -> Error (`WrongType "Program is not a function from int to int.")

2
lib/miniFun/TypeChecker.mli
View File

@ -1 +1 @@
val typecheck : Types.t_exp -> bool val typecheck : Types.t_exp -> (Types.ftype, Types.error) result

12
lib/miniFun/Types.ml
View File

@ -48,8 +48,10 @@ type memory = {
assignments: permittedValues VariableMap.t assignments: permittedValues VariableMap.t
} }
exception AbsentAssignment of string type error = [
exception WrongType of string `AbsentAssignment of string
exception DivisionByZero of string | `WrongType of string
exception WrongArity of string | `DivisionByZero of string
exception WrongTypeSpecification of string | `WrongArity of string
| `WrongTypeSpecification of string
]

60
lib/miniFun/Types.mli
View File

@ -8,30 +8,30 @@ type ftype =
| FunctionType of ftype list * ftype | FunctionType of ftype list * ftype
type t_exp = type t_exp =
Integer of int Integer of int (* x := a *)
| Boolean of bool | Boolean of bool (* v *)
| Variable of variable | Variable of variable (* x *)
| Function of variable list * ftype * t_exp | Function of variable list * ftype * t_exp (* lambda x: t. x *)
| Application of t_exp * t_exp list | Application of t_exp * t_exp list (* x x *)
| Plus of t_exp * t_exp | Plus of t_exp * t_exp (* x + x *)
| Minus of t_exp * t_exp | Minus of t_exp * t_exp (* x - x *)
| Times of t_exp * t_exp | Times of t_exp * t_exp (* x * x *)
| Division of t_exp * t_exp | Division of t_exp * t_exp (* x / x *)
| Modulo of t_exp * t_exp | Modulo of t_exp * t_exp (* x % x *)
| Power of t_exp * t_exp | Power of t_exp * t_exp (* x ^ x *)
| PowerMod of t_exp * t_exp * t_exp | PowerMod of t_exp * t_exp * t_exp (* (x ^ x) % x *)
| Rand of t_exp | Rand of t_exp (* rand(0, x) *)
| BAnd of t_exp * t_exp | BAnd of t_exp * t_exp (* x and x *)
| BOr of t_exp * t_exp | BOr of t_exp * t_exp (* x or x *)
| BNot of t_exp | BNot of t_exp (* not x *)
| Cmp of t_exp * t_exp | Cmp of t_exp * t_exp (* x == x *)
| CmpLess of t_exp * t_exp | CmpLess of t_exp * t_exp (* x < x *)
| CmpLessEq of t_exp * t_exp | CmpLessEq of t_exp * t_exp (* x <= x *)
| CmpGreater of t_exp * t_exp | CmpGreater of t_exp * t_exp (* x > x *)
| CmpGreaterEq of t_exp * t_exp | CmpGreaterEq of t_exp * t_exp (* x >= x *)
| IfThenElse of t_exp * t_exp * t_exp | IfThenElse of t_exp * t_exp * t_exp (* if b then c else c *)
| LetIn of variable * t_exp * t_exp | LetIn of variable * t_exp * t_exp (* let x = x in x *)
| LetFun of variable * variable list * ftype * t_exp * t_exp | LetFun of variable * variable list * ftype * t_exp * t_exp (* let rec x: t. x in x*)
type permittedValues = type permittedValues =
IntegerPermitted of int IntegerPermitted of int
@ -48,8 +48,10 @@ type memory = {
assignments: permittedValues VariableMap.t assignments: permittedValues VariableMap.t
} }
exception AbsentAssignment of string type error = [
exception WrongType of string `AbsentAssignment of string
exception DivisionByZero of string | `WrongType of string
exception WrongArity of string | `DivisionByZero of string
exception WrongTypeSpecification of string | `WrongArity of string
| `WrongTypeSpecification of string
]

1
lib/miniImp/Types.ml
View File

@ -32,7 +32,6 @@ and a_exp =
| Rand of a_exp (* rand(0, a) *) | Rand of a_exp (* rand(0, a) *)
module VariableMap = Map.Make(String) module VariableMap = Map.Make(String)
type memory = { type memory = {

1
lib/miniImp/Types.mli
View File

@ -32,7 +32,6 @@ and a_exp =
| Rand of a_exp (* rand(0, a) *) | Rand of a_exp (* rand(0, a) *)
module VariableMap : Map.S with type key = variable module VariableMap : Map.S with type key = variable
type memory = { type memory = {

26
test/testingFun.ml
View File

@ -11,7 +11,7 @@ let program =
) )
;; ;;
Printf.printf "Identity program: %d\n" (reduce program 1) Printf.printf "Identity program: %d\n" (Result.get_ok (reduce program 1))
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Constant program *) (* Constant program *)
@ -23,7 +23,7 @@ let program =
) )
;; ;;
Printf.printf "Constant program: %d\n" (reduce program 10) Printf.printf "Constant program: %d\n" (Result.get_ok (reduce program 10))
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Partial application of function program *) (* Partial application of function program *)
@ -37,7 +37,7 @@ let program =
) )
;; ;;
Printf.printf "Partial application of function program: %d\n" (reduce program 2) Printf.printf "Partial application of function program: %d\n" (Result.get_ok (reduce program 2))
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Partial application of function program *) (* Partial application of function program *)
@ -53,7 +53,7 @@ let program =
) )
;; ;;
Printf.printf "Partial application of function program: %d\n" (reduce program 3) Printf.printf "Partial application of function program: %d\n" (Result.get_ok (reduce program 3))
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Passing functions to functions program *) (* Passing functions to functions program *)
@ -89,8 +89,8 @@ let program =
) )
;; ;;
Printf.printf "Passing functions to functions program 1: %d\n" (reduce program (3)); Printf.printf "Passing functions to functions program 1: %d\n" (Result.get_ok (reduce program (3)));
Printf.printf "Passing functions to functions program 2: %d\n" (reduce program (-3)) Printf.printf "Passing functions to functions program 2: %d\n" (Result.get_ok (reduce program (-3)))
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Recursive function program *) (* Recursive function program *)
@ -104,7 +104,7 @@ let program =
) )
;; ;;
Printf.printf "Recursive function program: %d\n" (reduce program 10) Printf.printf "Recursive function program: %d\n" (Result.get_ok (reduce program 10))
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Scope program *) (* Scope program *)
@ -116,7 +116,7 @@ let program =
) )
;; ;;
Printf.printf "Scope program: %d\n" (reduce program 4) Printf.printf "Scope program: %d\n" (Result.get_ok (reduce program 4))
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Factorial program *) (* Factorial program *)
@ -130,7 +130,7 @@ let program =
) )
;; ;;
Printf.printf "Factorial program: %d\n" (reduce program 10) Printf.printf "Factorial program: %d\n" (Result.get_ok (reduce program 10))
;; ;;
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
@ -154,7 +154,7 @@ let program =
) )
;; ;;
Printf.printf "Hailstone sequence's lenght program: %d\n" (reduce program 77031) Printf.printf "Hailstone sequence's lenght program: %d\n" (Result.get_ok (reduce program 77031))
;; ;;
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
@ -176,7 +176,7 @@ let program =
) )
;; ;;
Printf.printf "Sum multiples of 3 and 5 program: %d\n" (reduce program 12345) Printf.printf "Sum multiples of 3 and 5 program: %d\n" (Result.get_ok (reduce program 12345))
;; ;;
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
@ -190,7 +190,7 @@ let program =
;; ;;
Printf.printf "Rand program: %b\n" ((reduce program 10) < 10) Printf.printf "Rand program: %b\n" ((Result.get_ok (reduce program 10) < 10))
;; ;;
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
@ -213,5 +213,5 @@ let program =
;; ;;
Printf.printf "Fibonacci program: %d\n" (reduce program 48) Printf.printf "Fibonacci program: %d\n" (Result.get_ok (reduce program 48))
;; ;;

42
test/testingTypeFun.expected
View File

@ -1,21 +1,21 @@
Error absent assignment program: error Error absent assignment program: error (success)
Error wrong arity program 1: error Error wrong arity program 1: error (success)
Error wrong arity program 2: error Error wrong arity program 2: error (success)
Error wrong return type program: error Error wrong return type program: error (success)
Error wrong specification program: error Error wrong specification program: error (success)
Error wrong input type program: error Error wrong input type program: error (success)
Error not a function program: error Error not a function program: error (success)
Error if branches with different types program: error Error if branches with different types program: error (success)
Error if guard is not a boolean program: error Error if guard is not a boolean program: error (success)
Identity program: true Identity program: success
Constant program: true Constant program: success
Partial application of function program: true Partial application of function program 1: success
Partial application of function program: true Partial application of function program 2: success
Passing functions to functions program: true Passing functions to functions program: success
Recursive function program: true Recursive function program: success
Scope program: true Scope program: success
Factorial program: true Factorial program: success
Hailstone sequence's lenght program: true Hailstone sequence's lenght program: success
Sum multiples of 3 and 5 program: true Sum multiples of 3 and 5 program: success
Rand program: true Rand program: success
Fibonacci program: true Fibonacci program: success

120
test/testingTypeFun.ml
View File

@ -8,14 +8,13 @@ let program =
Function Function
(["a"], (["a"],
FunctionType ([IntegerType], IntegerType), FunctionType ([IntegerType], IntegerType),
(Variable "x") Plus (Variable "x", Integer 1)
) )
;; ;;
try match typecheck program with
Printf.printf "Error absent assignment program: %b\n" (typecheck program) Error (`AbsentAssignment _) -> Printf.printf "Error absent assignment program: error (success)\n"
with AbsentAssignment _ -> | _ -> Printf.printf "Error absent assignment program: failed\n"
Printf.printf "Error absent assignment program: error\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Error wrong arity program *) (* Error wrong arity program *)
@ -28,10 +27,9 @@ let program =
) )
;; ;;
try match typecheck program with
Printf.printf "Error wrong arity program 1: %b\n" (typecheck program) Error (`WrongTypeSpecification _) -> Printf.printf "Error wrong arity program 1: error (success)\n"
with WrongTypeSpecification _ -> | _ -> Printf.printf "Error wrong arity program 1: failed\n"
Printf.printf "Error wrong arity program 1: error\n"
let program = let program =
LetFun LetFun
@ -43,11 +41,9 @@ let program =
) )
;; ;;
try match typecheck program with
Printf.printf "Error wrong arity program 2: %b\n" (typecheck program) Error (`WrongArity _) -> Printf.printf "Error wrong arity program 2: error (success)\n"
with WrongArity _ -> | _ -> Printf.printf "Error wrong arity program 2: failed\n"
Printf.printf "Error wrong arity program 2: error\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Error wrong return type program *) (* Error wrong return type program *)
@ -60,10 +56,9 @@ let program =
) )
;; ;;
try match typecheck program with
Printf.printf "Error wrong return type program: %b\n" (typecheck program) Error (`WrongTypeSpecification _) -> Printf.printf "Error wrong return type program: error (success)\n"
with WrongTypeSpecification _ -> | _ -> Printf.printf "Error wrong return type program: failed\n"
Printf.printf "Error wrong return type program: error\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Error wrong specification program *) (* Error wrong specification program *)
@ -76,10 +71,9 @@ let program =
) )
;; ;;
try match typecheck program with
Printf.printf "Error wrong specification program: %b\n" (typecheck program) Error (`WrongTypeSpecification _) -> Printf.printf "Error wrong specification program: error (success)\n"
with WrongTypeSpecification _ -> | _ -> Printf.printf "Error wrong specification program: failed\n"
Printf.printf "Error wrong specification program: error\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Error wrong input type program *) (* Error wrong input type program *)
@ -95,10 +89,9 @@ let program =
) )
;; ;;
try match typecheck program with
Printf.printf "Error wrong input type program: %b\n" (typecheck program) Error (`WrongType _) -> Printf.printf "Error wrong input type program: error (success)\n"
with WrongType _ -> | _ -> Printf.printf "Error wrong input type program: failed\n"
Printf.printf "Error wrong input type program: error\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Error not a function program *) (* Error not a function program *)
@ -110,10 +103,9 @@ let program =
) )
;; ;;
try match typecheck program with
Printf.printf "Error not a function program: %b\n" (typecheck program) Error (`WrongType _) -> Printf.printf "Error not a function program: error (success)\n"
with WrongType _ -> | _ -> Printf.printf "Error not a function program: failed\n"
Printf.printf "Error not a function program: error\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Error if branches with different types program *) (* Error if branches with different types program *)
@ -126,10 +118,9 @@ let program =
) )
;; ;;
try match typecheck program with
Printf.printf "Error if branches with different types program: %b\n" (typecheck program) Error (`WrongType _) -> Printf.printf "Error if branches with different types program: error (success)\n"
with WrongType _ -> | _ -> Printf.printf "Error if branches with different types program: failed\n"
Printf.printf "Error if branches with different types program: error\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Error if guard is not a boolean program *) (* Error if guard is not a boolean program *)
@ -142,11 +133,9 @@ let program =
) )
;; ;;
try match typecheck program with
Printf.printf "Error if guard is not a boolean program: %b\n" (typecheck program) Error (`WrongType _) -> Printf.printf "Error if guard is not a boolean program: error (success)\n"
with WrongType _ -> | _ -> Printf.printf "Error if guard is not a boolean program: failed\n"
Printf.printf "Error if guard is not a boolean program: error\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
@ -159,7 +148,9 @@ let program =
) )
;; ;;
Printf.printf "Identity program: %b\n" (typecheck program) match typecheck program with
Ok _ -> Printf.printf "Identity program: success\n"
| _ -> Printf.printf "Identity program: failed\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Constant program *) (* Constant program *)
@ -171,7 +162,9 @@ let program =
) )
;; ;;
Printf.printf "Constant program: %b\n" (typecheck program) match typecheck program with
Ok _ -> Printf.printf "Constant program: success\n"
| _ -> Printf.printf "Constant program: failed\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Partial application of function program *) (* Partial application of function program *)
@ -185,7 +178,9 @@ let program =
) )
;; ;;
Printf.printf "Partial application of function program: %b\n" (typecheck program) match typecheck program with
Ok _ -> Printf.printf "Partial application of function program 1: success\n"
| _ -> Printf.printf "Partial application of function program 1: failed\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Partial application of function program *) (* Partial application of function program *)
@ -201,7 +196,9 @@ let program =
) )
;; ;;
Printf.printf "Partial application of function program: %b\n" (typecheck program) match typecheck program with
Ok _ -> Printf.printf "Partial application of function program 2: success\n"
| _ -> Printf.printf "Partial application of function program 2: failed\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Passing functions to functions program *) (* Passing functions to functions program *)
@ -237,7 +234,9 @@ let program =
) )
;; ;;
Printf.printf "Passing functions to functions program: %b\n" (typecheck program) match typecheck program with
Ok _ -> Printf.printf "Passing functions to functions program: success\n"
| _ -> Printf.printf "Passing functions to functions program: failed\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Recursive function program *) (* Recursive function program *)
@ -251,7 +250,9 @@ let program =
) )
;; ;;
Printf.printf "Recursive function program: %b\n" (typecheck program) match typecheck program with
Ok _ -> Printf.printf "Recursive function program: success\n"
| _ -> Printf.printf "Recursive function program: failed\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Scope program *) (* Scope program *)
@ -263,7 +264,9 @@ let program =
) )
;; ;;
Printf.printf "Scope program: %b\n" (typecheck program) match typecheck program with
Ok _ -> Printf.printf "Scope program: success\n"
| _ -> Printf.printf "Scope program: failed\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Factorial program *) (* Factorial program *)
@ -277,8 +280,9 @@ let program =
) )
;; ;;
Printf.printf "Factorial program: %b\n" (typecheck program) match typecheck program with
;; Ok _ -> Printf.printf "Factorial program: success\n"
| _ -> Printf.printf "Factorial program: failed\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Hailstone sequence's lenght program *) (* Hailstone sequence's lenght program *)
@ -301,8 +305,9 @@ let program =
) )
;; ;;
Printf.printf "Hailstone sequence's lenght program: %b\n" (typecheck program) match typecheck program with
;; Ok _ -> Printf.printf "Hailstone sequence's lenght program: success\n"
| _ -> Printf.printf "Hailstone sequence's lenght program: failed\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Sum multiples of 3 and 5 program *) (* Sum multiples of 3 and 5 program *)
@ -323,8 +328,9 @@ let program =
) )
;; ;;
Printf.printf "Sum multiples of 3 and 5 program: %b\n" (typecheck program) match typecheck program with
;; Ok _ -> Printf.printf "Sum multiples of 3 and 5 program: success\n"
| _ -> Printf.printf "Sum multiples of 3 and 5 program: failed\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Rand program *) (* Rand program *)
@ -337,8 +343,9 @@ let program =
;; ;;
Printf.printf "Rand program: %b\n" (typecheck program) match typecheck program with
;; Ok _ -> Printf.printf "Rand program: success\n"
| _ -> Printf.printf "Rand program: failed\n"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* Fibonacci program *) (* Fibonacci program *)
@ -360,5 +367,6 @@ let program =
;; ;;
Printf.printf "Fibonacci program: %b\n" (typecheck program) match typecheck program with
;; Ok _ -> Printf.printf "Fibonacci program: success\n"
| _ -> Printf.printf "Fibonacci program: failed\n"