|
|
|
|
@ -5,71 +5,6 @@ Random.self_init ()
|
|
|
|
|
|
|
|
|
|
let (let*) = Result.bind
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
module VariableSet = Set.Make(String)
|
|
|
|
|
|
|
|
|
|
let rec freevariables (t: intermediaryTypes) : VariableSet.t =
|
|
|
|
|
match t with
|
|
|
|
|
(IntermediaryBooleanType) -> VariableSet.empty
|
|
|
|
|
| (IntermediaryIntegerType) -> VariableSet.empty
|
|
|
|
|
| (IntermediaryVariableType x) -> VariableSet.singleton x
|
|
|
|
|
| (IntermediaryFunctionType (Some name, tin)) ->
|
|
|
|
|
let partres = List.fold_left (fun acc x -> VariableSet.union acc (freevariables x)) VariableSet.empty tin in
|
|
|
|
|
VariableSet.add name partres
|
|
|
|
|
| (IntermediaryFunctionType (None, tin)) ->
|
|
|
|
|
List.fold_left (fun acc x -> VariableSet.union acc (freevariables x)) VariableSet.empty tin
|
|
|
|
|
|
|
|
|
|
let rec replaceunified (t: intermediaryTypes) (unifier: substitution) : intermediaryTypes =
|
|
|
|
|
match t with
|
|
|
|
|
IntermediaryIntegerType
|
|
|
|
|
| IntermediaryBooleanType -> t
|
|
|
|
|
| IntermediaryVariableType x -> (
|
|
|
|
|
match VariableMap.find_opt x unifier with
|
|
|
|
|
Some tnew -> tnew
|
|
|
|
|
| None -> t
|
|
|
|
|
)
|
|
|
|
|
| IntermediaryFunctionType (Some name, tin) -> (
|
|
|
|
|
match VariableMap.find_opt name unifier with
|
|
|
|
|
Some tnew -> tnew
|
|
|
|
|
| None -> IntermediaryFunctionType (Some name, List.map (fun x -> replaceunified x unifier) tin)
|
|
|
|
|
)
|
|
|
|
|
| IntermediaryFunctionType (None, tin) ->
|
|
|
|
|
IntermediaryFunctionType (None, List.map (fun x -> replaceunified x unifier) tin)
|
|
|
|
|
|
|
|
|
|
let rec unify t1 t2 =
|
|
|
|
|
match (t1, t2) with
|
|
|
|
|
| (_, IntermediaryVariableType x2) ->
|
|
|
|
|
if VariableSet.mem x2 (freevariables t1) then
|
|
|
|
|
Error (`WrongType "Cannot unify")
|
|
|
|
|
else
|
|
|
|
|
Ok (VariableMap.add x2 t1 VariableMap.empty)
|
|
|
|
|
| (IntermediaryVariableType x1, _) ->
|
|
|
|
|
if VariableSet.mem x1 (freevariables t2) then
|
|
|
|
|
Error (`WrongType "Cannot unify")
|
|
|
|
|
else
|
|
|
|
|
Ok (VariableMap.add x1 t2 VariableMap.empty)
|
|
|
|
|
| (IntermediaryIntegerType, IntermediaryIntegerType)
|
|
|
|
|
| (IntermediaryBooleanType, IntermediaryBooleanType) -> Ok VariableMap.empty
|
|
|
|
|
| (IntermediaryFunctionType (Some name1, tin1), IntermediaryFunctionType (Some name2, tin2)) ->
|
|
|
|
|
if name1 <> name2 then
|
|
|
|
|
Error (`WrongType "Different functions cannot be unified")
|
|
|
|
|
else
|
|
|
|
|
List.fold_left2 (
|
|
|
|
|
fun acc t1 t2 ->
|
|
|
|
|
if Result.is_error acc then (* stop at the first error *)
|
|
|
|
|
acc
|
|
|
|
|
else
|
|
|
|
|
let* partres = unify (replaceunified t1 (Result.get_ok acc)) (replaceunified t2 (Result.get_ok acc)) in
|
|
|
|
|
try
|
|
|
|
|
Ok (VariableMap.union (fun _ val1 val2 -> if val1 = val2 then Some val1 else failwith "Should not happen") partres acc)
|
|
|
|
|
with Failure e ->
|
|
|
|
|
Error (`WrongType e)
|
|
|
|
|
) (Ok VariableMap.empty) tin1 tin2
|
|
|
|
|
| (IntermediaryFunctionType (None, _), IntermediaryFunctionType _)
|
|
|
|
|
| (IntermediaryFunctionType _, IntermediaryFunctionType (None, _)) ->
|
|
|
|
|
Error (`WrongType "Unnamed Functions cannot be unified")
|
|
|
|
|
| _ -> failwith "Not implemented"
|
|
|
|
|
|
|
|
|
|
let rec evaluate_type (program: t_exp) (context: ftype VariableMap.t) : (ftype, error) result =
|
|
|
|
|
match program with
|
|
|
|
|
Integer _ -> Ok IntegerType
|
|
|
|
|
|
elvis