Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 947 lines (691 sloc) 22.357 kB
fccc685 Initial open-source release
MLstate authored
1 (*
5f95972 @Aqua-Ye [feature] iconv: binded iconv in Opa
Aqua-Ye 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 This application is the register generator, used as a preprocessor
20 on all files including to build the Bypass Standard Library.
21
22 @author Mathieu Barbin
23 @author Mehdi Bouaziz
24 *)
25
26 (*
27 <!> The layout of this file can seems weird,
28 it is a prototype for optimizing maintenace as well as git conflicts
29 and commit diffing. WIP, RFC
30 *)
31
32 (* TODO: refactoring of libbase *)
33 (* open Base is BAD, hoisting modules *)
34 module Arg = Base.Arg
35 module Format = Base.Format
36 module String = Base.String
37
38 (* shorthand *)
39 module BI = BslInterface
40 module BR = BslRegisterLib
41
42 let (|>) x f = f x
43
44 let opp_extension = BslConvention.Extension.plugin
45 let cwd = Sys.getcwd ()
46 let build_dir = ref ""
47 let opp_dir = ref ""
48 let is_default_lib = ref true
49 let bsl_pref = ref "default"
50
51 (**
52 A boolean to say if we want to generate the Plugin and the Loader file.
53 these files are used to link statically a plugin with an executable,
54 so that there is no need to load dynamically a .bypass file for beeing
55 able to load bypasses of a given plugin.
56
57 Currently, the static mode is used only for the opabsl, and the resulting
58 plugin is linked with opa.exe
59
60 The loader file can be used for interpreter in ml only (opatop)
61 to add new primitives.
62 *)
63 let static = ref false
64
65 (**
66 A boolean to say that generated files should be put in the build_dir directly,
67 without storing them in a opp directory.
68 *)
69 let no_opp = ref false
70
71 (**
72 These are the inclusion to give for compiling plugins.
73 This text will be produced in the Makefile, which will interprate shell expension like $(MY_VAR)
74 *)
75 let static_extrapaths () =
76 Printf.sprintf "-I $(%s)/%s" InstallDir.name InstallDir.lib_opa
77
78 (**
79 outputs in build_dir/libname.opp/libnameSuffix.ext
80 path to file may be absolute, in this case, produces
81 all the absolute path inside the build dir
82 *)
83 let finalize_opp_dir () =
84 opp_dir := (
85 if !no_opp then !build_dir
86 else
87 let opp = !bsl_pref ^ "." ^ opp_extension in
88 Filename.concat !build_dir opp
89 )
90
91
92 let output_prefix ?(mkdir=true) prefix filename =
93 (*
94 info about the file
95 *)
96 let dirname =
97 let d = Filename.dirname filename in
98 if d = "." then "" else d
99 in
100 let basename = Filename.basename filename in
101 let filename = prefix ^ basename in
102
103 (*
104 output directory
105 *)
106 let directory = !opp_dir in
107 let directory = Filename.concat directory dirname in
108
109 (*
110 eventually, check or create the directory
111 *)
112 if mkdir then (
113 if not (File.check_create_path directory) then
114 OManager.error "cannot create directory %s" directory
115 );
116
117 let filename = Filename.concat directory filename in
118 filename
119
120
121 module Name =
122 struct
123 let map f () =
124 output_prefix !bsl_pref f
125
126 let jskeys = map (BslConvention.Suffix.jskeys ^ ".js")
127 let loader = map (BslConvention.Suffix.loader ^ ".ml")
128 let marshalplugin = map (BslConvention.Suffix.marshalplugin ^ "." ^ BslConvention.Extension.bypass)
129 let mlruntime = map (BslConvention.Suffix.mlruntime ^ ".ml")
130 let mlruntime_mli = map (BslConvention.Suffix.mlruntime ^ ".mli")
131 let plugin = map (BslConvention.Suffix.plugin ^ ".ml")
132 end
133
134
135 (*
136 This function is used for itering opa and js generated files
137 *)
138 let prefix filename =
139 output_prefix (!bsl_pref ^ "_") filename
140
141
142 let js_code = prefix
143 let opa_code = prefix
144 let opa_interface f = (prefix f)^"i"
145
146
147 let jskeys = ref ""
148 let loader = ref ""
149 let marshalplugin = ref ""
150 let mlruntime = ref ""
151 let mlruntime_mli = ref ""
152 let plugin = ref ""
153
154 let makefile = ref "Makefile"
155 let stamp = ref "stamp"
156 let stamp_date = ref ""
157
158 let customize_lib_name name =
159 let name =
160 String.remove_suffix_if_possible ("."^BslConvention.Extension.plugin) name
161 in
162 if
5630897 [feature] stdlib: more tolerant naming of files
François-Régis Sinot authored
163 not (String.is_universal_ident name)
fccc685 Initial open-source release
MLstate authored
164 || name.[0] = '_' (* an universal ident is not empty *)
165 then
166 OManager.error (
167 "@{<bright>%S@} is not a valid plugin name@\n"^^
168 "Plugin name should be alphanumeric and start with a letter"
169 )
170 name
171 ;
172 let name = BslConvention.plugin_name name in
173
174 is_default_lib := false ;
175 bsl_pref := name ;
176 ()
177
178
179 let finalize_options () =
180 finalize_opp_dir () ;
181
182 jskeys := Name.jskeys () ;
183 loader := Name.loader () ;
184 marshalplugin := Name.marshalplugin () ;
185 mlruntime := Name.mlruntime () ;
186 mlruntime_mli := Name.mlruntime_mli () ;
187 plugin := Name.plugin () ;
188
189 makefile := output_prefix "" !makefile ;
190 stamp := output_prefix "" !stamp ;
191
192 ()
193
194
195 let spliter g =
196 List.map String.trim
461365b [cleanup] Base.String: changed String.split to a much simpler String.…
Louis Gesbert authored
197 (String.slice_chars "{} ,;" g)
fccc685 Initial open-source release
MLstate authored
198
199
200 let itersplit f sss = List.iter f (spliter sss)
201
202
203 let rename_factory src ml filename =
204 let s = if String.is_suffix ("."^ml) filename then filename else
205 (File.chop_extension filename)^"."^ml in
206 src := s
207
208
209 let rename_pair (ml, mli) src head filename =
210 let s =
211 if String.is_suffix ("."^ml) filename
212 then Filename.chop_extension filename
213 else filename in
214 src := s^"."^ml ;
215 head := s^"."^mli ;
216 ()
217
218
219 (* a *)
220
221
222 let auto_build = ref true
223
224
225 (* b *)
226
227
228 let bypass_plugins = MutableList.create ()
229 let bypass_plugins_add_file files =
230 List.iter (
231 fun file ->
232 if String.is_suffix ("." ^ BslConvention.Extension.bypass) file
233 then MutableList.add bypass_plugins (BslDynlink.MarshalPlugin file)
234 else MutableList.add bypass_plugins (BslDynlink.SharedObject file)
235 )
236 (spliter files)
237
238
239 (* c *)
240
241
242 let check_style = ref false
243
244
245 let clean = ref false
246 let clean_would_only = ref false
247
248
249 (* d *)
250
251
252 let default_iformats = ref true
253
254
255 (* e *)
256
257
258 let extrapaths = MutableList.create ()
259 let extrapaths_add d =
260 let existing_dir d = Sys.file_exists d && Sys.is_directory d in
261 let iter d =
262 if d.[0] <> '+' && not (existing_dir d)
263 then OManager.error "Option -I %S\nNo such file or directory" d
264 else (
265 let d =
266 if File.is_relative_include_path d
267 then
268 Filename.concat cwd d
269 else d
270 in
271 MutableList.add extrapaths d
272 )
273 in
274 List.iter iter (Arg.split d)
275
276
277 (* f *)
278
279
280 let files = MutableList.create ()
281 let files_generated = ref 0
282
283
284 (* j *)
285
286
287 let js_files = MutableList.create ()
288
6f11459 @OpaOnWindowsNow [feature] bslregister: activate js validation
OpaOnWindowsNow authored
289 let js_validator = ref (Some "js")
fccc685 Initial open-source release
MLstate authored
290 let js_validator_files = MutableList.create ()
6f11459 @OpaOnWindowsNow [feature] bslregister: activate js validation
OpaOnWindowsNow authored
291 let js_validator_files_set = ref StringSet.empty
fccc685 Initial open-source release
MLstate authored
292 let js_validator_add_file s =
293 List.iter (fun f ->
294 if not (File.is_regular f)
295 then OManager.error "cannot find file %S (js-validation)" f
296 else MutableList.add js_validator_files f)
297 (spliter s)
298
299 let js_validator_options = MutableList.create ()
300 let js_validator_add_option o =
301 MutableList.add js_validator_options o
302
303
304 (* m *)
305
306
307 let ml_flags = MutableList.create ()
308 let mlopt_flags = MutableList.create ()
309
310
311 (* r *)
312
313
314 let rename_mlruntime = rename_pair ( "ml" , "mli" ) mlruntime mlruntime_mli
315
316
317 (* u *)
318
319
320 let unsafe_js = ref false
321 let unsafe_opa = ref false
322
323
324 let plugin_inclusion file =
325 let inclusion = BslConvention.inclusion ~cwd file in
326 MutableList.add extrapaths inclusion.BslConvention.extrapath ;
327 bypass_plugins_add_file inclusion.BslConvention.plugin ;
328 ()
329
330
331 (* following guidelines for command line tools *)
332
333
334 let (!>) = Format.sprintf
335
336
337 let spec = [
338
339 (* b *)
340
341
342 "--build-dir",
343 Arg.Set_string build_dir,
344 !>
345 " Change the build directory. Default is $PWD" ;
346
347
348 (* c *)
349
350
351 "--check-style",
352 Arg.Set check_style,
353 !>
354 " Make some more check about some guidelines used in the files" ;
355
356
357 "--clean",
358 Arg.Symbol (["-n" ; "-f"], (
359 function
360 | "-f" ->
361 clean := true
362 | _ ->
363 clean := true;
364 clean_would_only := true
365 )),
366 !>
367 " With -n, it only says the files which would be cleaned, with '-f' the files are removed" ;
368
369
370 (* i *)
371
372
373 "-I",
374 Arg.String extrapaths_add,
375 !>
376 " Add path to external librairies for the compilation" ;
377
378 (* j *)
379
380 "--js-validator",
381 Arg.String (fun s -> js_validator := Some s),
382 !>
383 " Specify a js-validator (default is %a)" (Option.pp Format.pp_print_string) !js_validator ;
384
385
386 "--js-validator-file",
387 Arg.String js_validator_add_file,
388 !>
389 "<file> Add an js init file for the js-validation only" ;
390
391
392 "--js-validator-off",
393 Arg.Unit (fun () -> js_validator := None),
394 !>
395 " Disable the js validation (sad)" ;
396
397
398 "--js-validator-opt",
399 Arg.String js_validator_add_option,
400 !>
401 "<opt> Add an shell option for the the js-validator" ;
402
403
404 (* l *)
405
406
407 (* m *)
408
409
410 "--ml",
411 Arg.String (fun s -> List.iter (MutableList.add ml_flags) (Arg.split s)),
412 !>
413 "<flags> Add options for ocaml compilation (both byte and native)" ;
414
415
416 "--mlopt",
417 Arg.String (fun s -> List.iter (MutableList.add mlopt_flags) (Arg.split s)),
418 !>
419 "<flags> Add options for ocaml native compilation" ;
420
421 (* n *)
422
423 "--no-build",
424 Arg.Clear auto_build,
425 !>
426 " Do not build the plugin, just generate opp-files" ;
427
428
429 "--no-default-iformats",
430 Arg.Clear default_iformats,
431 !>
432 " Do not load default format for ##include" ;
433
434
435 "--no-opp",
436 Arg.Set no_opp,
437 !>
438 " Produces files in the build_dir directly, do not produce any opp directoy" ;
439
440
441 (* o *)
442
443
444 "-o",
445 Arg.String customize_lib_name,
446 !>
447 "<name> Specify the name of the plugin, default is %s"
448 !bsl_pref ;
449
450
451 (* p *)
452
453
454 "--plugin",
455 Arg.String plugin_inclusion,
456 !>
457 "<opp> Take the following argument as an opa plugin (opp)" ;
458
459
460 (* u *)
461
462
463 "--unsafe-js",
464 Arg.Set unsafe_js,
465 !>
466 " Activate unsafe-js mode (ignore js errors)" ;
467
468
469 "--unsafe-opa",
470 Arg.Set unsafe_opa,
471 !>
472 " Activate unsafe-opa mode (ignore opa errors)" ;
473
474 (* s *)
475
476 "--static",
477 Arg.Set static,
478 !>
479 "produces files for static linking with opa.exe (not for standard distrib)" ;
480
481 ]
482
483
484 let anon_fun file =
485 match File.extension file with
486
487 | opp when opp = BslConvention.Extension.plugin ->
488 plugin_inclusion file
489
490 | js ->
491 if js = "js"
492 then (
493 (*
494 The js files are indexed by their basename.
495 *)
6f11459 @OpaOnWindowsNow [feature] bslregister: activate js validation
OpaOnWindowsNow authored
496 let key = file in
497 if StringSet.mem key (!js_validator_files_set)
fccc685 Initial open-source release
MLstate authored
498 then
499 OManager.error (
500 "Found several js files with the same basename : @{<bright>%s@}@\n"^^
501 "@[<2>{@<bright>Hint@}:@\n"^^
502 "Perhaps the same file is passed several time in the command line@\n"^^
503 "or maybe you could rename one of the clashing javascript files@]@\n"
504 )
505 file
506 ;
6f11459 @OpaOnWindowsNow [feature] bslregister: activate js validation
OpaOnWindowsNow authored
507 js_validator_files_set := StringSet.add key (!js_validator_files_set);
fccc685 Initial open-source release
MLstate authored
508 MutableList.add js_files file
509 ) ;
510 MutableList.add files file
511
512
513 let usage_msg =
9a4a8ee [enhance] help/manpages: global pass for improving help messages of O…
Mathieu Baudet authored
514 !> "@{<bright>%s@}: Opa External Libraries Register\nUsage: %s [options] files\n"
515 Sys.argv.(0) Sys.argv.(0)
fccc685 Initial open-source release
MLstate authored
516
517
518 let parse () =
519 let spec = (
ee9137a [cleanup] options: removed useless () argument to cmdline options
Mathieu Baudet authored
520 WarningClass.Arg.options @
fccc685 Initial open-source release
MLstate authored
521 (OManager.Arg.version "bslregister" :: OManager.Arg.options) @
522 BslLib.Arg.options @
523 spec
524 )
525
526 |> Arg.add_bash_completion
527 |> Arg.sort
528 |> Arg.align
529
530 in
9a4a8ee [enhance] help/manpages: global pass for improving help messages of O…
Mathieu Baudet authored
531 Arg.parse spec anon_fun (usage_msg^"Options:") ;
fccc685 Initial open-source release
MLstate authored
532 finalize_options ()
533
534
535 (* ======================================================================= *)
96b18ab [fix] bslregister: 2 minor typos in comments
Mathieu Baudet authored
536 (** {6 Makefile Generation} *)
fccc685 Initial open-source release
MLstate authored
537 (* ======================================================================= *)
538 module Makefile :
539 sig
540 (**
541 Return a buffer containing the generated Makefile.
542 *)
543 val generate : unit -> Buffer.t
544 end =
545 struct
546 (**
96b18ab [fix] bslregister: 2 minor typos in comments
Mathieu Baudet authored
547 For lisibility of this generation there, we use the add_substitute function
fccc685 Initial open-source release
MLstate authored
548 of the [Buffer] module. This means that we use a list of binding for inserting
549 dynamic parts into this generated makefile.
550 As we generating a Makefile, we need to generate the $ character, in this case,
551 it is echaped '\$'.
552 *)
553
554 let bindings () =
555 let extrapaths =
556 static_extrapaths () ^ (
557 String.concat_map ~left:" " " " (Printf.sprintf "-I %s")
558 (MutableList.to_list extrapaths)
559 ) in
560 let suffix = String.concat " " (
561 BslConvention.Suffix.mlruntime ::
562 if !static then [
563 BslConvention.Suffix.loader ;
564 BslConvention.Suffix.plugin ;
565 ] else []
566 )
567 in
568 let date =
569 let d = DebugTracer.now () in
570 stamp_date := d ;
571 d
572 in
573
574 [
575
576 (* c *)
577
578 "command", String.concat " " (Array.to_list Sys.argv) ;
579
580 (* d *)
581
582 "date", date ;
583
584 (* g *)
585
586 "generator", Sys.argv.(0) ;
587
588 (* i *)
589
590 "include", extrapaths ;
591
592 (* m *)
593
594 "ml_flags", String.concat " " (MutableList.to_list ml_flags) ;
595 "mlopt_flags", String.concat " " (MutableList.to_list mlopt_flags) ;
596
597 (* p *)
598
599 "plugin", !bsl_pref ;
600
601 (* s *)
602
603 "suffix", suffix ;
604
605 (* v *)
606
607 "version", BuildInfos.version_id ;
608 ]
609
610 let makefile_pattern =
611 "# ============================== #
612 # ==== BSL-CUSTOMLIB-MAKER ===== #
613 # ========== MLstate =========== #
614
615 # Generated Makefile by $(generator) version $(version) : $(date)
616 # from command : $(command)
617
618 OPP=$(plugin)
619
620 SUFFIX=$(suffix)
621 INCLUDE=$(include)
622
623 OCAML_FLAGS=$(ml_flags)
624 OCAMLOPT_FLAGS=$(mlopt_flags)
625 "
626
627 let static_part = "
628 TARGETS_CMI=$(patsubst %, $(OPP)%.cmi, $(SUFFIX))
629 TARGETS_CMX=$(patsubst %, $(OPP)%.cmx, $(SUFFIX))
5f95972 @Aqua-Ye [feature] iconv: binded iconv in Opa
Aqua-Ye authored
630 TARGETS_CMXA=$(patsubst %, $(OPP)%.cmxa, $(SUFFIX))
fccc685 Initial open-source release
MLstate authored
631
5f95972 @Aqua-Ye [feature] iconv: binded iconv in Opa
Aqua-Ye authored
632 all: $(TARGETS_CMI) $(TARGETS_CMX) $(TARGETS_CMXA)
fccc685 Initial open-source release
MLstate authored
633
634 OCAMLOPT ?= ocamlopt.opt
635 TRX ?= $(MLSTATELIBS)/bin/trx
636
637 %.ml : %.trx
638 \t$(TRX) $^ > $@
639
640 %.cmx : %.ml %.cmi
641 \t$(OCAMLOPT) $(OCAML_FLAGS) $(OCAMLOPT_FLAGS) $(INCLUDE) -c $<
642
5f95972 @Aqua-Ye [feature] iconv: binded iconv in Opa
Aqua-Ye authored
643 %.cmxa : %.cmx
644 \t$(OCAMLOPT) $(OCAML_FLAGS) $(OCAMLOPT_FLAGS) $(INCLUDE) -a $< -o $@
645
fccc685 Initial open-source release
MLstate authored
646 %.cmi : %.mli
647 \t$(OCAMLOPT) $(OCAML_FLAGS) $(OCAMLOPT_FLAGS) $(INCLUDE) -c $<
648
649 %.cmi : %.ml
650 \t$(OCAMLOPT) $(OCAML_FLAGS) $(OCAMLOPT_FLAGS) $(INCLUDE) -c $<
651
652 clean :
653 \trm -f *.cmx *.cmo *.o *.cmi
654
655 wclean :
656 \t@echo \"Would remove *.cmx *.cmo *.o *.cmi\"
657 "
658
659 let generate () =
660 let bindings = bindings () in
661 let map = StringMap.from_list bindings in
662 let subst var =
663 try StringMap.find var map with
664 | Not_found ->
665 OManager.apologies ();
666 OManager.printf (
667 "@[<2>@{<bright>Hint@}:@\nvar %S is not found during Makefile generation.@]@\n"
668 )
669 var
670 ;
671 assert false
672 in
673 let buf = Buffer.create 1024 in
674 let () =
675 try
676 Buffer.add_substitute buf subst makefile_pattern
677 with
678 | Not_found ->
679 OManager.apologies ();
680 OManager.printf (
681 "@[<2>@{<bright>Hint@}:@\nthe closing character of a parenthesized variable@\n"^^
682 "cannot be found during Makefile generation.@]@\n"
683 ) ;
684 assert false
685 in
686 Buffer.add_string buf static_part ;
687 buf
688
689 end
690 (* ======================================================================= *)
691
692
693 let iter_generated_files fct =
694
695 MutableList.iter (
696 fun f ->
697 match File.extension f with
698 | "opa" ->
699 fct (opa_code f) ;
700 fct (opa_interface f) ;
701 ()
702 | "js" ->
703 fct (js_code f) ;
704 ()
705 | _ -> ()
706 ) files ;
707
708 fct !jskeys ;
709 fct !marshalplugin ;
710 fct !mlruntime ;
711 fct !mlruntime_mli ;
712
713 if !static then (
714 fct !loader ;
715 fct !plugin ;
716 ) ;
717
718 fct !makefile ;
719 fct !stamp ;
720
721 ()
722
723
724 let check_safety_overwrite () =
725 let fct n =
726 if MutableList.mem n files then (
727 OManager.error (
728 "@[<2><!> bslregister refuse to do that !@\n"^^
729 "The file @{<bright>%S@} would be @{<bright>overwritten@} during the process@]"
730 ) n
731 ) in
732 iter_generated_files fct
733
734
735 let remove_file f =
736 try Unix.unlink f with Unix.Unix_error (e,_,_) ->
737 OManager.verbose "@[<2><!> Cannot clean @{<bright>%s@}:@\n%s@]" f (Unix.error_message e)
738
739
740 (* preprocessing format, for ##include *)
741 let may_add_format () =
742 if !default_iformats then (
743 BslLib.HLParser.add_iformat BslLib.HLParser.default_opa_iformats ;
744 ()
745 )
746
747
748 (* build BR.options from the current state of parameters *)
749 let bslregister_options ()=
750
751 let basename = !bsl_pref in
752
753 let bypass_plugins = MutableList.to_list bypass_plugins in
754
755 let check_style = !check_style in
756
757 let js_files = MutableList.to_list js_files in
758
759 let js_validator =
760 Option.map (
761 fun js -> (js, MutableList.to_list js_validator_files), MutableList.to_list js_validator_options
762 ) (!js_validator)
763 in
764
765 let ml_plugin_filename = !plugin in
766 let ml_runtime_filename = !mlruntime in
767
768 let unsafe_js = !unsafe_js in
769 let unsafe_opa = !unsafe_opa in
770
771
772 let options = {
773 BI.
774
775 basename ;
776 bypass_plugins ;
777
778 check_style ;
779
780 js_files ;
781 js_validator ;
782
783 ml_plugin_filename ;
784 ml_runtime_filename ;
785
786 unsafe_js ;
787 unsafe_opa ;
788
789 } in
790 options
791
792
793 (* clean, or just say what would be cleaned *)
794 let may_clean () =
795 if !clean then (
796 let rm f =
797 if !clean_would_only
798 then OManager.printf "Would remove @{<bright>%s@}@\n" f
799 else (
800 OManager.unquiet "rm -f %s" f ;
801 remove_file f ;
802 ()
803 )
804 in iter_generated_files rm;
805 exit 0
806 )
807
808 (* open_out_bin : read ocaml doc,
809 Marshal should be used with binary channel
810 for a win OS compatilibity *)
811 let handle_open_out file =
812 try open_out_bin file
813 with
814 | Sys_error s ->
815 OManager.error "@[<2>@{<bright>bslregister@}: cannot open_out @{<bright>%s@}:@\n%s@]" file s
816
817
818 let handle_close_out file oc =
819 try close_out oc
820 with
821 | Sys_error s ->
822 OManager.error "@[<2>@{<bright>bslregister@}: cannot close_out @{<bright>%s@}:@\n%s@]" file s
823
824
825 let output filename pp a =
826 OManager.verbose "writing file @{<bright>%S@}..." filename ;
827 let oc = handle_open_out filename in
828 pp oc a ;
829 handle_close_out filename oc ;
830 incr(files_generated) ;
831 ()
832
833
834 let make_iterator rename =
835 let output filename =
836 let filename = rename filename in
837 output filename
838 in
839 { BR.output = output }
840
841
842 (* after finalization of register session, actually produce files *)
843 let files_generation ( finalized_t : BR.finalized_t ) =
844 let iterator_js_code = make_iterator js_code in
845 let iterator_opa_code = make_iterator opa_code in
846 let iterator_opa_interface = make_iterator opa_interface in
847
848 BR.out_js_code iterator_js_code finalized_t ;
849 BR.out_opa_code iterator_opa_code finalized_t ;
850 BR.out_opa_interface iterator_opa_interface finalized_t ;
851
852 output !jskeys BR.out_js_keys finalized_t ;
853
854 output !marshalplugin BR.out_ml_marshal_plugin finalized_t ;
855 output !mlruntime BR.out_ml_runtime finalized_t ;
856 output !mlruntime_mli BR.out_ml_runtime_mli finalized_t ;
857
858 if !static then (
859 output !loader BR.out_ml_loader finalized_t ;
860 output !plugin BR.out_ml_plugin finalized_t ;
861 ) ;
862
863 output !makefile Buffer.output_buffer (Makefile.generate ()) ;
864 output !stamp Pervasives.output_string !stamp_date ;
865
866 ()
867
868
869 (* Checking options *)
870 let check_options options =
871 (* if needed, add some checks *)
872 ignore options ;
873
874 (* default lib name *)
875 if !is_default_lib then
876 OManager.warning ~wclass:WarningClass.bsl_register (
877 "@[<2>You did not precise a name for your lib.@\n"^^
878 "By default the lib name will be @{<bright>%S@}.@]@\n"^^
879 "@[<2>@{<bright>Hint@}:@\n"^^
880 "use option @{<bright>-o@} <libname>@]" )
881 !bsl_pref ;
882
883 ()
884
885 (* === *)
886
887 (* Main *)
888 let _ =
889 try
890 WarningClass.load_set BR.warning_set;
891 BR.set_signal_sigint ();
892 parse ();
893 check_safety_overwrite ();
894 may_clean ();
895 OManager.this_is_tool "bslregister";
896 may_add_format ();
897 if MutableList.length files = 0 then (
898 OManager.unquiet "no input files";
899 exit 0
900 );
901 let session =
902 let options = bslregister_options () in
903 check_options options ;
904 BR.create ~options
905 in
906 let session = MutableList.fold_left (
907 fun session file ->
908 OManager.verbose "registering file @{<bright>%S@}" file ;
909 BR.preprocess_file session file
910 ) session files
911 in
912 OManager.verbose "generating files ...";
913 let finalized_t = BR.finalize session in
914 files_generation finalized_t ;
915
6f11459 @OpaOnWindowsNow [feature] bslregister: activate js validation
OpaOnWindowsNow authored
916 BR.js_validator finalized_t;
917
fccc685 Initial open-source release
MLstate authored
918 OManager.verbose "successfull generation of plugin files : @{<bright>%d@} files" !files_generated ;
919
920 if !auto_build then (
921 OManager.verbose "building plugin...";
bfae307 @jlmess77 [fix] build: Use the makebinary from config.ml instead of a hardcore …
jlmess77 authored
922 let ret = Sys.command (Printf.sprintf "%s -C %s -f %s" Config.makebinary !opp_dir (Filename.basename !makefile)) in
fccc685 Initial open-source release
MLstate authored
923 if ret <> 0
924 then
925 OManager.error "building failure due to error(s) in source files@\n"
926 else
927 OManager.verbose "successfull compilation of plugin @{<bright>%s@}" !bsl_pref
928 );
929
930 (* if success : remove unused logs from previous error *)
931 if not (!unsafe_opa || !unsafe_js) then ignore (Sys.command "rm -f bsl_log_*");
932
933 ()
934 with
935 | BR.SigInt ->
936 OManager.error
937 "building process @{<bright>not accomplished@} due to an @{<bright>user interruption@}"
938 | e ->
939 let backtrace = Printexc.get_backtrace () in
940 OManager.apologies ();
941 (* if not BuildInfos.is_release then ( *)
942 (* OManager.printf "Now you get an extra hint, because this is not the @{<bright>release@} mode:@\n"; *)
943 OManager.printf "@[<2>@{<bright>Hint@}:@\n%s@]@\n@{<bright>Backtrace@}:@\n%s@\n"
944 (Printexc.to_string e) backtrace;
945 (* ); *)
946 exit 2
Something went wrong with that request. Please try again.