Skip to content
Newer
Older
100644 940 lines (824 sloc) 32.9 KB
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
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 (**
20 Common library for Qml to OCaml compiler.
21 @author Mathieu Barbin
22 *)
23
24 (* depends *)
25 module Char = Base.Char
26 module Hashtbl = Base.Hashtbl
27 module List = Base.List
28 module String = Base.String
29
30 (* shorthands *)
31 module O = Qml2ocamlOptions
32
33 (* -- *)
34
35 (** {6 Exported Types} *)
36 type dynloader = BslPluginInterface.plugin -> unit
37
38 type env_qml_code =
39 {
40 init_code : QmlAst.code option ;
41 user_code : QmlAst.code ;
42 }
43
44 type env_blender = QmlBlender.qml_milkshake
45
46 type 'a env_ocaml = {
47 ocaml_init_contents : (string * string) list ; (** wanted name + direct ocaml generated as string,deps *)
48 ocaml_code : 'a ;
49 }
50
51 type env_ocaml_input = Ocaml.code env_ocaml
52
53 (**
54 + [split]
55 The name of the file and the code.
56 For each splitten file.
57
58 + [depends]
59 The complete dependencies of files in the current packages.
60 From basename to basename.
61 *)
62 type env_ocaml_split = {
63 split : (string * Ocaml.code) list env_ocaml ;
64 depends : (string * string list) list ;
65 }
66
67 type env_ocaml_output = {
68 generated_files : string list ; (** path/name without build directory *)
69 caller_wd : string; (** absolute path of the caller working directory *)
70 }
71
72
73 (** New : back end specific traduction from QmlAst.ast to Ocaml.code
74 This is a record not a module (simplification for dynamically choices)
75 This can be used
76 *)
77 type ('bymap, 'env, 'code) back_end_factory =
78 {
79 build_bymap : ?filter:(BslKey.t -> bool) -> Qml2ocamlOptions.argv_options -> BslLib.BSL.ByPassMap.t -> 'bymap ; (** will build its own specific map (later uses export in libBSL) *)
80 ocaml_init : 'bymap -> string; (** contents *)
81 env_initial : Qml2ocamlOptions.argv_options -> 'bymap -> QmlTyper.env -> 'env ;
82 empty_code : 'code ;
83 compile : ('env * 'code) -> QmlAst.code -> 'env * 'code ;
84 get_code : 'code -> Ocaml.code ;
85 }
86
87 type qml_to_ocaml = Qml2ocamlOptions.argv_options -> BslLib.env_bsl -> env_blender -> env_ocaml_input
88
89 (** We use this type for the sugar, until we use export function in BslLib *)
90 type back_end =
91 {
92 dynloader : dynloader ;
93 qml_to_ocaml : qml_to_ocaml
94 }
95
96 let bsl_init_basename () =
97 match ObjectFiles.compilation_mode () with
98 | `init -> "bsl_init"
99 | `compilation | `linking | `prelude -> "bsl_init_" ^ ObjectFiles.get_current_package_name_as_a_valid_ident ~will_be_prefixed:true ()
100
101 let bsl_init_module () =
102 OcamlUtils.Module.of_filename (bsl_init_basename ())
103
104 (**
105 PASSES of qml2ocaml :
106 ---------------------
107 // Command line passes
108 returns a : env_bsl, env_blender
109
110 << qml_to_ocaml : argv_options -> env_bsl -> env_blender -> env_ocaml_input >>
111
112 // End passes
113 val ocaml_generation : argv_options -> env_ocaml_input -> env_ocaml_output
114 val ocaml_compilation : argv_options -> env_ocaml_output -> int
115
116 NEEDED from any instance of a qml-compiler :
117 val qml_to_ocaml : qml_to_ocaml
118
119 Since the 2ocaml compilers are similar, we propose a factory function
120 see qml_to_ocaml_factory : ('a, 'b, 'c) back_end_factory -> qml_to_ocaml
121 *)
122
123 (* ============================================================================== *)
124
125 let command options s =
126 if options.O.show_compilation then prerr_endline s ;
127 Sys.command s
128
129 let command_raise options s =
130 let result = command options s in
131 if result <> 0 then OManager.error "external error -- the command was :@\n@\n%s" s
132
133 (* ============================================================================== *)
134
135 let qml_to_ocaml_factory : ('a, 'b, 'c) back_end_factory -> qml_to_ocaml =
136 fun compiler options bsl blender ->
137 OManager.verbose "bsl: projection of bypass code";
138 let qml_code = blender.QmlBlender.code in
139 (* projecting only the necessary bypasses *)
140 let used_bypasses =
141 let bypass_of_directive = function
142 | `assert_ -> Some "bslpervasives.assertion"
b7cdc64 [fix] qmlflat: pretending to compile throw and catch in non cps mode
Valentin Gatien-Baron authored Jul 7, 2011
143 | `fail | `throw | `catch -> Some "bslpervasives.fail"
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
144 | `callcc -> Some "bslcps.notcps_compatibility.callcc_directive"
145 | `thread_context -> Some "bslcps.notcps_compatibility.thread_context"
146 | `with_thread_context -> Some "bslcps.notcps_compatibility.with_thread_context"
147 | _ -> None in
148 QmlAstWalk.CodeExpr.fold
149 (QmlAstWalk.Expr.fold
150 (fun set -> function
151 | QmlAst.Bypass (_, k) -> BslKeySet.add k set
152 | QmlAst.Directive (_, v, _, _) ->
153 (match bypass_of_directive v with
154 | Some s -> BslKeySet.add (BslKey.normalize s) set
155 | None -> set)
156 | _ -> set)) BslKeySet.empty qml_code in
157 let bymap = compiler.build_bymap ~filter:(fun k -> BslKeySet.mem k used_bypasses) options bsl.BslLib.bymap in
158 let ocaml_init = compiler.ocaml_init bymap in
159 (** Ocaml Init (projection of lib init) *)
160 let file = (bsl_init_basename ()) ^ ".ml" in
161 let ocaml_env, ocaml_code = compiler.env_initial options bymap (blender.QmlBlender.env : QmlTyper.env), compiler.empty_code in
162 OManager.verbose "ocaml traduction";
163 let _, ocaml_code = compiler.compile (ocaml_env, ocaml_code) qml_code in
164 let ocaml_code = compiler.get_code ocaml_code in
165 {
166 ocaml_init_contents = [ file, ocaml_init ] ;
167 ocaml_code = ocaml_code
168 }
169
170 (* ============================================================================== *)
171
172 module OcamlCompilation :
173 sig
174
175 (**
176 Splitting the code into smaller ocaml modules.
177 Each identifier is prefixed with the absolute module path of its definition.
178 This pass is compositionnal, it loads and saves corresponding environments.
179 *)
180 val ocaml_split_code : Qml2ocamlOptions.argv_options -> env_ocaml_input -> env_ocaml_split
181
182 (**
183 Outputs on the disk the ml files corresponding to ocaml modules.
184 Outputs also a previously computed .depends file.
185 *)
186 val ocaml_generation : Qml2ocamlOptions.argv_options -> env_ocaml_split -> env_ocaml_output
187
188 val ocaml_compilation : Qml2ocamlOptions.argv_options -> env_ocaml_output -> int
189 end =
190 struct
191
192 let tuple_pat_name = function
193 |Ocaml.Pat(Ocaml.PatVar s),_ -> Some s
194 | _ -> None
195
196 let get_decl_name = function
197 |Ocaml.Let (l)
198 |Ocaml.Letrec (l) -> List.filter_map tuple_pat_name l
199 | _ -> []
200
201 (* ident -> module name of definition *)
202 type ocaml_split_code = string IdentTable.t
203 module OcamlSplitCode = ObjectFiles.Make(
204 struct
205 type t = ocaml_split_code
206 let pass = "OcamlSplitCode"
207 let pp f _ = Format.pp_print_string f "<dummy>"
208 end)
209
210 let ocaml_split_code options env_ocaml_input =
211 let ocaml_code = env_ocaml_input.ocaml_code in
212
213 (* Generation of module names *)
214 let next_filename setf index =
215 let target =
216 (* the name of the ml files from different packages and for the linking
217 * should never be able conflict *)
218 match ObjectFiles.compilation_mode () with
219 | `compilation ->
220 let target = ObjectFiles.get_current_package_name_as_a_valid_ident ~will_be_prefixed:true () in
221 Printf.sprintf "opa_%s_%.3d" target index
222 | `init ->
223 let target = File.from_pattern "%b" options.O.target in
224 Printf.sprintf "init_%s_%.3d" target index
225 | `linking | `prelude ->
226 let target = File.from_pattern "%b" options.O.target in
227 Printf.sprintf "link_%s_%.3d" target index
228 in
229 (* modification of the name, because Ocaml modules names are strict *)
230 let target = (String.map (fun c -> if Char.is_alpha c || Char.is_digit c then c else '_') target ) in
231 if StringSet.mem target setf then Printf.sprintf "collide_%d_%s" index target else target
232 in
233 (*
234 For a stable split in case of modification.
235 *)
236 (*let split_number = options.O.split_ocaml_value in
237 let magic_synchro s = Hashtbl.hash s mod split_number == 0 in*)
238 let magic_synchro =
239 let r = ref 0 in
240 fun _ -> if !r = 300 then (r := 0; true) else (incr r; false) in
241 let split_randomly_with_sync code =
242 let rec aux acc l =
243 match l with
244 | x:: rl ->
245 if magic_synchro (String.concat_map "" Ident.stident (get_decl_name x))
246 then (List.rev (x::acc), rl)
247 else aux (x::acc) rl
248 | [] -> (List.rev acc, [])
249 in
250 aux [] code
251 in
252
253 (* compositionality *)
254 let fileapi_all = IdentTable.create 1024 in
255 let () =
256 let iter t =
257 let add id m = IdentTable.add fileapi_all id m in
258 IdentTable.iter add t in
259 OcamlSplitCode.iter iter
260 in
261 let fileapi_this = IdentTable.create 1024 in
262 (* -- *)
263
264 (* depends *)
265 let static_depends = ListHashtbl.create 1024 in
266 (* -- *)
267
268 let split_files code =
269 let rec aux index setf rev_files code =
270 match code with
271 | [] -> List.rev rev_files
272 | _ ->
273 let code, rest = split_randomly_with_sync code in
274
275 let filename = next_filename setf index in
276 let module_ = String.capitalize filename in
277 let index = succ index in
278 let setf = StringSet.add filename setf in
279
280 (*
281 dependencies to the bsl init file cannot be determinated easily,
282 and we do not care actually. Each file can depends on bsl_init.
283 *)
284 let add_depends =
285 if options.O.compile_via_makefile
286 then (
287 ListHashtbl.add static_depends filename (bsl_init_basename()) ;
288 (fun module_ ->
289 let depends = String.uncapitalize module_ in
290 if StringSet.mem depends setf
291 then
292 ListHashtbl.add static_depends filename depends
293 )
294 )
295 else ignore
296 in
297
298 (*
299 Resolve dependencies:
300 1) add complete path, instead of producing open
301 2) collect dependencies for the build system.
302 only the depends in the same package are keeped.
303 *)
304 let map_ident ids =
305 match ids with
306 | [id] -> (
307 match IdentTable.find_opt fileapi_all id with
308 | Some module_ ->
309 add_depends module_ ;
310 [ Ident.source module_ ; id ]
311 | _ -> ids
312 )
313 | _ -> ids
314 in
315 let map_pe pe =
316 match pe with
317 | Ocaml.Pated (ident, b) ->
318 let fident = map_ident ident in
319 if fident == ident
320 then pe
321 else Ocaml.Pated (fident, b)
322 | _ -> pe
323 in
324 let map_expr = OcamlWalk.Expr.map (
325 fun e ->
326 match e with
327 | Ocaml.Var pe ->
328 let fpe = map_pe pe in
329 if pe == fpe
330 then e
331 else
332 Ocaml.Var fpe
333 | _ -> e
334 )
335 in
336 let code = List.map_stable map_expr code in
337
338 let () =
339 (* Collect definitions, and store it for a future compilation *)
340 let iter_bindings = function
341 | Ocaml.Pat (Ocaml.PatVar id), _ -> (
342 IdentTable.add fileapi_all id module_ ;
343 IdentTable.add fileapi_this id module_ ;
344 )
345 | _ -> () in
346 let iter = function
347 | Ocaml.Let l
348 | Ocaml.Letrec l -> List.iter iter_bindings l
349 | _ -> () in
350 List.iter iter code
351 in
352 let filename = filename^".ml" in
353 let file = filename, code in
354 let rev_files = file :: rev_files in
355 aux index setf rev_files rest
356 in
357 aux 1 StringSet.empty [] code
358 in
359
360 let ocaml_code = split_files ocaml_code in
361
362 (* compositionality *)
363 OcamlSplitCode.save fileapi_this ;
364 (* -- *)
365
366 let split =
367 { env_ocaml_input with
368 ocaml_code = ocaml_code
369 } in
370 let depends =
371 if options.O.compile_via_makefile
372 then
373 ListHashtbl.to_list static_depends
374 else
375 []
376 in
377 {
378 split = split ;
379 depends = depends ;
380 }
381
382 let open_out filename =
383 let oc =
384 try open_out filename
385 with
386 | Sys_error s -> OManager.error "cannot write file @{<bright>%S@} : %s" filename s
387 in
388 oc
389
390 let close_out filename oc =
391 let () =
392 try close_out oc
393 with
394 | Sys_error s -> OManager.error "cannot close file @{<bright>%S@} : %s@\n" filename s
395 in
396 ()
397
398 (* ml and cmx files are stored in blabla.opx/_build in compilation mode
399 * and in the _build/"path from the -o options " for linking *)
400 let build_dir_of_opx opx = Filename.concat opx "_build"
401 let get_build_dir ?package_dir:package_dir_opt caller_wd argv_options =
402 let package_dir_opt =
403 match package_dir_opt with
404 | None -> ObjectFiles.get_compilation_directory ()
405 | Some _ -> package_dir_opt in
406 let d =
407 Option.default_map
408 argv_options.O.compilation_directory
409 build_dir_of_opx
410 package_dir_opt in
411 if Filename.is_relative d then
412 Filename.concat caller_wd d
413 else
414 d
415
416 let ocaml_generation argv_options env_ocaml_split =
417
418 let split = env_ocaml_split.split in
419
420 (*
421 PRODUCTION OF FILES
422 The iteration is done is the corresponding folder, with a previous Sys.chdir
423 *)
424
425 let output_file_contents acc (filename, contents) =
426 if not (File.output filename contents) then OManager.error "cannot write file @{<bright>%S@}" filename ;
427 filename :: acc
428 in
429
430 let output_file_code acc (filename, code) =
431 let () =
432 let oc = open_out filename in
433 OcamlPrint.Output.code oc code ;
434 flush oc ;
435 close_out filename oc ;
436 ()
437 in
438 filename :: acc
439 in
440
441 (* retrieve current path (caller working directory path) *)
442 let caller_wd = Sys.getcwd () in
443 let build_dir = get_build_dir caller_wd argv_options in
444 let success = File.check_create_path build_dir in
445 let _ = if not success then OManager.error "cannot create or enter in directory @{<bright>%S@}" build_dir in
446
447 (* going to building directory *)
448 OManager.verbose "goto build directory@ %s" build_dir;
449 Sys.chdir build_dir;
450 OManager.verbose "outputing ml files";
451 let rev_generated_files = [] in
452 let rev_generated_files = List.fold_left output_file_contents rev_generated_files split.ocaml_init_contents in
453 let rev_generated_files = List.fold_left output_file_code rev_generated_files split.ocaml_code in
454
455 let rev_generated_files =
456 if argv_options.O.check_lib
457 then
458 let filename = "check_lib_15343.ml" in
459 let content = "
460 let _ = prerr_endline (String.concat \" \" (Array.to_list Sys.argv)) ;
461 prerr_endline \"CHECKUP - LIBS - OK\"
462 "
463 in
464 output_file_contents rev_generated_files (filename, content)
465 else
466 rev_generated_files
467 in
468
469 (* generation of the .depends file *)
470 let () =
471 if argv_options.O.compile_via_makefile then
472 let filename = ".depends" in
473 let oc = open_out filename in
474 let () =
475 let iter (basename, depends) =
476 let one_line ext =
477 Printf.fprintf oc "%s.%s:" basename ext ;
478 List.iter (
479 fun dep ->
480 output_string oc " " ;
481 output_string oc dep ;
482 output_string oc "." ;
483 output_string oc ext
484 ) depends ;
485 output_string oc "\n" ;
486 in
487 one_line "cmx" ;
488 one_line "cmo" ;
489 in
490 List.iter iter env_ocaml_split.depends
491 in
492 flush oc ;
493 close_out filename oc ;
494 in
495
496 (*
497 for the track system, a pass is not allowed to finish somewhere else then in the
498 starting directory
499 *)
500 Sys.chdir caller_wd;
501
502 {
503 generated_files = List.rev rev_generated_files ;
504 caller_wd = caller_wd ;
505 }
506
507 let ocaml_compilation options env_ocaml_output =
508 let caller_wd = env_ocaml_output.caller_wd in
509 let build_dir = get_build_dir caller_wd options in
510
511 (** COMPILATION AND LINKING *)
512 let link_lib = "link" in
513 let libs =
514 match ObjectFiles.compilation_mode () with
515 | `compilation | `linking | `prelude -> []
516 | `init ->
517 if ObjectFiles.Arg.is_fully_separated () then
518 List.rev (
519 link_lib ::
520 ObjectFiles.fold_name ~deep:true ~packages:true
521 (fun acc package ->
522 ObjectFiles.get_package_as_a_valid_ident package :: acc
523 ) []
524 )
525 else
526 [link_lib] in
527
528 (* do not change the current dir before calling ObjectFiles.fold* *)
529 Sys.chdir build_dir ;
530 let chop_extension_files = List.map (fun f ->
531 try
532 Filename.chop_extension f
533 with Invalid_argument s -> raise (Invalid_argument ( s ^ ":Cannot remove extension of "^f ))
534 ) env_ocaml_output.generated_files in
535 let add_extension_gen l ext = List.map (fun v -> Printf.sprintf "%s.%s " v ext) l in
536 let add_extension_source = add_extension_gen chop_extension_files in
537 let add_extension_lib = add_extension_gen libs in
538 let ml_list = add_extension_source "ml" in
539
540 let objects_extension_native = "cmx"
541 and objects_extension_bytecode = "cmo"
542 and lib_extension_native = "cmxa"
543 and lib_extension_bytecode = "cma" in
544
545 let libname =
546 match ObjectFiles.compilation_mode () with
547 | `compilation | `init -> ObjectFiles.get_current_package_name_as_a_valid_ident ()
548 | `linking | `prelude -> link_lib in
549
550 let lib_native = libname ^ "." ^ lib_extension_native in
551 let lib_bytecode = libname ^ "." ^ lib_extension_bytecode in
552
553 let dep_lib_native = String.concat " " (add_extension_lib lib_extension_native) in
554 let dep_lib_bytecode = String.concat " " (add_extension_lib lib_extension_bytecode) in
555 let objects_list_native = String.concat " " (add_extension_source objects_extension_native) in
556 let objects_list_bytecode = String.concat " " (add_extension_source objects_extension_bytecode) in
557
558 let objects_list = match options.O.makefile_rule with
559 | O.Bytecode -> "all_cmo"
560 | O.Native -> "all_cmx"
561 | _ -> "all_cmo all_cmx"
562 in
563 let exe = Filename.basename options.O.target in
564 let target_exe = options.O.target in
565 let is_relative_caml_lib dir = dir.[0] = '+' in
566 let extra_path =
567 let relative_position = PathTransform.of_string caller_wd in
568 let deep, packages =
569 match ObjectFiles.compilation_mode () with
570 | `compilation -> false, false
571 | `init | `linking | `prelude -> true, true in
572 String.concat_map " "
573 (fun dir ->
574 let dir = if is_relative_caml_lib dir then dir else PathTransform.string_to_mysys ~relative_position dir in
575 if is_relative_caml_lib dir || File.exists dir then Printf.sprintf "-I %S" dir else "")
576 (ObjectFiles.fold_dir ~deep ~packages (fun acc opx -> build_dir_of_opx opx :: acc) options.O.extra_path)
577 in
578 let substitute_lib_extension_native = File.subst ["", "cmxa" ; "cmo", "cmx" ; "cma", "cmxa"] in
579 let substitute_lib_extension_bytecode = File.subst ["", "cma" ; "cmx", "cmo" ; "cmxa", "cma"] in
580
581 let extra_lib_native = String.concat_map " " substitute_lib_extension_native options.O.extra_lib in
582 let extra_lib_bytecode = String.concat_map " " substitute_lib_extension_bytecode options.O.extra_lib in
583
584 (* options for compiler & linker *)
585 let options_compiler = String.concat " " ((if options.O.hacker_mode then "-annot" else "")::(if options.O.profile then "-p" else "")::options.O.mlcopt) in
586 let options_linker = String.concat " " ((if options.O.profile then "-p" else "")::options.O.mllopt) in
587
588 let extra_bytecode_options = String.concat " " Qml2ocamlOptions.StaticParameters.extra_bytecode_options in
589 let extra_native_options = String.concat " " Qml2ocamlOptions.StaticParameters.extra_native_options in
590
591 let compiler_native = options.O.ocamlopt in
592 let compiler_bytecode = options.O.ocamlc in
593
594 let do_command name compilation =
595 Some (compilation,
596 (fun () ->
597 OManager.verbose "%s" name;
598 OManager.verbose "%s" compilation;
599 command options compilation)) in
600
601 let compilation_native ml_file =
602 (** compilation : ml to cmx *)
603 Printf.sprintf "%s -c %s %s %s %s"
604 compiler_native
605 extra_native_options
606 options_compiler
607 extra_path
608 ml_file
609 in
610
611 let compilation_bytecode ml_file =
612 (** compilation : ml to cmx *)
613 Printf.sprintf "%s -c %s %s %s %s"
614 compiler_bytecode
615 extra_bytecode_options
616 options_compiler
617 extra_path
618 ml_file
619 in
620
621 let target_makefile =
622 (* avoiding that the Makefile of the init overwrites the Makefile
623 * of the linking (since the compilation directory is the same)*)
624 match ObjectFiles.compilation_mode () with
625 | `init | `compilation -> "Makefile"
626 | `linking | `prelude -> "MakefileLinking" in
627 let compilation = match options.O.makefile_rule with
628 | O.Bytecode -> compilation_bytecode
629 | O.Native -> compilation_native
630 | _ -> (fun s -> Printf.sprintf "%s\t%s" (compilation_bytecode s) (compilation_native s))
631 in
632 let linking_native_gen more_opt exe =
633 (** linking : cmx + all lib to .exe *)
634 Printf.sprintf "%s %s %s %s %s %s runtimeMain.cmx -o %s"
635 compiler_native
636 extra_native_options
637 options_linker
638 extra_path
639 extra_lib_native
640 more_opt
641 exe
642 in
643 let linking_native_with_lib exe =
644 match ObjectFiles.compilation_mode () with
645 | `init ->
646 (* the init package needs to be linked first *)
647 linking_native_gen (lib_native ^ " " ^ dep_lib_native) exe
648 | `compilation | `linking | `prelude ->
649 linking_native_gen (dep_lib_native ^ " " ^ lib_native) exe
650 in
651 let linking_native_with_obj exe =
652 linking_native_gen objects_list_native exe
653 in
654
655 let linking_bytecode_gen more_opt exe =
656 (** linking : cmx + all lib to .exe *)
657 Printf.sprintf "%s %s %s %s %s %s runtimeMain.cmo -o %s"
658 compiler_bytecode
659 extra_bytecode_options
660 options_linker
661 extra_path
662 extra_lib_bytecode
663 more_opt
664 exe
665 in
666 let linking_bytecode_with_lib exe =
667 match ObjectFiles.compilation_mode () with
668 | `init ->
669 (* the init package needs to be linked first *)
670 linking_bytecode_gen (lib_bytecode ^ " " ^ dep_lib_bytecode) exe
671 | `compilation | `linking | `prelude ->
672 linking_bytecode_gen (dep_lib_bytecode ^ " " ^ lib_bytecode) exe
673 in
674 let linking_bytecode_with_obj exe =
675 linking_bytecode_gen objects_list_bytecode exe
676 in
677
678 let linking_with_obj, _linking_with_lib = match options.O.makefile_rule
679 with
680 | O.Bytecode -> linking_bytecode_with_obj exe, linking_bytecode_with_lib exe
681 | O.Native -> linking_native_with_obj exe, linking_native_with_lib exe
682 | _ -> "", ""
683 in
684
685 let do_compilation =
686 if options.O.compile_via_makefile
687 then []
688 else
689 List.map
690 (fun ml_file -> do_command "compiling" (compilation ml_file)) ml_list
691 in
692
693 let do_linking =
694 if options.O.compile_via_makefile
695 then None
696 else
697 Some (linking_with_obj,
698 (fun () ->
699 OManager.verbose "linking";
700 OManager.verbose "%s" linking_with_obj;
701 let r = command options linking_with_obj in
702 if r = 0 then OManager.verbose "exe is \t@{<bright>%s@}" exe ; r))
703 in
704
705 let compilation_via_makefile =
1321ba9 @fperrin On FreeBSD check and use gmake, use make elsewhere
fperrin authored Sep 21, 2011
706 let make = Printf.sprintf "%s --makefile=%s -W %s -j %d %s" Config.makebinary target_makefile target_makefile options.O.makefile_max_jobs
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
707 (match options.O.makefile_rule with
708 | O.Bytecode ->
709 (match ObjectFiles.compilation_mode () with
710 | `compilation | `linking | `prelude -> "cma"
711 | `init -> "byte")
712 | O.Native ->
713 (match ObjectFiles.compilation_mode () with
714 | `compilation | `linking | `prelude -> "cmxa"
715 | `init -> "native")
716 | O.Bytecode_or_native -> "tryall"
717 | O.Bytecode_and_native -> "all")
718 in
719 if options.O.show_compilation then make else make^" -s"
720 in
721
722 let do_compilation_via_makefile =
723 if options.O.compile_via_makefile
724 then do_command "compiling" compilation_via_makefile
725 else None
726 in
727
728 let do_one_camlp4o_makefile ml = Printf.sprintf "\t$(CAMLP4O) %s -o %s" ml ml in
729 let do_one_camlp4o ml = Printf.sprintf "\tcamlp4o.opt %s -o %s" ml ml in
730 let do_camlp4o = if options.O.camlp4o || options.O.hacker_mode then Some (
731 "camlp4o preprocess",
732 (fun () ->
733 List.fold_left (fun a f ->
734 OManager.verbose "applying camlp4o.opt to file %S" f;
735 let c = command options (do_one_camlp4o f) in
736 if a = 0 then c else a)
737 0 env_ocaml_output.generated_files))
738 else None in
739
740 let mrule ~native = Printf.sprintf "\t%s $<" (if native then "$(NATIVE_RULE)" else "$(BYTECODE_RULE)" ) in
741 (* let all_ml = String.concat " " env_ocaml_output.generated_files in *)
742
0f26216 @Aqua-Ye [enhance] compilation: better redirect for ocaml compilation error st…
Aqua-Ye authored Aug 23, 2011
743
744 let compilation_log_file = "compilation.log" in
d6c5ed2 @Aqua-Ye [fix] compilation: TO_BE_IMPROVED - redirect ocaml compilation error …
Aqua-Ye authored Aug 23, 2011
745 (* let make_filter = "2> >(grep -v \"ld: warning: directory not found for option*\" 1>&2)" in *)
0f26216 @Aqua-Ye [enhance] compilation: better redirect for ocaml compilation error st…
Aqua-Ye authored Aug 23, 2011
746 let make_filter = Printf.sprintf "2> %s" compilation_log_file in (* FIXME: we ignore all caml compilation error... *)
d6c5ed2 @Aqua-Ye [fix] compilation: TO_BE_IMPROVED - redirect ocaml compilation error …
Aqua-Ye authored Aug 23, 2011
747
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
748 let makefile : unit -> string = fun () ->
749 let ( |> ) = FBuffer.addln in
750 let ( |< ) x f = f x in
751 let sprintf = Printf.sprintf in
752 FBuffer.create 1024
753 (* THIS IS THE GENERATED MAKEFILE *)
754 |> sprintf "# Makefile for %s" exe
755
756 |> sprintf "\nCAMLP4O=camlp4o.opt"
757 |> sprintf "\n.SUFFIXES: .cmo .cmx .cmi .ml"
758 |> sprintf "\n.ml.cmo:"
759 |> sprintf "\t%s" (mrule ~native:false)
760 |> sprintf "\n.ml.cmi:"
761 |> sprintf "\t%s" (mrule ~native:false)
762 |> sprintf "\n.ml.cmx:"
763 |> sprintf "\t%s" (mrule ~native:true)
764
765 |> sprintf "\nNATIVE_RULE=%s" (compilation_native "")
766 |> sprintf "\nBYTECODE_RULE=%s" (compilation_bytecode "")
767
768 |> sprintf "\nNATIVE_LINKING=%s" (linking_native_with_lib "")
769 |> sprintf "\nBYTECODE_LINKING=%s" (linking_bytecode_with_lib "")
770 |> sprintf "\nOCAMLDEP=%s " "ocamldep"
771
772 |> sprintf "all :\n" ^
773 (if options.O.hacker_mode then "\t$(MAKE) clean_old_source\n" else "")
774 |> sprintf "\t$(MAKE) native"
775 |> sprintf "\t$(MAKE) byte"
776 |> sprintf "\t$(MAKE) exe"
777 |> sprintf "exe : %s" exe
778
779 |> sprintf "tryall :"
780 |> sprintf "\t$(MAKE) byte || $(MAKE) native || echo \"compilation failed in native and in byte\""
781 |> sprintf "all_cmx : %s" objects_list_native
782 |> sprintf "all_cmo : %s" objects_list_bytecode
783 |> sprintf "cmxa: all_cmx"
784 |> sprintf "\t%s -linkall -a %s -o %s" compiler_native objects_list_native lib_native
785 |> sprintf "cma: all_cmo"
786 |> sprintf "\t%s -linkall -a %s -o %s" compiler_bytecode objects_list_bytecode lib_bytecode
787 |> "\n# Default compilation"
788 |> sprintf "%s : %s" exe objects_list
d6c5ed2 @Aqua-Ye [fix] compilation: TO_BE_IMPROVED - redirect ocaml compilation error …
Aqua-Ye authored Aug 23, 2011
789 |> sprintf "\t%s $@ %s" (match options.O.makefile_rule
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
790 with
791 | O.Bytecode -> "$(BYTECODE_LINKING)"
792 | O.Native -> "$(NATIVE_LINKING)"
793 | O.Bytecode_and_native -> "$(MAKE) all"
794 | O.Bytecode_or_native -> "$(MAKE) tryall"
d6c5ed2 @Aqua-Ye [fix] compilation: TO_BE_IMPROVED - redirect ocaml compilation error …
Aqua-Ye authored Aug 23, 2011
795 ) make_filter
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
796
797 |> "\n# Native compilation"
798 |> sprintf "native : cmxa"
d6c5ed2 @Aqua-Ye [fix] compilation: TO_BE_IMPROVED - redirect ocaml compilation error …
Aqua-Ye authored Aug 23, 2011
799 |> sprintf "\t$(NATIVE_LINKING) %s %s" exe make_filter
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
800 |> sprintf "%s.native : cmxa" exe
d6c5ed2 @Aqua-Ye [fix] compilation: TO_BE_IMPROVED - redirect ocaml compilation error …
Aqua-Ye authored Aug 23, 2011
801 |> sprintf "\t$(NATIVE_LINKING) $@ %s" make_filter
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
802
803 |> "\n# Bytecode compilation"
804 |> sprintf "byte : cma"
d6c5ed2 @Aqua-Ye [fix] compilation: TO_BE_IMPROVED - redirect ocaml compilation error …
Aqua-Ye authored Aug 23, 2011
805 |> sprintf "\t$(BYTECODE_LINKING) %s %s" exe make_filter
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
806 |> sprintf "%s.byte : cma" exe
d6c5ed2 @Aqua-Ye [fix] compilation: TO_BE_IMPROVED - redirect ocaml compilation error …
Aqua-Ye authored Aug 23, 2011
807 |> sprintf "\t$(BYTECODE_LINKING) $@ %s" make_filter
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
808
809
810 |> "\n# COMPILATION RULES"
811 (*|< compute_linear_dependencies ~native:true
812 |< compute_linear_dependencies ~native:false*)
813 |> sprintf "\n-include .depends"
814 |> "\ncamlp4 :"
815 |> String.concat_map "\n" do_one_camlp4o_makefile env_ocaml_output.generated_files
816
817 |> "\nclean :"
818 |> "\trm -f *.cmx *.cmi *.cmo *.o"
819
820 |> sprintf "\nshow_old_source :\n\tls | grep -v -E \"%s\""
821 (String.concat "|" env_ocaml_output.generated_files)
822
823
824 |> sprintf "\nclean_old_source :\n\tls | grep -v -E \"%s|*.qml|*.exe\" | xargs rm -f"
825 (String.concat "|" (target_makefile::env_ocaml_output.generated_files))
826
827 |< FBuffer.contents
828
829 in
830
831 let do_makefile =
832 (* if options.O.compile_via_makefile *)
833 (* then *)
834 Some (
835 Printf.sprintf "writing \"%s\"" target_makefile,
836 (fun () ->
837 OManager.verbose "writing debug makefile : %S" target_makefile;
838 let b = File.output target_makefile (makefile ()) in
839 if not b then OManager.printf "cannot write %S@\n" target_makefile ;
840 0))
841 (* else None *)
842 in
843
844 let abs_path_exe = Filename.concat build_dir exe in
845 let rel_path_exe =
846 if Filename.is_relative target_exe then
847 Filename.concat caller_wd target_exe
848 else target_exe
849 in
850
851 let exe_move =
852 match ObjectFiles.compilation_mode (), options.O.no_move, !ObjectFiles.no_init with
853 | (`compilation | `linking | `prelude), _, false
854 | _, true, false -> None
855 | _, _, true
856 | `init, false, false ->
857 Some (
858 let c = Printf.sprintf "copying %s to %s" abs_path_exe rel_path_exe in
859 c,
860 (fun () ->
861 try
862 if abs_path_exe <> rel_path_exe then
863 File.copy ~force:true abs_path_exe rel_path_exe
864 else 0
865 with Sys_error s -> OManager.printf "System error: %s" s ; 1
866 ))
867 in
868 let exe_run =
869 match ObjectFiles.compilation_mode (), options.O.exe_run, !ObjectFiles.no_init with
870 | (`compilation | `linking | `prelude), _, false
871 | _, false, false -> None
872 | _, _, true
873 | `init, true, false ->
874 let path_exe =
875 if options.O.no_move
876 then abs_path_exe
877 else rel_path_exe
878 in
879 Some
880 (let argv = path_exe :: options.O.exe_argv in
881 let c = String.concat " " argv in
882 c,
883 (fun () ->
884 OManager.verbose "building finished, will run the exe@\n@{<bright>%s@}" c;
885 let argv = Array.of_list ( path_exe :: options.O.exe_argv ) in
886 Sys.chdir caller_wd ;
887 let do_it () = Unix.execv path_exe argv in
888 Unix.handle_unix_error do_it ()
889 )) in
890
891 (* let command_line s = s, (fun () -> command options s) in *)
892 let full_compilation =
893 [
894 do_camlp4o ;
895 do_makefile ]@
896 do_compilation@
897 [ do_linking ;
898 do_compilation_via_makefile ;
899 exe_move ;
900 exe_run
901 ]
902 in
903
904 let filter_compilation = List.filter_map (fun s -> s) full_compilation in
905 let rec do_compilation = function
906 | [] -> 0
907 | (c, cont) :: q ->
908 let o = cont () in
909 if o <> 0
910 then (
0f26216 @Aqua-Ye [enhance] compilation: better redirect for ocaml compilation error st…
Aqua-Ye authored Aug 23, 2011
911 OManager.printf "error during ocaml compilation -- the command was :@\n%s@\nyou can see compilation logs in %s/%s" c build_dir compilation_log_file;
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
912 o
913 )
914 else do_compilation q in
915 let return = do_compilation filter_compilation in
0f26216 @Aqua-Ye [enhance] compilation: better redirect for ocaml compilation error st…
Aqua-Ye authored Aug 23, 2011
916 (* OManager.printf "Compilation log file at %s/%s\n" build_dir compilation_log_file; *)
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
917 Sys.chdir caller_wd ;
918 return
919 end
920
921 (* ============================================================================== *)
922
923 module Sugar :
924 sig
925 (** sugar of interface to be used in opa/passes.
926 Beware, this function do not call any Front pass.
927 It starts at qml_to_ocaml and goes still end passes.
928 This function does not have the same behavior than console which includes Front passes.*)
929 val for_opa : qml_to_ocaml -> Qml2ocamlOptions.argv_options -> BslLib.env_bsl -> QmlBlender.qml_milkshake -> int
930 end
931 =
932 struct
933 let for_opa qml_to_ocaml options bsl blender =
934 let env_ocaml_input = qml_to_ocaml options bsl blender in
935 let env_ocaml_split = OcamlCompilation.ocaml_split_code options env_ocaml_input in
936 let env_ocaml_output = OcamlCompilation.ocaml_generation options env_ocaml_split in
937 let returned = OcamlCompilation.ocaml_compilation options env_ocaml_output in
938 returned
939 end
Something went wrong with that request. Please try again.