Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Compile_common.implementation

master
Valentin Gatien-Baron 2018-07-31 08:05:15 -04:00 committed by Gabriel Scherer
parent ebc34d5115
commit c93d080f13
4 changed files with 36 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
driver/compile.ml
View File

@ -49,16 +49,9 @@ let emit_bytecode i (bytecode, required_globals) =
(Emitcode.to_file oc i.modulename cmofile ~required_globals);
)
let implementation ~sourcefile ~outputprefix =
Compmisc.with_ppf_dump ~fileprefix:(outputprefix ^ ".cmo") @@ fun ppf_dump ->
let info =
init ppf_dump ~init_path:false ~tool_name ~sourcefile ~outputprefix
in
Profile.record_call info.sourcefile @@ fun () ->
let parsed = parse_impl info in
let typed = typecheck_impl info parsed in
if not !Clflags.print_types then begin
let bytecode = to_bytecode info typed in
emit_bytecode info bytecode
end;
Warnings.check_fatal ();
let implementation =
Compile_common.implementation
~native:false ~tool_name ~backend:(fun info typed ->
let bytecode = to_bytecode info typed in
emit_bytecode info bytecode
)

17
driver/compile_common.ml
View File

@ -103,3 +103,20 @@ let typecheck_impl i parsetree =
|> print_if i.ppf_dump Clflags.dump_typedtree
Printtyped.implementation_with_coercion
)
let implementation ~tool_name ~native ~backend ~sourcefile ~outputprefix =
let suf, sufs = if native then ".cmx", [ cmx; obj ] else ".cmo", [ cmo ] in
Compmisc.with_ppf_dump ~fileprefix:(outputprefix ^ suf) @@ fun ppf_dump ->
let info =
init ppf_dump ~init_path:native ~tool_name ~sourcefile ~outputprefix
in
Profile.record_call info.sourcefile @@ fun () ->
let parsed = parse_impl info in
let typed = typecheck_impl info parsed in
if not !Clflags.print_types then begin
let exceptionally () =
List.iter (fun suf -> remove_file (suf info)) sufs;
in
Misc.try_finally ~exceptionally (fun () -> backend info typed)
end;
Warnings.check_fatal ();

9
driver/compile_common.mli
View File

@ -67,6 +67,15 @@ val typecheck_impl :
its public interface.
*)
val implementation :
tool_name:string ->
native:bool ->
backend:(info -> Typedtree.structure * Typedtree.module_coercion -> unit) ->
sourcefile:string ->
outputprefix:string ->
unit
(** The complete compilation pipeline for implementations. *)
(** {2 Build artifacts} *)
val cmo : info -> string

21
driver/optcompile.ml
View File

@ -71,24 +71,11 @@ let clambda i typed =
i.outputprefix ~ppf_dump:i.ppf_dump;
Compilenv.save_unit_info (cmx i))
let implementation ~backend ~sourcefile ~outputprefix =
Compmisc.with_ppf_dump ~fileprefix:(outputprefix ^ ".cmo") @@ fun ppf_dump ->
let info =
init ppf_dump ~init_path:true ~tool_name ~sourcefile ~outputprefix
in
Compilenv.reset ?packname:!Clflags.for_package info.modulename;
Profile.record_call info.sourcefile @@ fun () ->
let parsed = parse_impl info in
let typed = typecheck_impl info parsed in
if not !Clflags.print_types then begin
let exceptionally () =
Misc.remove_file (Compile_common.obj info);
Misc.remove_file (Compile_common.cmx info);
in
Misc.try_finally ~exceptionally (fun () ->
let implementation ~backend =
Compile_common.implementation ~tool_name
~native:true ~backend:(fun info typed ->
Compilenv.reset ?packname:!Clflags.for_package info.modulename;
if Config.flambda
then flambda info backend typed
else clambda info typed
)
end;
Warnings.check_fatal ();