Adding simple Algorithm W implementation (no recursive functions)

lib/miniFun/Types.ml

@@ -5,18 +5,79 @@ let globalIdentifier = ref 1
 module VariableMap = Map.Make(String)
 module VariableSet = Set.Make(String)
 
-type ftype =
+(* -------------------------------------------------------------------------- *)
+(*                      polimporphic type checking types                      *)
+(* -------------------------------------------------------------------------- *)
+
+type id = int
+type level = int
+
+type type_f =
+    IntegerTypeP
+  | BooleanTypeP
+  | TupleTypeP of type_f * type_f
+  | VariableTypeP of variable_type ref
+  | FunctionTypeP of type_f * type_f
+  | ApplicationP of type_f * type_f
+and variable_type =
+    Unbound of id * level
+  | Link of type_f
+  | Generic of id
+
+type env = type_f VariableMap.t
+module IntegerMap = Map.Make(Int)
+
+let pp_type_f (ty: type_f) : string =
+  let id_name_map = ref IntegerMap.empty in
+  let count = ref 0 in
+  let next_name () =
+    let i = !count in
+    incr count;
+    Utility.from_int_to_string i
+  in
+  let rec aux is_simple ty =
+    match ty with
+    | IntegerTypeP -> "Int"
+    | BooleanTypeP -> "Bool"
+    | TupleTypeP (ty1, ty2) ->
+      "(" ^ aux is_simple ty1 ^ ", " ^ aux is_simple ty2 ^ ")"
+    | ApplicationP (ty, ty_arg) ->
+      aux true ty ^ "(" ^ aux false ty_arg ^ ")"
+    | FunctionTypeP (ty_arg, ty) ->
+      let ty_arg_str = aux true ty_arg in
+      let ty_str = aux false ty in
+      let str = ty_arg_str ^ " -> " ^ ty_str in
+      if is_simple then "(" ^ str ^ ")" else str
+    | VariableTypeP {contents = Generic id} -> (
+        match IntegerMap.find_opt id !id_name_map with
+        | Some a -> a
+        | None ->
+          let name = next_name () in
+          id_name_map := IntegerMap.add id name !id_name_map;
+          name
+      )
+    | VariableTypeP {contents = Unbound (id, _)} ->
+      "_" ^ string_of_int id
+    | VariableTypeP {contents = Link ty} ->
+      aux is_simple ty
+  in
+  let ty_str = aux false ty in
+  if !count > 0 then
+    let var_names =
+      IntegerMap.fold (fun _ value acc -> value :: acc) !id_name_map []
+    in
+    "∀ " ^ (String.concat " " (List.sort String.compare var_names))
+    ^ ", " ^ ty_str
+  else
+    ty_str
+
+(* -------------------------------------------------------------------------- *)
+
+type ftype = (* type used for specification *)
     IntegerType
   | BooleanType
   | TupleType of ftype * ftype
-  | PolimorphicType of string
   | FunctionType of ftype * ftype
-type fsubstitution = (* goes from polimorphic types to types *)
-  ftype VariableMap.t
-type fenvironment = (* goes from variables to types *)
-  ftype VariableMap.t
-type typingshape = (* tuple of a simple type environment and a simple type *)
-  fenvironment * ftype
 
 type t_exp =
     Integer of int                                  (* x := a *)