unify function

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