Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 294 lines (219 sloc) 7.345 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 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"] )
ee9137a [cleanup] options: removed useless () argument to cmdline options
Mathieu Baudet authored
210 @ ( Sa.import_arg_options WarningClass.Arg.options )
fccc685 Initial open-source release
MLstate authored
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 (
f4b7752 [doc] opatop: disclaimers about experimental status
François-Régis Sinot authored
269 OManager.oformatter := Format.std_formatter;
270 OManager.this_is_tool ~force:true "opatop";
9529343 [enhance] manpages: added manpage generator for opatop
Mathieu Baudet authored
271 OManager.printf "This is an experimental interpretation loop for opa. Type '#help;;' to know more.@\n";
f4b7752 [doc] opatop: disclaimers about experimental status
François-Régis Sinot authored
272 OManager.oformatter := Format.err_formatter;
fccc685 Initial open-source release
MLstate authored
273 P.dump_set true;
274 let env = OpaTopEnv.set_filename env "stdin" in
275 let _ = OpaTopEnv.input_loop env stdin in
276 print_newline ()
277 ) else (
278 ()
279 )
9529343 [enhance] manpages: added manpage generator for opatop
Mathieu Baudet authored
280
281 (** Output a manpage file *)
282 let write_manpage file =
283 ServerArg.write_simple_manpage
284 ~cmdname:"opatop"
285 ~summary:"The Opa top-level"
286 ~section:1
287 ~centerheader:"Opa Manual"
288 ~synopsis:"opatop [options]"
289 ~description:"Opatop is an experimental interpretation loop for opa. Type '#help;;' to know more."
290 ~options:spec
291 ~other:["NOTE","Opatop also accept some options inherited from the Opa platform. Run 'opatop --help' for details."]
292 file
293
Something went wrong with that request. Please try again.