/
qmlTypeVarsScope.ml
123 lines (90 loc) · 3.55 KB
/
qmlTypeVarsScope.ml
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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
(*
Copyright © 2011 MLstate
This file is part of OPA.
OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.
OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.
You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
(* Typevar *)
(* type typevarsscope_elt = Type of TypeVar.t | Row of RowVar.t | Col of ColVar.t *)
(* module Arg = *)
(* struct *)
(* type elt = Type of TypeVar.t | Row of RowVar.t | Col of ColVar.t *)
(* (\* TypeVarHash --> Hash basé global stamp (global stamp, local, name, descr) *\) *)
(* module HashVarstlb = Hashtbl.Make( *)
(* struct *)
(* type t = elt *)
(* let equal x y = *)
(* match x,y with *)
(* | Type t, Type t' -> TypeVar.equal t t' *)
(* | Row r, Row r' -> RowVar.equal r r' *)
(* | Col c, Col c' -> ColVar.equal c c' *)
(* | _ -> false *)
(* let hash x = *)
(* (\* TODO: a better hash based on stamp *\) *)
(* match x with *)
(* | Type _ *)
(* | Row _ *)
(* | Col _ -> Hashtbl.hash x *)
(* end *)
(* ) *)
(* type 'a block = 'a HashVarstlb.t *)
(* let create n = HashVarstlb.create n *)
(* let fold f = HashVarstlb.fold f *)
(* let bind b e v = HashVarstlb.add b e v *)
(* let unbind b e = HashVarstlb.remove b e *)
(* let find b e = *)
(* try *)
(* Some (HashVarstlb.find b e) *)
(* with *)
(* | Not_found -> None *)
(* end *)
(* module TypeVarsScope = ImperativeScope.Make(Arg) *)
module TypeVarsScope(Arg : sig type id end) =
struct
type ident = Arg.id
type ty_elt = ETy of ident | ERow of ident | ECol of ident
module IdentScope = ImperativeScope.Default(struct type elt = ty_elt end)
type ty_vars = VTy of QmlAst.TypeVar.t | VRow of QmlAst.RowVar.t | VCol of QmlAst.ColVar.t
let create n = IdentScope.create n
let reset s = IdentScope.reset s
let bind_typevar s e v = IdentScope.bind s (ETy e) (VTy v)
let bind_rowvar s e v = IdentScope.bind s (ERow e) (VRow v)
let bind_colvar s e v = IdentScope.bind s (ECol e) (VCol v)
let add_local_scope s = IdentScope.push s
let remove_local_scope s = IdentScope.pop s
let get_local_vars s =
let init_acc = ([], [], []) in
let fold_fun _e v (acc_ty, acc_row, acc_col) =
match v with
| VTy v -> (v::acc_ty, acc_row, acc_col)
| VRow v -> (acc_ty, v::acc_row, acc_col)
| VCol v -> (acc_ty, acc_row, v::acc_col)
in
IdentScope.fold fold_fun s init_acc
let find_typevar_opt s ident =
match IdentScope.find_opt s (ETy ident) with
| Some(VTy v) -> Some v
| _ -> None
let find_rowvar_opt s ident =
match IdentScope.find_opt s (ERow ident) with
| Some(VRow v) -> Some v
| _ -> None
let find_colvar_opt s ident =
match IdentScope.find_opt s (ECol ident) with
| Some(VCol v) -> Some v
| _ -> None
end
(* TODO: *)
(* 1) fresh.ml, vérifier l'histoire du quadruplet *)
(* 1.1) créer FreshHash à partir HashMake de caml, spécialisé pour les fresh basé sur global stam *)
(* 2) creer TypeVarHash en utilisant FreshHash (pareil pour Col, Row) *)
(* 3) utilser TypeVarHash ici au lieu de Hash *)
(* 4) inserer le scope dans opa2qml *)
(* 5) tester dasn qmltop *)