Add compile_common.ml which contains the basic compilation pipeline.
Factorize the part from compile.ml and optcompile.ml.master
Drup
parent
d8dc9f3b7c
commit
abc0b7e3ed
78
.depend
78
.depend
|
|
@ -2317,25 +2317,18 @@ driver/compenv.cmx : utils/warnings.cmx utils/profile.cmx utils/misc.cmx \
|
|||
parsing/location.cmx utils/config.cmx utils/clflags.cmx utils/ccomp.cmx \
|
||||
driver/compenv.cmi
|
||||
driver/compenv.cmi :
|
||||
driver/compile.cmo : utils/warnings.cmi typing/typemod.cmi \
|
||||
typing/typedtree.cmi typing/typecore.cmi bytecomp/translmod.cmi \
|
||||
typing/stypes.cmi bytecomp/simplif.cmi utils/profile.cmi \
|
||||
typing/printtyped.cmi typing/printtyp.cmi bytecomp/printlambda.cmi \
|
||||
bytecomp/printinstr.cmi parsing/printast.cmi parsing/pprintast.cmi \
|
||||
driver/pparse.cmi utils/misc.cmi bytecomp/lambda.cmi \
|
||||
typing/includemod.cmi typing/env.cmi bytecomp/emitcode.cmi \
|
||||
driver/compmisc.cmi driver/compenv.cmi utils/clflags.cmi \
|
||||
bytecomp/bytegen.cmi parsing/builtin_attributes.cmi driver/compile.cmi
|
||||
driver/compile.cmx : utils/warnings.cmx typing/typemod.cmx \
|
||||
typing/typedtree.cmx typing/typecore.cmx bytecomp/translmod.cmx \
|
||||
typing/stypes.cmx bytecomp/simplif.cmx utils/profile.cmx \
|
||||
typing/printtyped.cmx typing/printtyp.cmx bytecomp/printlambda.cmx \
|
||||
bytecomp/printinstr.cmx parsing/printast.cmx parsing/pprintast.cmx \
|
||||
driver/pparse.cmx utils/misc.cmx bytecomp/lambda.cmx \
|
||||
typing/includemod.cmx typing/env.cmx bytecomp/emitcode.cmx \
|
||||
driver/compmisc.cmx driver/compenv.cmx utils/clflags.cmx \
|
||||
bytecomp/bytegen.cmx parsing/builtin_attributes.cmx driver/compile.cmi
|
||||
driver/compile.cmi :
|
||||
driver/compile.cmo : utils/warnings.cmi bytecomp/translmod.cmi \
|
||||
bytecomp/simplif.cmi utils/profile.cmi bytecomp/printlambda.cmi \
|
||||
bytecomp/printinstr.cmi utils/misc.cmi driver/compile_common.cmi \
|
||||
bytecomp/lambda.cmi bytecomp/emitcode.cmi utils/clflags.cmi \
|
||||
bytecomp/bytegen.cmi driver/compile.cmi
|
||||
driver/compile.cmx : utils/warnings.cmx bytecomp/translmod.cmx \
|
||||
bytecomp/simplif.cmx utils/profile.cmx bytecomp/printlambda.cmx \
|
||||
bytecomp/printinstr.cmx utils/misc.cmx driver/compile_common.cmx \
|
||||
bytecomp/lambda.cmx bytecomp/emitcode.cmx utils/clflags.cmx \
|
||||
bytecomp/bytegen.cmx driver/compile.cmi
|
||||
driver/compile.cmi : typing/typedtree.cmi driver/compile_common.cmi \
|
||||
bytecomp/instruct.cmi typing/ident.cmi
|
||||
driver/compmisc.cmo : utils/warnings.cmi typing/typemod.cmi utils/misc.cmi \
|
||||
parsing/location.cmi typing/ident.cmi typing/env.cmi utils/config.cmi \
|
||||
driver/compenv.cmi utils/clflags.cmi driver/compmisc.cmi
|
||||
|
|
@ -2353,6 +2346,22 @@ driver/compplugin.cmi :
|
|||
driver/errors.cmo : parsing/location.cmi driver/errors.cmi
|
||||
driver/errors.cmx : parsing/location.cmx driver/errors.cmi
|
||||
driver/errors.cmi :
|
||||
driver/compile_common.cmo : utils/warnings.cmi typing/typemod.cmi \
|
||||
typing/typedtree.cmi typing/typecore.cmi typing/stypes.cmi \
|
||||
utils/profile.cmi typing/printtyped.cmi typing/printtyp.cmi \
|
||||
parsing/printast.cmi parsing/pprintast.cmi driver/pparse.cmi \
|
||||
utils/misc.cmi typing/includemod.cmi typing/env.cmi utils/config.cmi \
|
||||
driver/compmisc.cmi driver/compenv.cmi utils/clflags.cmi \
|
||||
parsing/builtin_attributes.cmi driver/compile_common.cmi
|
||||
driver/compile_common.cmx : utils/warnings.cmx typing/typemod.cmx \
|
||||
typing/typedtree.cmx typing/typecore.cmx typing/stypes.cmx \
|
||||
utils/profile.cmx typing/printtyped.cmx typing/printtyp.cmx \
|
||||
parsing/printast.cmx parsing/pprintast.cmx driver/pparse.cmx \
|
||||
utils/misc.cmx typing/includemod.cmx typing/env.cmx utils/config.cmx \
|
||||
driver/compmisc.cmx driver/compenv.cmx utils/clflags.cmx \
|
||||
parsing/builtin_attributes.cmx driver/compile_common.cmi
|
||||
driver/compile_common.cmi : typing/typedtree.cmi parsing/parsetree.cmi \
|
||||
typing/env.cmi
|
||||
driver/main.cmo : utils/warnings.cmi utils/profile.cmi utils/misc.cmi \
|
||||
driver/makedepend.cmi driver/main_args.cmi parsing/location.cmi \
|
||||
utils/config.cmi driver/compplugin.cmi driver/compmisc.cmi \
|
||||
|
|
@ -2382,25 +2391,18 @@ driver/makedepend.cmx : driver/pparse.cmx parsing/parsetree.cmi \
|
|||
utils/config.cmx driver/compplugin.cmx driver/compenv.cmx \
|
||||
utils/clflags.cmx driver/makedepend.cmi
|
||||
driver/makedepend.cmi :
|
||||
driver/optcompile.cmo : utils/warnings.cmi typing/typemod.cmi \
|
||||
typing/typedtree.cmi typing/typecore.cmi bytecomp/translmod.cmi \
|
||||
typing/stypes.cmi bytecomp/simplif.cmi utils/profile.cmi \
|
||||
typing/printtyped.cmi typing/printtyp.cmi bytecomp/printlambda.cmi \
|
||||
parsing/printast.cmi parsing/pprintast.cmi driver/pparse.cmi \
|
||||
utils/misc.cmi middle_end/middle_end.cmi bytecomp/lambda.cmi \
|
||||
typing/includemod.cmi typing/env.cmi utils/config.cmi driver/compmisc.cmi \
|
||||
asmcomp/compilenv.cmi driver/compenv.cmi utils/clflags.cmi \
|
||||
parsing/builtin_attributes.cmi asmcomp/asmgen.cmi driver/optcompile.cmi
|
||||
driver/optcompile.cmx : utils/warnings.cmx typing/typemod.cmx \
|
||||
typing/typedtree.cmx typing/typecore.cmx bytecomp/translmod.cmx \
|
||||
typing/stypes.cmx bytecomp/simplif.cmx utils/profile.cmx \
|
||||
typing/printtyped.cmx typing/printtyp.cmx bytecomp/printlambda.cmx \
|
||||
parsing/printast.cmx parsing/pprintast.cmx driver/pparse.cmx \
|
||||
utils/misc.cmx middle_end/middle_end.cmx bytecomp/lambda.cmx \
|
||||
typing/includemod.cmx typing/env.cmx utils/config.cmx driver/compmisc.cmx \
|
||||
asmcomp/compilenv.cmx driver/compenv.cmx utils/clflags.cmx \
|
||||
parsing/builtin_attributes.cmx asmcomp/asmgen.cmx driver/optcompile.cmi
|
||||
driver/optcompile.cmi : middle_end/backend_intf.cmi
|
||||
driver/optcompile.cmo : bytecomp/translmod.cmi bytecomp/simplif.cmi \
|
||||
utils/profile.cmi bytecomp/printlambda.cmi middle_end/middle_end.cmi \
|
||||
driver/compile_common.cmi bytecomp/lambda.cmi utils/config.cmi \
|
||||
asmcomp/compilenv.cmi utils/clflags.cmi asmcomp/asmgen.cmi \
|
||||
driver/optcompile.cmi
|
||||
driver/optcompile.cmx : bytecomp/translmod.cmx bytecomp/simplif.cmx \
|
||||
utils/profile.cmx bytecomp/printlambda.cmx middle_end/middle_end.cmx \
|
||||
driver/compile_common.cmx bytecomp/lambda.cmx utils/config.cmx \
|
||||
asmcomp/compilenv.cmx utils/clflags.cmx asmcomp/asmgen.cmx \
|
||||
driver/optcompile.cmi
|
||||
driver/optcompile.cmi : typing/typedtree.cmi driver/compile_common.cmi \
|
||||
middle_end/backend_intf.cmi
|
||||
driver/opterrors.cmo : parsing/location.cmi driver/opterrors.cmi
|
||||
driver/opterrors.cmx : parsing/location.cmx driver/opterrors.cmi
|
||||
driver/opterrors.cmi :
|
||||
|
|
|
|||
4
Changes
4
Changes
|
|
@ -232,6 +232,10 @@ Working version
|
|||
(François Bobot, Gabriel Scherer, and Nicolás Ojeda Bär, review by Gabriel
|
||||
Scherer)
|
||||
|
||||
- GPR#1703 : Add the module Compile_common, which factorizes the common
|
||||
part in Compile and Optcompile. This also makes the pipeline more modular.
|
||||
(Gabriel Radanne, review by Mark Shinwell)
|
||||
|
||||
### Bug fixes:
|
||||
|
||||
- MPR#7726, GPR#1676: Recursive modules, equi-recursive types and stack overflow
|
||||
|
|
|
|||
3
Makefile
3
Makefile
|
|
@ -112,7 +112,8 @@ COMP=bytecomp/lambda.cmo bytecomp/printlambda.cmo \
|
|||
bytecomp/symtable.cmo \
|
||||
driver/pparse.cmo driver/main_args.cmo \
|
||||
driver/compenv.cmo driver/compmisc.cmo \
|
||||
driver/compdynlink.cmo driver/compplugin.cmo driver/makedepend.cmo
|
||||
driver/compdynlink.cmo driver/compplugin.cmo driver/makedepend.cmo \
|
||||
driver/compile_common.cmo
|
||||
|
||||
|
||||
COMMON=$(UTILS) $(PARSING) $(TYPING) $(COMP)
|
||||
|
|
|
|||
|
|
@ -576,12 +576,12 @@ let process_action
|
|||
| ProcessImplementation name ->
|
||||
readenv ppf (Before_compile name);
|
||||
let opref = output_prefix name in
|
||||
implementation name opref;
|
||||
implementation ~sourcefile:name ~outputprefix:opref;
|
||||
objfiles := (opref ^ ocaml_mod_ext) :: !objfiles
|
||||
| ProcessInterface name ->
|
||||
readenv ppf (Before_compile name);
|
||||
let opref = output_prefix name in
|
||||
interface name opref;
|
||||
interface ~sourcefile:name ~outputprefix:opref;
|
||||
if !make_package then objfiles := (opref ^ ".cmi") :: !objfiles
|
||||
| ProcessCFile name ->
|
||||
readenv ppf (Before_compile name);
|
||||
|
|
|
|||
|
|
@ -70,8 +70,10 @@ val intf : string -> unit
|
|||
|
||||
val process_deferred_actions :
|
||||
Format.formatter *
|
||||
(string -> string -> unit) * (* compile implementation *)
|
||||
(string -> string -> unit) * (* compile interface *)
|
||||
(sourcefile:string -> outputprefix:string -> unit) *
|
||||
(* compile implementation *)
|
||||
(sourcefile:string -> outputprefix:string -> unit) *
|
||||
(* compile interface *)
|
||||
string * (* ocaml module extension *)
|
||||
string -> (* ocaml library extension *)
|
||||
unit
|
||||
|
|
|
|||
|
|
@ -13,111 +13,46 @@
|
|||
(* *)
|
||||
(**************************************************************************)
|
||||
|
||||
(* The batch compiler *)
|
||||
|
||||
open Misc
|
||||
open Format
|
||||
open Typedtree
|
||||
open Compenv
|
||||
|
||||
(* Compile a .mli file *)
|
||||
|
||||
(* Keep in sync with the copy in optcompile.ml *)
|
||||
open Compile_common
|
||||
|
||||
let tool_name = "ocamlc"
|
||||
|
||||
let interface sourcefile outputprefix =
|
||||
Compmisc.with_ppf_dump ~fileprefix:(outputprefix ^ ".cmi") (fun ppf_dump ->
|
||||
Profile.record_call sourcefile (fun () ->
|
||||
Compmisc.init_path false;
|
||||
let modulename = module_of_filename sourcefile outputprefix in
|
||||
Env.set_unit_name modulename;
|
||||
let initial_env = Compmisc.initial_env () in
|
||||
let ast = Pparse.parse_interface ~tool_name sourcefile in
|
||||
let interface = Compile_common.interface ~tool_name
|
||||
|
||||
if !Clflags.dump_parsetree then
|
||||
fprintf ppf_dump "%a@." Printast.interface ast;
|
||||
if !Clflags.dump_source then
|
||||
fprintf ppf_dump "%a@." Pprintast.signature ast;
|
||||
Profile.(record_call typing) (fun () ->
|
||||
let tsg = Typemod.type_interface sourcefile initial_env ast in
|
||||
if !Clflags.dump_typedtree then
|
||||
fprintf ppf_dump "%a@." Printtyped.interface tsg;
|
||||
let sg = tsg.sig_type in
|
||||
if !Clflags.print_types then
|
||||
Printtyp.wrap_printing_env ~error:false initial_env (fun () ->
|
||||
fprintf std_formatter "%a@."
|
||||
(Printtyp.printed_signature sourcefile)
|
||||
sg);
|
||||
ignore (Includemod.signatures initial_env sg sg);
|
||||
Typecore.force_delayed_checks ();
|
||||
Warnings.check_fatal ();
|
||||
if not !Clflags.print_types then begin
|
||||
let deprecated = Builtin_attributes.deprecated_of_sig ast in
|
||||
let sg =
|
||||
Env.save_signature ~deprecated sg modulename (outputprefix ^ ".cmi")
|
||||
in
|
||||
Typemod.save_signature modulename tsg outputprefix sourcefile
|
||||
initial_env sg ;
|
||||
end
|
||||
(** Bytecode compilation backend for .ml files. *)
|
||||
|
||||
let to_bytecode i (typedtree, coercion) =
|
||||
(typedtree, coercion)
|
||||
|> Profile.(record transl)
|
||||
(Translmod.transl_implementation i.modulename)
|
||||
|> Profile.(record ~accumulate:true generate)
|
||||
(fun { Lambda.code = lambda; required_globals } ->
|
||||
lambda
|
||||
|> print_if i.ppf_dump Clflags.dump_rawlambda Printlambda.lambda
|
||||
|> Simplif.simplify_lambda i.sourcefile
|
||||
|> print_if i.ppf_dump Clflags.dump_lambda Printlambda.lambda
|
||||
|> Bytegen.compile_implementation i.modulename
|
||||
|> print_if i.ppf_dump Clflags.dump_instr Printinstr.instrlist
|
||||
|> fun bytecode -> bytecode, required_globals
|
||||
)
|
||||
))
|
||||
|
||||
(* Compile a .ml file *)
|
||||
let emit_bytecode i (bytecode, required_globals) =
|
||||
let cmofile = cmo i in
|
||||
let oc = open_out_bin cmofile in
|
||||
Misc.try_finally (fun () ->
|
||||
bytecode
|
||||
|> Profile.(record ~accumulate:true generate)
|
||||
(Emitcode.to_file oc i.modulename cmofile ~required_globals);
|
||||
)
|
||||
~always:(fun () -> close_out oc)
|
||||
~exceptionally:(fun () -> Misc.remove_file cmofile)
|
||||
|
||||
let print_if ppf flag printer arg =
|
||||
if !flag then fprintf ppf "%a@." printer arg;
|
||||
arg
|
||||
|
||||
let (++) x f = f x
|
||||
|
||||
let implementation sourcefile outputprefix =
|
||||
Compmisc.with_ppf_dump ~fileprefix:(outputprefix ^ ".cmo") (fun ppf_dump ->
|
||||
Profile.record_call sourcefile (fun () ->
|
||||
Compmisc.init_path false;
|
||||
let modulename = module_of_filename sourcefile outputprefix in
|
||||
Env.set_unit_name modulename;
|
||||
let env = Compmisc.initial_env() in
|
||||
Misc.try_finally (fun () ->
|
||||
let (typedtree, coercion) =
|
||||
Pparse.parse_implementation ~tool_name sourcefile
|
||||
++ print_if ppf_dump Clflags.dump_parsetree Printast.implementation
|
||||
++ print_if ppf_dump Clflags.dump_source Pprintast.structure
|
||||
++ Profile.(record typing)
|
||||
(Typemod.type_implementation sourcefile outputprefix modulename env)
|
||||
++ print_if ppf_dump Clflags.dump_typedtree
|
||||
Printtyped.implementation_with_coercion
|
||||
in
|
||||
if !Clflags.print_types then begin
|
||||
Warnings.check_fatal ();
|
||||
Stypes.dump (Some (outputprefix ^ ".annot"))
|
||||
end else begin
|
||||
let bytecode, required_globals =
|
||||
(typedtree, coercion)
|
||||
++ Profile.(record transl)
|
||||
(Translmod.transl_implementation modulename)
|
||||
++ Profile.(record ~accumulate:true generate)
|
||||
(fun { Lambda.code = lambda; required_globals } ->
|
||||
lambda
|
||||
++ print_if ppf_dump Clflags.dump_rawlambda Printlambda.lambda
|
||||
++ Simplif.simplify_lambda sourcefile
|
||||
++ print_if ppf_dump Clflags.dump_lambda Printlambda.lambda
|
||||
++ Bytegen.compile_implementation modulename
|
||||
++ print_if ppf_dump Clflags.dump_instr Printinstr.instrlist
|
||||
++ fun bytecode -> bytecode, required_globals)
|
||||
in
|
||||
let objfile = outputprefix ^ ".cmo" in
|
||||
let oc = open_out_bin objfile in
|
||||
Misc.try_finally
|
||||
~always:(fun () -> close_out oc)
|
||||
~exceptionally:(fun () -> remove_file objfile)
|
||||
(fun () ->
|
||||
bytecode
|
||||
++ Profile.(record ~accumulate:true generate)
|
||||
(Emitcode.to_file oc modulename objfile ~required_globals);
|
||||
Warnings.check_fatal ()
|
||||
)
|
||||
end
|
||||
)
|
||||
~always:(fun () -> Stypes.dump (Some (outputprefix ^ ".annot")))
|
||||
))
|
||||
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
|
||||
let frontend info = typecheck_impl info @@ parse_impl info in
|
||||
let backend info typed = emit_bytecode info @@ to_bytecode info typed in
|
||||
wrap_compilation ~frontend ~backend info
|
||||
|
|
|
|||
|
|
@ -13,7 +13,23 @@
|
|||
(* *)
|
||||
(**************************************************************************)
|
||||
|
||||
(* Compile a .ml or .mli file *)
|
||||
(** Bytecode compilation for .ml and .mli files. *)
|
||||
|
||||
val interface: string -> string -> unit
|
||||
val implementation: string -> string -> unit
|
||||
val interface:
|
||||
sourcefile:string -> outputprefix:string -> unit
|
||||
val implementation:
|
||||
sourcefile:string -> outputprefix:string -> unit
|
||||
|
||||
(** {2 Internal functions} **)
|
||||
|
||||
val to_bytecode :
|
||||
Compile_common.info ->
|
||||
Typedtree.structure * Typedtree.module_coercion ->
|
||||
Instruct.instruction list * Ident.Set.t
|
||||
(** [to_bytecode info typed] takes a typechecked implementation
|
||||
and returns its bytecode.
|
||||
*)
|
||||
|
||||
val emit_bytecode :
|
||||
Compile_common.info -> Instruct.instruction list * Ident.Set.t -> unit
|
||||
(** [emit_bytecode bytecode] output the bytecode executable. *)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,118 @@
|
|||
(**************************************************************************)
|
||||
(* *)
|
||||
(* OCaml *)
|
||||
(* *)
|
||||
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
||||
(* *)
|
||||
(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
||||
(* en Automatique. *)
|
||||
(* *)
|
||||
(* All rights reserved. This file is distributed under the terms of *)
|
||||
(* the GNU Lesser General Public License version 2.1, with the *)
|
||||
(* special exception on linking described in the file LICENSE. *)
|
||||
(* *)
|
||||
(**************************************************************************)
|
||||
|
||||
open Misc
|
||||
open Compenv
|
||||
|
||||
type info = {
|
||||
sourcefile : string;
|
||||
modulename : string;
|
||||
outputprefix : string;
|
||||
env : Env.t;
|
||||
ppf_dump : Format.formatter;
|
||||
tool_name : string;
|
||||
}
|
||||
|
||||
|
||||
let cmx i = i.outputprefix ^ ".cmx"
|
||||
let obj i = i.outputprefix ^ Config.ext_obj
|
||||
let cmo i = i.outputprefix ^ ".cmo"
|
||||
let annot i = i.outputprefix ^ ".annot"
|
||||
|
||||
let init ppf_dump ~init_path ~tool_name ~sourcefile ~outputprefix =
|
||||
Compmisc.init_path init_path;
|
||||
let modulename = module_of_filename sourcefile outputprefix in
|
||||
Env.set_unit_name modulename;
|
||||
let env = Compmisc.initial_env() in
|
||||
{ modulename; outputprefix; env; sourcefile; ppf_dump; tool_name }
|
||||
|
||||
|
||||
(** Compile a .mli file *)
|
||||
|
||||
let parse_intf i =
|
||||
Pparse.parse_interface ~tool_name:i.tool_name i.sourcefile
|
||||
|> print_if i.ppf_dump Clflags.dump_parsetree Printast.interface
|
||||
|> print_if i.ppf_dump Clflags.dump_source Pprintast.signature
|
||||
|
||||
let typecheck_intf info ast =
|
||||
Profile.(record_call typing) @@ fun () ->
|
||||
let tsg =
|
||||
ast
|
||||
|> Typemod.type_interface info.sourcefile info.env
|
||||
|> print_if info.ppf_dump Clflags.dump_typedtree Printtyped.interface
|
||||
in
|
||||
let sg = tsg.Typedtree.sig_type in
|
||||
if !Clflags.print_types then
|
||||
Printtyp.wrap_printing_env ~error:false info.env (fun () ->
|
||||
Format.(fprintf std_formatter) "%a@."
|
||||
(Printtyp.printed_signature info.sourcefile)
|
||||
sg);
|
||||
ignore (Includemod.signatures info.env sg sg);
|
||||
Typecore.force_delayed_checks ();
|
||||
Warnings.check_fatal ();
|
||||
tsg
|
||||
|
||||
let emit_signature info ast tsg =
|
||||
let sg =
|
||||
let deprecated = Builtin_attributes.deprecated_of_sig ast in
|
||||
Env.save_signature ~deprecated tsg.Typedtree.sig_type
|
||||
info.modulename (info.outputprefix ^ ".cmi")
|
||||
in
|
||||
Typemod.save_signature info.modulename tsg
|
||||
info.outputprefix info.sourcefile info.env sg
|
||||
|
||||
let interface ~tool_name ~sourcefile ~outputprefix =
|
||||
Compmisc.with_ppf_dump ~fileprefix:(outputprefix ^ ".cmi") @@ fun ppf_dump ->
|
||||
Profile.record_call sourcefile @@ fun () ->
|
||||
let info =
|
||||
init ppf_dump ~init_path:false ~tool_name ~sourcefile ~outputprefix
|
||||
in
|
||||
let ast = parse_intf info in
|
||||
let tsg = typecheck_intf info ast in
|
||||
if not !Clflags.print_types then begin
|
||||
emit_signature info ast tsg
|
||||
end
|
||||
|
||||
|
||||
(** Frontend for a .ml file *)
|
||||
|
||||
let parse_impl i =
|
||||
Pparse.parse_implementation ~tool_name:i.tool_name i.sourcefile
|
||||
|> print_if i.ppf_dump Clflags.dump_parsetree Printast.implementation
|
||||
|> print_if i.ppf_dump Clflags.dump_source Pprintast.structure
|
||||
|
||||
let typecheck_impl i parsetree =
|
||||
parsetree
|
||||
|> Profile.(record typing)
|
||||
(Typemod.type_implementation i.sourcefile i.outputprefix i.modulename i.env)
|
||||
|> print_if i.ppf_dump Clflags.dump_typedtree
|
||||
Printtyped.implementation_with_coercion
|
||||
|
||||
let wrap_compilation ~frontend ~backend info =
|
||||
Profile.record_call info.sourcefile @@ fun () ->
|
||||
Misc.try_finally (fun () ->
|
||||
let typed = frontend info in
|
||||
if not !Clflags.print_types then begin
|
||||
backend info typed
|
||||
end;
|
||||
Warnings.check_fatal ();
|
||||
)
|
||||
~always:(fun () ->
|
||||
Stypes.dump (Some (annot info))
|
||||
)
|
||||
~exceptionally:(fun () ->
|
||||
Misc.remove_file (obj info);
|
||||
Misc.remove_file (cmx info);
|
||||
)
|
||||
|
|
@ -0,0 +1,85 @@
|
|||
(**************************************************************************)
|
||||
(* *)
|
||||
(* OCaml *)
|
||||
(* *)
|
||||
(* Gabriel Radanne *)
|
||||
(* *)
|
||||
(* Copyright 2018 Gabriel Radanne *)
|
||||
(* *)
|
||||
(* All rights reserved. This file is distributed under the terms of *)
|
||||
(* the GNU Lesser General Public License version 2.1, with the *)
|
||||
(* special exception on linking described in the file LICENSE. *)
|
||||
(* *)
|
||||
(**************************************************************************)
|
||||
|
||||
(** Common compilation pipeline between bytecode and native. *)
|
||||
|
||||
(** {2 Initialization} *)
|
||||
|
||||
type info = {
|
||||
sourcefile : string;
|
||||
modulename : string;
|
||||
outputprefix : string;
|
||||
env : Env.t;
|
||||
ppf_dump : Format.formatter;
|
||||
tool_name : string;
|
||||
}
|
||||
(** Information needed to compile a file. *)
|
||||
|
||||
val init :
|
||||
Format.formatter ->
|
||||
init_path:bool ->
|
||||
tool_name:string ->
|
||||
sourcefile:string -> outputprefix:string -> info
|
||||
(** [init ppf ~init_path ~tool_name ~sourcefile ~outputprefix] initializes
|
||||
the various global variables and returns an {!info}.
|
||||
*)
|
||||
|
||||
(** {2 Interfaces} *)
|
||||
|
||||
val parse_intf : info -> Parsetree.signature
|
||||
(** [parse_intf info] parses an interface (usually an [.mli] file). *)
|
||||
|
||||
val typecheck_intf : info -> Parsetree.signature -> Typedtree.signature
|
||||
(** [typecheck_intf info parsetree] typechecks an interface and returns
|
||||
the typedtree of the associated signature.
|
||||
*)
|
||||
|
||||
val emit_signature : info -> Parsetree.signature -> Typedtree.signature -> unit
|
||||
(** [emit_signature info parsetree typedtree] emits the [.cmi] file
|
||||
containing the given signature.
|
||||
*)
|
||||
|
||||
val interface :
|
||||
tool_name:string ->
|
||||
sourcefile:string -> outputprefix:string -> unit
|
||||
(** The complete compilation pipeline for interfaces. *)
|
||||
|
||||
(** {2 Implementations} *)
|
||||
|
||||
val parse_impl : info -> Parsetree.structure
|
||||
(** [parse_impl info] parses an implementation (usually an [.ml] file). *)
|
||||
|
||||
val typecheck_impl :
|
||||
info -> Parsetree.structure -> Typedtree.structure * Typedtree.module_coercion
|
||||
(** [typecheck_impl info parsetree] typechecks an implementation and returns
|
||||
the typedtree of the associated module, along with a coercion against
|
||||
its public interface.
|
||||
*)
|
||||
|
||||
val wrap_compilation :
|
||||
frontend:(info -> 'a) ->
|
||||
backend:(info -> 'a -> unit) -> info -> unit
|
||||
(** [wrap_compilation ~frontend ~backend info] calls [frontend] and [backend]
|
||||
in succession while handling options and errors.
|
||||
*)
|
||||
|
||||
(** {2 Build artifacts} *)
|
||||
|
||||
val cmo : info -> string
|
||||
val cmx : info -> string
|
||||
val obj : info -> string
|
||||
val annot : info -> string
|
||||
(** Return the filename of some compiler build artifacts associated
|
||||
with the file being compiled.
|
||||
*)
|
||||
|
|
@ -13,136 +13,74 @@
|
|||
(* *)
|
||||
(**************************************************************************)
|
||||
|
||||
(* The batch compiler *)
|
||||
(** The batch compiler *)
|
||||
|
||||
open Misc
|
||||
open Config
|
||||
open Format
|
||||
open Typedtree
|
||||
open Compenv
|
||||
|
||||
(* Compile a .mli file *)
|
||||
|
||||
(* Keep in sync with the copy in compile.ml *)
|
||||
open Compile_common
|
||||
|
||||
let tool_name = "ocamlopt"
|
||||
|
||||
let interface sourcefile outputprefix =
|
||||
Compmisc.with_ppf_dump ~fileprefix:(outputprefix ^ ".cmi") (fun ppf_dump ->
|
||||
Profile.record_call sourcefile (fun () ->
|
||||
Compmisc.init_path false;
|
||||
let modulename = module_of_filename sourcefile outputprefix in
|
||||
Env.set_unit_name modulename;
|
||||
let initial_env = Compmisc.initial_env () in
|
||||
let ast = Pparse.parse_interface ~tool_name sourcefile in
|
||||
if !Clflags.dump_parsetree then
|
||||
fprintf ppf_dump "%a@." Printast.interface ast;
|
||||
if !Clflags.dump_source then
|
||||
fprintf ppf_dump "%a@." Pprintast.signature ast;
|
||||
Profile.(record_call typing) (fun () ->
|
||||
let tsg = Typemod.type_interface sourcefile initial_env ast in
|
||||
if !Clflags.dump_typedtree then
|
||||
fprintf ppf_dump "%a@." Printtyped.interface tsg;
|
||||
let sg = tsg.sig_type in
|
||||
if !Clflags.print_types then
|
||||
Printtyp.wrap_printing_env ~error:false initial_env (fun () ->
|
||||
fprintf std_formatter "%a@."
|
||||
(Printtyp.printed_signature sourcefile)
|
||||
sg);
|
||||
ignore (Includemod.signatures initial_env sg sg);
|
||||
Typecore.force_delayed_checks ();
|
||||
Warnings.check_fatal ();
|
||||
if not !Clflags.print_types then begin
|
||||
let deprecated = Builtin_attributes.deprecated_of_sig ast in
|
||||
let sg =
|
||||
Env.save_signature ~deprecated sg modulename (outputprefix ^ ".cmi")
|
||||
in
|
||||
Typemod.save_signature modulename tsg outputprefix sourcefile
|
||||
initial_env sg ;
|
||||
end
|
||||
)
|
||||
))
|
||||
let interface = Compile_common.interface ~tool_name
|
||||
|
||||
(* Compile a .ml file *)
|
||||
let (|>>) (x, y) f = (x, f y)
|
||||
|
||||
let print_if ppf flag printer arg =
|
||||
if !flag then fprintf ppf "%a@." printer arg;
|
||||
arg
|
||||
(** Native compilation backend for .ml files. *)
|
||||
|
||||
let (++) x f = f x
|
||||
let (+++) (x, y) f = (x, f y)
|
||||
let flambda i backend typed =
|
||||
if !Clflags.classic_inlining then begin
|
||||
Clflags.default_simplify_rounds := 1;
|
||||
Clflags.use_inlining_arguments_set Clflags.classic_arguments;
|
||||
Clflags.unbox_free_vars_of_closures := false;
|
||||
Clflags.unbox_specialised_args := false
|
||||
end;
|
||||
typed
|
||||
|> Profile.(record transl)
|
||||
(Translmod.transl_implementation_flambda i.modulename)
|
||||
|> Profile.(record generate)
|
||||
(fun {Lambda.module_ident; main_module_block_size;
|
||||
required_globals; code } ->
|
||||
((module_ident, main_module_block_size), code)
|
||||
|>> print_if i.ppf_dump Clflags.dump_rawlambda Printlambda.lambda
|
||||
|>> Simplif.simplify_lambda i.sourcefile
|
||||
|>> print_if i.ppf_dump Clflags.dump_lambda Printlambda.lambda
|
||||
|> (fun ((module_ident, size), lam) ->
|
||||
Middle_end.middle_end
|
||||
~ppf_dump:i.ppf_dump
|
||||
~prefixname:i.outputprefix
|
||||
~size
|
||||
~filename:i.sourcefile
|
||||
~module_ident
|
||||
~backend
|
||||
~module_initializer:lam)
|
||||
|> Asmgen.compile_implementation_flambda
|
||||
i.outputprefix ~required_globals ~backend ~ppf_dump:i.ppf_dump;
|
||||
Compilenv.save_unit_info (cmx i))
|
||||
|
||||
let implementation ~backend sourcefile outputprefix =
|
||||
Compmisc.with_ppf_dump ~fileprefix:(outputprefix ^ ".cmx") (fun ppf_dump ->
|
||||
Profile.record_call sourcefile (fun () ->
|
||||
Compmisc.init_path true;
|
||||
let modulename = module_of_filename sourcefile outputprefix in
|
||||
Env.set_unit_name modulename;
|
||||
let env = Compmisc.initial_env() in
|
||||
Compilenv.reset ?packname:!Clflags.for_package modulename;
|
||||
let cmxfile = outputprefix ^ ".cmx" in
|
||||
let objfile = outputprefix ^ ext_obj in
|
||||
Misc.try_finally
|
||||
~exceptionally:(fun () -> remove_file objfile; remove_file cmxfile)
|
||||
(fun () ->
|
||||
let (typedtree, coercion) =
|
||||
Pparse.parse_implementation ~tool_name sourcefile
|
||||
++ print_if ppf_dump Clflags.dump_parsetree Printast.implementation
|
||||
++ print_if ppf_dump Clflags.dump_source Pprintast.structure
|
||||
++ Profile.(record typing)
|
||||
(Typemod.type_implementation sourcefile outputprefix
|
||||
modulename env)
|
||||
++ print_if ppf_dump Clflags.dump_typedtree
|
||||
Printtyped.implementation_with_coercion
|
||||
in
|
||||
if not !Clflags.print_types then begin
|
||||
if Config.flambda then begin
|
||||
if !Clflags.classic_inlining then begin
|
||||
Clflags.default_simplify_rounds := 1;
|
||||
Clflags.use_inlining_arguments_set Clflags.classic_arguments;
|
||||
Clflags.unbox_free_vars_of_closures := false;
|
||||
Clflags.unbox_specialised_args := false
|
||||
end;
|
||||
(typedtree, coercion)
|
||||
++ Profile.(record transl)
|
||||
(Translmod.transl_implementation_flambda modulename)
|
||||
++ Profile.(record generate)
|
||||
(fun { Lambda.module_ident; main_module_block_size;
|
||||
required_globals; code } ->
|
||||
((module_ident, main_module_block_size), code)
|
||||
+++ print_if ppf_dump Clflags.dump_rawlambda Printlambda.lambda
|
||||
+++ Simplif.simplify_lambda sourcefile
|
||||
+++ print_if ppf_dump Clflags.dump_lambda Printlambda.lambda
|
||||
++ (fun ((module_ident, size), lam) ->
|
||||
Middle_end.middle_end ~ppf_dump
|
||||
~prefixname:outputprefix
|
||||
~size
|
||||
~filename:sourcefile
|
||||
~module_ident
|
||||
~backend
|
||||
~module_initializer:lam)
|
||||
++ Asmgen.compile_implementation_flambda
|
||||
outputprefix ~required_globals ~backend ~ppf_dump;
|
||||
Compilenv.save_unit_info cmxfile)
|
||||
end
|
||||
else begin
|
||||
Clflags.use_inlining_arguments_set Clflags.classic_arguments;
|
||||
(typedtree, coercion)
|
||||
++ Profile.(record transl)
|
||||
(Translmod.transl_store_implementation modulename)
|
||||
++ print_if ppf_dump Clflags.dump_rawlambda Printlambda.program
|
||||
++ Profile.(record generate)
|
||||
(fun program ->
|
||||
{ program with
|
||||
Lambda.code = Simplif.simplify_lambda sourcefile
|
||||
program.Lambda.code }
|
||||
++ print_if ppf_dump Clflags.dump_lambda Printlambda.program
|
||||
++ Asmgen.compile_implementation_clambda
|
||||
outputprefix ~ppf_dump;
|
||||
Compilenv.save_unit_info cmxfile)
|
||||
end
|
||||
end;
|
||||
Warnings.check_fatal ()
|
||||
)
|
||||
~always:(fun () -> Stypes.dump (Some (outputprefix ^ ".annot")))
|
||||
))
|
||||
let clambda i typed =
|
||||
Clflags.use_inlining_arguments_set Clflags.classic_arguments;
|
||||
typed
|
||||
|> Profile.(record transl)
|
||||
(Translmod.transl_store_implementation i.modulename)
|
||||
|> print_if i.ppf_dump Clflags.dump_rawlambda Printlambda.program
|
||||
|> Profile.(record generate)
|
||||
(fun program ->
|
||||
let code = Simplif.simplify_lambda i.sourcefile program.Lambda.code in
|
||||
{ program with Lambda.code }
|
||||
|> print_if i.ppf_dump Clflags.dump_lambda Printlambda.program
|
||||
|> Asmgen.compile_implementation_clambda
|
||||
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;
|
||||
let frontend info = typecheck_impl info @@ parse_impl info in
|
||||
let backend info typed =
|
||||
if Config.flambda
|
||||
then flambda info backend typed
|
||||
else clambda info typed
|
||||
in
|
||||
wrap_compilation ~frontend ~backend info
|
||||
|
|
|
|||
|
|
@ -13,12 +13,27 @@
|
|||
(* *)
|
||||
(**************************************************************************)
|
||||
|
||||
(* Compile a .ml or .mli file *)
|
||||
(** Native compilation for .ml and .mli files. *)
|
||||
|
||||
val interface: string -> string -> unit
|
||||
val interface: sourcefile:string -> outputprefix:string -> unit
|
||||
|
||||
val implementation:
|
||||
backend:(module Backend_intf.S)
|
||||
-> string
|
||||
-> string
|
||||
-> unit
|
||||
-> sourcefile:string -> outputprefix:string -> unit
|
||||
|
||||
(** {2 Internal functions} **)
|
||||
|
||||
val clambda :
|
||||
Compile_common.info ->
|
||||
Typedtree.structure * Typedtree.module_coercion -> unit
|
||||
(** [clambda info typed] applies the regular compilation pipeline to the
|
||||
given typechecked implementation and outputs the resulting files.
|
||||
*)
|
||||
|
||||
val flambda :
|
||||
Compile_common.info ->
|
||||
(module Backend_intf.S) ->
|
||||
Typedtree.structure * Typedtree.module_coercion -> unit
|
||||
(** [flambda info backend typed] applies the Flambda compilation pipeline to the
|
||||
given typechecked implementation and outputs the resulting files.
|
||||
*)
|
||||
|
|
|
|||
|
|
@ -822,3 +822,7 @@ let debug_prefix_map_flags () =
|
|||
map
|
||||
[]
|
||||
end
|
||||
|
||||
let print_if ppf flag printer arg =
|
||||
if !flag then Format.fprintf ppf "%a@." printer arg;
|
||||
arg
|
||||
|
|
|
|||
|
|
@ -398,3 +398,7 @@ val get_build_path_prefix_map: unit -> Build_path_prefix_map.map option
|
|||
val debug_prefix_map_flags: unit -> string list
|
||||
(** Returns the list of [--debug-prefix-map] flags to be passed to the
|
||||
assembler, built from the [BUILD_PATH_PREFIX_MAP] environment variable. *)
|
||||
|
||||
val print_if :
|
||||
Format.formatter -> bool ref -> (Format.formatter -> 'a -> unit) -> 'a -> 'a
|
||||
(** [print_if ppf flag fmt x] prints [x] with [fmt] on [ppf] if [b] is true. *)
|
||||
|
|
|
|||
Loading…
Reference in New Issue