lci/lib/miniFun/Types.ml

type variable = string

let globalIdentifier = ref 1

module VariableMap = Map.Make(String)
module VariableSet = Set.Make(String)

(* -------------------------------------------------------------------------- *)
(*                      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
  | UnknownType
  | TupleType of ftype * ftype
  | FunctionType of ftype * ftype

type t_exp =
    Integer of int                                  (* x := a *)
  | Boolean of bool                                 (* v *)
  | Variable of variable                            (* x *)
  | Tuple of t_exp * t_exp                          (* (a, b) *)
  | Function of variable * ftype * t_exp            (* lambda x: t. x *)
  | Application of t_exp * t_exp                    (* x x *)
  | Plus of t_exp * t_exp                           (* x + x *)
  | Minus of t_exp * t_exp                          (* x - x *)
  | Times of t_exp * t_exp                          (* x * x *)
  | Division of t_exp * t_exp                       (* x / x *)
  | Modulo of t_exp * t_exp                         (* x % x *)
  | Power of t_exp * t_exp                          (* x ^ x *)
  | PowerMod of t_exp * t_exp * t_exp               (* (x ^ x) % x *)
  | Rand of t_exp                                   (* rand(0, x) *)
  | BAnd of t_exp * t_exp                           (* x && x *)
  | BOr of t_exp * t_exp                            (* x || x *)
  | BNot of t_exp                                   (* not x *)
  | First of t_exp                                  (* fst x *)
  | Second of t_exp                                 (* scn x *)
  | Cmp of t_exp * t_exp                            (* x == x *)
  | CmpLess of t_exp * t_exp                        (* x < x *)
  | CmpLessEq of t_exp * t_exp                      (* x <= x *)
  | CmpGreater of t_exp * t_exp                     (* x > x *)
  | CmpGreaterEq of t_exp * t_exp                   (* x >= x *)
  | IfThenElse of t_exp * t_exp * t_exp             (* if b then c else c *)
  | LetIn of variable * t_exp * t_exp               (* let x = x in x *)
  | LetFun of variable * variable * ftype * t_exp * t_exp
                                                    (* let rec x. y: t. x in x*)

type permitted_values =
    IntegerPermitted  of int
  | BooleanPermitted  of bool
  | TuplePermitted    of permitted_values * permitted_values
  | FunctionPermitted of closure
and closure = {
  input: variable;
  body: t_exp;
  assignments: permitted_values VariableMap.t;
  recursiveness: variable option
}

type memory = {
  assignments: permitted_values VariableMap.t
}


type base_error = [
    `AbsentAssignment of string
  | `WrongType of string
]

type typechecking_error = [
  | base_error
  | `WrongTypeSpecification of string
]

type polytypechecking_error = [
  | typechecking_error
  | `RecursionNotImplemented of string
]


type error = [
  | base_error
  | `DivisionByZero of string
]