Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 319 lines (240 sloc) 8.125 kb
fccc685 Initial open-source release
MLstate authored
1 (*
fdc8b55 @OpaOnWindowsNow [fix] opatop: init lib with classic syntax
OpaOnWindowsNow authored
2 Copyright © 2011, 2012 MLstate
fccc685 Initial open-source release
MLstate authored
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 )
84c2f7f @BourgerieQuentin [fix] compilers: derived compiler should also handle syntax options.
BourgerieQuentin authored
211 @ ( Sa.import_arg_options OpaSyntax.Args.options )
fccc685 Initial open-source release
MLstate authored
212
c6557db @BourgerieQuentin [enhance] opatop: Added typer warnings to opatop
BourgerieQuentin authored
213
214 (**
215 Loading opatop warnings
216 *)
217 let _ =
218 let warning_set =
219 let s = WarningClass.Set.create () in
220 (* let (!+) w = WarningClass.Set.add s w in *)
221 let (!++) s' = WarningClass.Set.add_set s s' in
222 !++ QmlTyperWarnings.warning_set;
223 s
224 in
225 WarningClass.load_set warning_set
226
fccc685 Initial open-source release
MLstate authored
227 (**
228 Anon function for non --option arguments
229 *)
230 let anon_fun opafile =
231 if String.is_suffix ".opa" opafile then user_files_add opafile else (
232 if String.is_prefix "-" opafile then (
233 OManager.printf "Invalid option @{<bright>%S@}@\n" opafile;
234 OManager.printf "@[<2>@{<bright>Hint@}:@\nTry @{<bright>--help@} for more details.@]@\n";
235 ()
236 ) else (
237 OManager.printf "Argument @{<bright>%S@} does not have the @{<bright>.opa@} extension@\n" opafile;
238 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;
239 ()
240 );
241 OManager.error "command line error"
242 )
243
244 (** {6 Main} *)
245
fdc8b55 @OpaOnWindowsNow [fix] opatop: init lib with classic syntax
OpaOnWindowsNow authored
246
247 let with_classic_syntax f =
248 let opa_parser = (!OpaSyntax.Args.r).OpaSyntax.Args.parser in
249 (* the libs of opatop are still in classic syntax *)
250 OpaSyntax.Args.r := {!OpaSyntax.Args.r with OpaSyntax.Args.parser=OpaSyntax.Classic};
251 let v = f () in
252 OpaSyntax.Args.r := {!OpaSyntax.Args.r with OpaSyntax.Args.parser=opa_parser};
253 v
254
fccc685 Initial open-source release
MLstate authored
255 (**
256 The main of the console tool.
257 *)
258 let main () =
259 (try ServerArg.filter () (ServerArg.make_parser ~final:true "opatop options" spec)
260 with Exit -> exit 1);
261 ServerArg.filter () (ServerArg.fold (ServerArg.func ServerArg.anystring (fun () -> anon_fun)));
262 OpaTopEnv.set_directive_handler OpaTopDirectives.handler;
263 let env = OpaTopEnv.start () in
264 (* for init and user files, be greedy only if the option as asked *)
265 P.greedy_set !greedy;
266 P.dump_set !dump_stdlib;
267 (* init *)
268 let env =
fdc8b55 @OpaOnWindowsNow [fix] opatop: init lib with classic syntax
OpaOnWindowsNow authored
269 (* the libs of opatop are still in classic syntax *)
270 if !do_init then with_classic_syntax (fun () ->
fccc685 Initial open-source release
MLstate authored
271 let loaders = Option.default [] (BslPluginTable.last_finalize ()) in
272 let fold env loader =
273 let fold env (filename, contents) =
274 OManager.verbose "load file @{<bright>%S@} ..." filename;
275 let env = OpaTopEnv.set_filename env filename in
276 let env = OpaTopEnv.input_contents env contents in
277 env
278 in
279 List.fold_left fold env loader.BslPluginInterface.opa_code
280 in
281 let env = List.fold_left fold env loaders in
282 env
283 ) else env
284 in
285 (* user files *)
286 P.dump_set !dump_files;
287 let env =
288 MutableList.fold_left OpaTopEnv.input_file env user_files
289 in
290 (* for input, be greedy, unless the option fatal was asked *)
291 P.greedy_set (not !fatal);
292 (* input *)
293 if MutableList.length user_files = 0 || !do_input then (
f4b7752 [doc] opatop: disclaimers about experimental status
François-Régis Sinot authored
294 OManager.oformatter := Format.std_formatter;
295 OManager.this_is_tool ~force:true "opatop";
9529343 [enhance] manpages: added manpage generator for opatop
Mathieu Baudet authored
296 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
297 OManager.oformatter := Format.err_formatter;
fccc685 Initial open-source release
MLstate authored
298 P.dump_set true;
299 let env = OpaTopEnv.set_filename env "stdin" in
300 let _ = OpaTopEnv.input_loop env stdin in
301 print_newline ()
302 ) else (
303 ()
304 )
9529343 [enhance] manpages: added manpage generator for opatop
Mathieu Baudet authored
305
306 (** Output a manpage file *)
307 let write_manpage file =
308 ServerArg.write_simple_manpage
309 ~cmdname:"opatop"
310 ~summary:"The Opa top-level"
311 ~section:1
312 ~centerheader:"Opa Manual"
313 ~synopsis:"opatop [options]"
314 ~description:"Opatop is an experimental interpretation loop for opa. Type '#help;;' to know more."
315 ~options:spec
316 ~other:["NOTE","Opatop also accept some options inherited from the Opa platform. Run 'opatop --help' for details."]
317 file
318
Something went wrong with that request. Please try again.