Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 124 lines (90 sloc) 3.639 kB
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18
19
20 (* Typevar *)
21
22
23 (* type typevarsscope_elt = Type of TypeVar.t | Row of RowVar.t | Col of ColVar.t *)
24
25 (* module Arg = *)
26 (* struct *)
27 (* type elt = Type of TypeVar.t | Row of RowVar.t | Col of ColVar.t *)
28
29 (* (\* TypeVarHash --> Hash basé global stamp (global stamp, local, name, descr) *\) *)
30
31 (* module HashVarstlb = Hashtbl.Make( *)
32 (* struct *)
33 (* type t = elt *)
34 (* let equal x y = *)
35 (* match x,y with *)
36 (* | Type t, Type t' -> TypeVar.equal t t' *)
37 (* | Row r, Row r' -> RowVar.equal r r' *)
38 (* | Col c, Col c' -> ColVar.equal c c' *)
39 (* | _ -> false *)
40 (* let hash x = *)
41 (* (\* TODO: a better hash based on stamp *\) *)
42 (* match x with *)
43 (* | Type _ *)
44 (* | Row _ *)
45 (* | Col _ -> Hashtbl.hash x *)
46 (* end *)
47 (* ) *)
48
49 (* type 'a block = 'a HashVarstlb.t *)
50
51
52 (* let create n = HashVarstlb.create n *)
53
54 (* let fold f = HashVarstlb.fold f *)
55
56 (* let bind b e v = HashVarstlb.add b e v *)
57 (* let unbind b e = HashVarstlb.remove b e *)
58
59 (* let find b e = *)
60 (* try *)
61 (* Some (HashVarstlb.find b e) *)
62 (* with *)
63 (* | Not_found -> None *)
64
65 (* end *)
66
67
68 (* module TypeVarsScope = ImperativeScope.Make(Arg) *)
69
70
71 module TypeVarsScope(Arg : sig type id end) =
72 struct
73 type ident = Arg.id
74 type ty_elt = ETy of ident | ERow of ident | ECol of ident
75 module IdentScope = ImperativeScope.Default(struct type elt = ty_elt end)
76 type ty_vars = VTy of QmlAst.TypeVar.t | VRow of QmlAst.RowVar.t | VCol of QmlAst.ColVar.t
77
78 let create n = IdentScope.create n
79 let reset s = IdentScope.reset s
80
81 let bind_typevar s e v = IdentScope.bind s (ETy e) (VTy v)
82 let bind_rowvar s e v = IdentScope.bind s (ERow e) (VRow v)
83 let bind_colvar s e v = IdentScope.bind s (ECol e) (VCol v)
84
85 let add_local_scope s = IdentScope.push s
86 let remove_local_scope s = IdentScope.pop s
87
88 let get_local_vars s =
89 let init_acc = ([], [], []) in
90 let fold_fun _e v (acc_ty, acc_row, acc_col) =
91 match v with
92 | VTy v -> (v::acc_ty, acc_row, acc_col)
93 | VRow v -> (acc_ty, v::acc_row, acc_col)
94 | VCol v -> (acc_ty, acc_row, v::acc_col)
95 in
96 IdentScope.fold fold_fun s init_acc
97
98 let find_typevar_opt s ident =
99 match IdentScope.find_opt s (ETy ident) with
100 | Some(VTy v) -> Some v
101 | _ -> None
102
103 let find_rowvar_opt s ident =
104 match IdentScope.find_opt s (ERow ident) with
105 | Some(VRow v) -> Some v
106 | _ -> None
107
108 let find_colvar_opt s ident =
109 match IdentScope.find_opt s (ECol ident) with
110 | Some(VCol v) -> Some v
111 | _ -> None
112
113 end
114
115
116 (* TODO: *)
117
118 (* 1) fresh.ml, vérifier l'histoire du quadruplet *)
119 (* 1.1) créer FreshHash à partir HashMake de caml, spécialisé pour les fresh basé sur global stam *)
120 (* 2) creer TypeVarHash en utilisant FreshHash (pareil pour Col, Row) *)
121 (* 3) utilser TypeVarHash ici au lieu de Hash *)
122 (* 4) inserer le scope dans opa2qml *)
123 (* 5) tester dasn qmltop *)
Something went wrong with that request. Please try again.