Skip to content
This repository
Newer
Older
100644 276 lines (203 sloc) 6.623 kb
fccc6851 »
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 (**
19 OpaTop main starter.
20 @author Mathieu Barbin.
21 *)
22
23 (**
24 This file is the common main for any opatop using external loaders.
25 The code of an opatop should be:
26 {[
27 (* Generated opatop with opa-plugin-maker *)
28 let _ =
29 Loader1.Self.self_store ();
30 Loader2.Self.self_store ();
31 OpaTopMain.main ()
32 ]}
33 where [Loader_] are the loader built by [bslregister] from the
34 external libraries (bsl plugins).
35 *)
36
37 module String = Base.String
38
39 (** {6 Options} *)
40 (**
41 Since opatop is a runtime tool, linked with the application server suite,
42 it shares the option system of servers.
43
44 In this way, we may use the command line options to set options of weblib,
45 the db, etc...
46
47 But the interpreter is also a compiler like tool, because it contains some
48 rewritting rules, and trate code. So, some options are also binded there
49 (like OManager, etc..)
50 *)
51
52 (*
53 Following the guidelines for Arguments.
54 Cf also in :
55 - libbsl/bslbrowser.ml
56 - libbsl/bslregister.ml
57
58 TODO: apply the same guidelines in every applications.
59 *)
60
61
62 (* d *)
63
64
65 let do_init = ref true
66 let do_input = ref false
67
68
69 let dump_files = ref false
70 let dump_stdlib = ref false
71
72 (* f *)
73
74
75 let fatal = ref false
76
77
78 (* g *)
79
80
81 let greedy = ref false
82
83
84 (* u *)
85
86
87 let user_files = MutableList.create ()
88 let user_files_add opafile = MutableList.add user_files opafile
89
90
91 (* parse *)
92
93 module P = OpaTopProperties
94 module Sa = ServerArg
95
96 let (!>) = Base.Format.sprintf
97
98 (**
99 Spec list for parsing.
100 *)
101 let spec = [
102
103
104 (* - *)
105
106
107 ["--"],
108 (fun () -> Sa.skip_all),
109 "",
110 !>
111 "Pass any remaining options to the application" ;
112
113
114 (* d *)
115
116
117 (* FIXME: use a ppdebug variable instead of this hacky option *)
118 ["--dddbgen"],
119 Sa.func Sa.unit (fun () () -> P.dddbgen_set true),
120 "",
121 !>
122 "Start with dbgen-dumper on" ;
123
124
125 ["--dump-files"; "-e"],
126 Sa.func Sa.unit (fun () () -> dump_files := true),
127 "",
128 !>
129 "Dump (types + values) the loaded files" ;
130
131
132 ["--dump-stdlib"],
133 Sa.func Sa.unit (fun () () -> dump_stdlib := true),
134 "",
135 !>
136 "Dump (types + values) the stdlib" ;
137
138
139 (* f *)
140
141 ["--fatal-mode"],
142 Sa.func Sa.unit (fun () () -> fatal := true),
143 "",
144 !>
145 "Loading stdin, stop the interpreter with the first error. This is the default behavior for the stdlib and files";
146
147
148 (* g *)
149
150
151 ["--greedy"],
152 Sa.func Sa.unit (fun () () -> greedy := true),
153 "",
154 !>
155 "Loading stdlib and files, evaluate as much as possible and do not stop at the first error. This is the default behavior for stdin";
156
157
158 (* i *)
159
160
161 ["--input"],
162 Sa.func Sa.unit (fun () () -> do_input := true),
163 "",
164 !>
165 "After loading given file(s), don't quit and continue with stdin" ;
166
167
168 (* n *)
169
170
171 ["--no-assert"],
172 Sa.func Sa.unit (fun () () -> P.assert_set false),
173 "",
174 !>
175 "Start with assert off" ;
176
177
178 [ "--no-stdlib" ],
179 Sa.func Sa.unit (fun () () -> do_init := false),
180 "",
181 !>
182 "Do not load the opalight stdlib" ;
183
184
185 (* o *)
186
187
188 ["--opa"],
189 Sa.func Sa.string (fun () -> user_files_add),
190 "<file>",
191 !>
192 "Load a file as an opa source" ;
193
194 (* v *)
195
196 ["--value-restriction"],
197 Sa.func_opt Sa.string (fun () s ->
198 match s with
199 | "disabled" -> P.value_restriction_set `disabled; Some ()
200 | "normal" -> P.value_restriction_set `normal; Some ()
201 | "strict" -> P.value_restriction_set `strict; Some ()
202 | _ -> None),
203 "{disabled|normal|strict}",
204 !>
205 "Set the kind of value restriction" ;
206
207 ]
208 @ ( Sa.import_arg_options OManager.Arg.options )
209 @ ( Sa.import_arg_options [OManager.Arg.version "opatop"] )
210 @ ( Sa.import_arg_options (WarningClass.Arg.options ()) )
211
212 (**
213 Anon function for non --option arguments
214 *)
215 let anon_fun opafile =
216 if String.is_suffix ".opa" opafile then user_files_add opafile else (
217 if String.is_prefix "-" opafile then (
218 OManager.printf "Invalid option @{<bright>%S@}@\n" opafile;
219 OManager.printf "@[<2>@{<bright>Hint@}:@\nTry @{<bright>--help@} for more details.@]@\n";
220 ()
221 ) else (
222 OManager.printf "Argument @{<bright>%S@} does not have the @{<bright>.opa@} extension@\n" opafile;
223 OManager.printf "@[<2>@{<bright>Hint@}:@\nIf this is really an opa file,@ you can use the option@ @{<bright>--opa %s@}@\nTry @{<bright>--help@} for more details.@]@\n" opafile;
224 ()
225 );
226 OManager.error "command line error"
227 )
228
229 (** {6 Main} *)
230
231 (**
232 The main of the console tool.
233 *)
234 let main () =
235 (try ServerArg.filter () (ServerArg.make_parser ~final:true "opatop options" spec)
236 with Exit -> exit 1);
237 ServerArg.filter () (ServerArg.fold (ServerArg.func ServerArg.anystring (fun () -> anon_fun)));
238 OpaTopEnv.set_directive_handler OpaTopDirectives.handler;
239 let env = OpaTopEnv.start () in
240 (* for init and user files, be greedy only if the option as asked *)
241 P.greedy_set !greedy;
242 P.dump_set !dump_stdlib;
243 (* init *)
244 let env =
245 if !do_init then (
246 let loaders = Option.default [] (BslPluginTable.last_finalize ()) in
247 let fold env loader =
248 let fold env (filename, contents) =
249 OManager.verbose "load file @{<bright>%S@} ..." filename;
250 let env = OpaTopEnv.set_filename env filename in
251 let env = OpaTopEnv.input_contents env contents in
252 env
253 in
254 List.fold_left fold env loader.BslPluginInterface.opa_code
255 in
256 let env = List.fold_left fold env loaders in
257 env
258 ) else env
259 in
260 (* user files *)
261 P.dump_set !dump_files;
262 let env =
263 MutableList.fold_left OpaTopEnv.input_file env user_files
264 in
265 (* for input, be greedy, unless the option fatal was asked *)
266 P.greedy_set (not !fatal);
267 (* input *)
268 if MutableList.length user_files = 0 || !do_input then (
269 P.dump_set true;
270 let env = OpaTopEnv.set_filename env "stdin" in
271 let _ = OpaTopEnv.input_loop env stdin in
272 print_newline ()
273 ) else (
274 ()
275 )
Something went wrong with that request. Please try again.