Skip to content
This repository
Newer
Older
100644 69 lines (62 sloc) 2.615 kb
fccc6851 » MLstate
2011-06-21 Initial open-source release
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 (* shorthands *)
19 module P = Passes
20 module Q = QmlAst
21
22 let same o1 o2 =
23 match (o1, o2) with
24 | (None, None)
25 | ((Some _), (Some _)) -> true
26 | (None, (Some _))
27 | ((Some _), None) -> false
28
29 let compare_annotmap original_annotmap correct_annotmap code =
30 let f label =
31 let annot = Annot.annot label in
32 let pos = Annot.pos label in
33 let tsc_gen_opt1 = QmlAnnotMap.find_tsc_opt annot original_annotmap in
34 let tsc_gen_opt2 = QmlAnnotMap.find_tsc_opt annot correct_annotmap in
35 let tsc_inst_opt1 = QmlAnnotMap.find_tsc_inst_opt annot original_annotmap in
36 let tsc_inst_opt2 = QmlAnnotMap.find_tsc_inst_opt annot correct_annotmap in
37 let _ty_opt1 = QmlAnnotMap.find_ty_opt annot original_annotmap in
38 let _ty_opt2 = QmlAnnotMap.find_ty_opt annot correct_annotmap in
39 let annot_int = Annot.to_int annot in
40 if not (same tsc_gen_opt1 tsc_gen_opt2) then
41 if tsc_gen_opt1 = None then
42 OManager.printf
43 "%a-%d@\n No tsc_gen in the computed annotmap@."
44 FilePos.pp_pos pos annot_int
45 else
46 OManager.printf
47 "%a-%d@\n Tsc_gen in the computed annotmap@."
48 FilePos.pp_pos pos annot_int;
49 if not (same tsc_inst_opt1 tsc_inst_opt2) then
50 if tsc_inst_opt1 = None then
51 OManager.printf
52 "%a-%d@\n No tsc_inst in the computed annotmap@."
53 FilePos.pp_pos pos annot_int
54 else
55 OManager.printf
56 "%a-%d@\n Tsc_inst in the computed annotmap@."
57 FilePos.pp_pos pos annot_int in
58 QmlAstWalk.CodeExpr.iter
59 (QmlAstWalk.ExprPatt.iter
60 (fun expr -> f (QmlAst.Label.expr expr))
61 (fun pat -> f (QmlAst.Label.pat pat)))
62 code
63
64 let process_code env =
65 let typed_env = Pass_Typing.process_code ~save:false env in
66 let original_annotmap = env.P.typerEnv.QmlTypes.annotmap in
67 let correct_annotmap = typed_env.P.typerEnv.QmlTypes.annotmap in
68 compare_annotmap original_annotmap correct_annotmap env.P.qmlAst;
69 env
Something went wrong with that request. Please try again.