Skip to content
This repository
Newer
Older
100644 84 lines (70 sloc) 2.469 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 module Printer =
19 struct
20 let code_uids fmt code =
21 Format.fprintf fmt "/* printer: --print code */@\n@\n" ;
22 OpaPrint.ident#code fmt code ;
23 Format.fprintf fmt "@."
24
25 let full_ident fmt code =
26 Format.fprintf fmt "/* printer: --print full_ident */@\n@\n" ;
27 OpaPrint.full_ident#code fmt code ;
28 Format.fprintf fmt "@."
29
30 let readable_ident fmt code =
31 Format.fprintf fmt "/* printer: --print readable_ident */@\n@\n" ;
32 OpaPrint.readable_ident#code fmt code ;
33 Format.fprintf fmt "@."
34
35 let code_nonuid fmt code =
36 Format.fprintf fmt "/* printer: --print code */@\n@\n" ;
37 OpaPrint.string#code fmt code ;
38 Format.fprintf fmt "@."
39
40 let size fmt code =
41 Format.fprintf fmt
42 "%d declarations@\n%d nodes@."
43 (OpaWalk.Code.length code)
44 (OpaWalk.Code.size code)
45 end
46
47 let define = PassHandler.define_printer
48 let code_id = define "code"
49 let full_ident_id = define "full_ident"
50 let readable_ident_id = define "readable_ident"
51 let size_id = define "size"
52 (* let declaration_id = define "declaration" *)
53 (* let annotation_id = define "annotation" *)
54 (* let tracked_id = define "tracked" *)
55
56 let printers_uids extract options =
57 ignore(options);
58 let make fct fmt env = fct fmt (extract env) in
59 [
60 code_id, make Printer.code_uids;
61 full_ident_id, make Printer.full_ident;
62 readable_ident_id, make Printer.readable_ident;
63 size_id, make Printer.size;
64 ]
65
66 let printers_nonuid extract options =
67 ignore(options);
68 let make fct fmt env = fct fmt (extract env) in
69 [
70 code_id, make Printer.code_nonuid;
71 size_id, make Printer.size;
72 ]
73
74 module Tracker =
75 struct
76
77 end
78
79 let trackers (* extract *) _ _ =
80 (* let make fct fmt env = fct fmt (extract env) in *)
81 [
82 (* directive_id, make Tracker.directive ; *)
83 (* val_id, make Tracker.val_ ; *)
84 ]
Something went wrong with that request. Please try again.