summary refs log tree commit diff
path: root/source/xi_lib/types.ml
blob: 398b2e9c03093d3967ee7b84d575fc21db8558d9 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
type normal_type
  = TP_Int
  | TP_Bool
  | TP_Array of normal_type

let rec string_of_normal_type = function
  | TP_Int -> "int"
  | TP_Bool -> "bool"
  | TP_Array el -> string_of_normal_type el ^ "[]"

(* Rozszerzony typ
 * Lista 0 elementów - unit
 * Lista 1 element - normalny typ
 * Lista n elementów - krotka
 *)
type extended_type = normal_type list

let string_of_extended_type xs =
    String.concat ", " @@ List.map string_of_normal_type xs

type result_type
  = RT_Unit
  | RT_Void

type env_type
  = ENVTP_Var of normal_type
  | ENVTP_Fn of extended_type * extended_type

let string_of_env_type = function
  | ENVTP_Var t -> string_of_normal_type t
  | ENVTP_Fn (xs, []) -> Format.sprintf "fn(%s)"
    (string_of_extended_type xs)
  | ENVTP_Fn (xs, rs) -> Format.sprintf "fn(%s) -> (%s)"
    (string_of_extended_type xs)
    (string_of_extended_type rs)

module TypingEnvironment = struct

  (* W przeciwieństwie do specyfikacji nie trzymamy specjalnej zmiennej `ro`
    * oznaczającej return type. Trzymamy to w oddzielnym polu dla
    *  przejrzystości.
    *)

  type t = 
    { mapping: env_type Ast.IdMap.t
    ; return: extended_type option
    }

  (* Dodaj do środowiska.
    * Zwraca nowe środowisko oraz informację czy dany klucz `x` już nie był
    * w kontekście. Jak był to nic nie zwracamy, klient zapyta o starą wartość
    * by zgłosić komunikat o błędzie. Ta informacja o dodawaniu jest używana
    * aby wykrywać przykrywanie zmiennych.
    *)
  let add (x:Ast.identifier) (t:env_type) (env:t) =
    if Ast.IdMap.mem x env.mapping then
      env ,
      false
    else
      {env with mapping=Ast.IdMap.add x t env.mapping},
      true

  (* Pobranie, zwraca option *)
  let lookup x (t : t) = Ast.IdMap.find_opt x t.mapping

  (* Gdy wiemy że klucz jest w bazie i nie chce nam się rozpatrywać czy było
    * Some czy None *)
  let lookup_unsafe x t = 
    match lookup x t with
    | None -> failwith "TypingEnvironment.lookup_unsafe failed"
    | Some x -> x

  let empty : t = { mapping=Ast.IdMap.empty; return=None}

  let set_return t r = {t with return=Some r}

  let get_return t = t.return
end