diff --git a/lib/miniFun/TypeChecker.ml b/lib/miniFun/TypeChecker.ml index 2bfcdec..8fc9feb 100644 --- a/lib/miniFun/TypeChecker.ml +++ b/lib/miniFun/TypeChecker.ml @@ -5,6 +5,71 @@ 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 diff --git a/lib/miniFun/TypeChecker.mli b/lib/miniFun/TypeChecker.mli index 286691a..049bcb4 100644 --- a/lib/miniFun/TypeChecker.mli +++ b/lib/miniFun/TypeChecker.mli @@ -1 +1,7 @@ val typecheck : Types.t_exp -> (Types.ftype, Types.error) result + +val unify : Types.intermediaryTypes -> Types.intermediaryTypes -> (Types.substitution, Types.error) result + +module VariableSet : Set.S with type elt = string + +val freevariables : Types.intermediaryTypes -> VariableSet.t diff --git a/lib/miniFun/Types.ml b/lib/miniFun/Types.ml index cfb694b..167fb81 100644 --- a/lib/miniFun/Types.ml +++ b/lib/miniFun/Types.ml @@ -2,6 +2,13 @@ type variable = string module VariableMap = Map.Make(String) +type intermediaryTypes = + IntermediaryIntegerType + | IntermediaryBooleanType + | IntermediaryFunctionType of (variable option) * (intermediaryTypes list) + | IntermediaryVariableType of variable +type substitution = intermediaryTypes VariableMap.t + type ftype = IntegerType | BooleanType diff --git a/lib/miniFun/Types.mli b/lib/miniFun/Types.mli index 2cedefd..5ca1830 100644 --- a/lib/miniFun/Types.mli +++ b/lib/miniFun/Types.mli @@ -2,6 +2,13 @@ type variable = string module VariableMap : Map.S with type key = variable +type intermediaryTypes = + IntermediaryIntegerType + | IntermediaryBooleanType + | IntermediaryFunctionType of (variable option) * (intermediaryTypes list) + | IntermediaryVariableType of variable +type substitution = intermediaryTypes VariableMap.t + type ftype = IntegerType | BooleanType