diff options
| -rw-r--r-- | driver/compile.ml | 3 | ||||
| -rw-r--r-- | driver/main.ml | 1 | ||||
| -rw-r--r-- | driver/main_args.ml | 12 | ||||
| -rw-r--r-- | driver/main_args.mli | 4 | ||||
| -rw-r--r-- | driver/optcompile.ml | 3 | ||||
| -rw-r--r-- | driver/optmain.ml | 1 | ||||
| -rw-r--r-- | parsing/pprintast.ml | 2 | ||||
| -rw-r--r-- | parsing/pprintast.mli | 2 | ||||
| -rw-r--r-- | tools/ocamlcp.ml | 1 | ||||
| -rw-r--r-- | tools/ocamloptp.ml | 1 | ||||
| -rw-r--r-- | toplevel/opttoploop.ml | 2 | ||||
| -rw-r--r-- | toplevel/opttopmain.ml | 1 | ||||
| -rw-r--r-- | toplevel/toploop.ml | 2 | ||||
| -rw-r--r-- | toplevel/topmain.ml | 1 | ||||
| -rw-r--r-- | utils/clflags.ml | 1 | ||||
| -rw-r--r-- | utils/clflags.mli | 1 |
16 files changed, 36 insertions, 2 deletions
diff --git a/driver/compile.ml b/driver/compile.ml index c3873d32f..f1aaaa9e7 100644 --- a/driver/compile.ml +++ b/driver/compile.ml @@ -82,6 +82,7 @@ let interface ppf sourcefile outputprefix = let ast = Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast; + if !Clflags.dump_source then fprintf ppf "%a@." Pprintast.signature ast; let tsg = Typemod.transl_signature initial_env ast in let sg = tsg.sig_type in if !Clflags.print_types then @@ -121,6 +122,7 @@ let implementation ppf sourcefile outputprefix = try ignore( Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number ++ print_if ppf Clflags.dump_parsetree Printast.implementation + ++ print_if ppf Clflags.dump_source Pprintast.structure ++ Typemod.type_implementation sourcefile outputprefix modulename env); Warnings.check_fatal (); Pparse.remove_preprocessed inputfile; @@ -135,6 +137,7 @@ let implementation ppf sourcefile outputprefix = try Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number ++ print_if ppf Clflags.dump_parsetree Printast.implementation + ++ print_if ppf Clflags.dump_source Pprintast.structure ++ Typemod.type_implementation sourcefile outputprefix modulename env ++ Translmod.transl_implementation modulename ++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda diff --git a/driver/main.ml b/driver/main.ml index 8b895af63..b3d5842a0 100644 --- a/driver/main.ml +++ b/driver/main.ml @@ -138,6 +138,7 @@ module Options = Main_args.Make_bytecomp_options (struct let _where = print_standard_library let _verbose = set verbose let _nopervasives = set nopervasives + let _dsource = set dump_source let _dparsetree = set dump_parsetree let _drawlambda = set dump_rawlambda let _dlambda = set dump_lambda diff --git a/driver/main_args.ml b/driver/main_args.ml index c5fd7c8f3..3f3e063ae 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -330,6 +330,10 @@ let mk_drawlambda f = "-drawlambda", Arg.Unit f, " (undocumented)" ;; +let mk_dsource f = + "-dsource", Arg.Unit f, " (undocumented)" +;; + let mk_dlambda f = "-dlambda", Arg.Unit f, " (undocumented)" ;; @@ -450,6 +454,7 @@ module type Bytecomp_options = sig val _nopervasives : unit -> unit val _use_prims : string -> unit + val _dsource : unit -> unit val _dparsetree : unit -> unit val _drawlambda : unit -> unit val _dlambda : unit -> unit @@ -480,6 +485,7 @@ module type Bytetop_options = sig val _warn_error : string -> unit val _warn_help : unit -> unit + val _dsource : unit -> unit val _dparsetree : unit -> unit val _drawlambda : unit -> unit val _dlambda : unit -> unit @@ -539,6 +545,7 @@ module type Optcomp_options = sig val _where : unit -> unit val _nopervasives : unit -> unit + val _dsource : unit -> unit val _dparsetree : unit -> unit val _drawlambda : unit -> unit val _dlambda : unit -> unit @@ -585,6 +592,7 @@ module type Opttop_options = sig val _warn_error : string -> unit val _warn_help : unit -> unit + val _dsource : unit -> unit val _dparsetree : unit -> unit val _drawlambda : unit -> unit val _dlambda : unit -> unit @@ -669,6 +677,7 @@ struct mk_nopervasives F._nopervasives; mk_use_prims F._use_prims; + mk_dsource F._dsource; mk_dparsetree F._dparsetree; mk_drawlambda F._drawlambda; mk_dlambda F._dlambda; @@ -702,6 +711,7 @@ struct mk_warn_error F._warn_error; mk_warn_help F._warn_help; + mk_dsource F._dsource; mk_dparsetree F._dparsetree; mk_drawlambda F._drawlambda; mk_dlambda F._dlambda; @@ -765,6 +775,7 @@ struct mk_where F._where; mk_nopervasives F._nopervasives; + mk_dsource F._dsource; mk_dparsetree F._dparsetree; mk_drawlambda F._drawlambda; mk_dlambda F._dlambda; @@ -813,6 +824,7 @@ module Make_opttop_options (F : Opttop_options) = struct mk_warn_error F._warn_error; mk_warn_help F._warn_help; + mk_dsource F._dsource; mk_dparsetree F._dparsetree; mk_drawlambda F._drawlambda; mk_dclambda F._dclambda; diff --git a/driver/main_args.mli b/driver/main_args.mli index bbdc8ec41..80e659e3f 100644 --- a/driver/main_args.mli +++ b/driver/main_args.mli @@ -62,6 +62,7 @@ module type Bytecomp_options = val _nopervasives : unit -> unit val _use_prims : string -> unit + val _dsource : unit -> unit val _dparsetree : unit -> unit val _drawlambda : unit -> unit val _dlambda : unit -> unit @@ -93,6 +94,7 @@ module type Bytetop_options = sig val _warn_error : string -> unit val _warn_help : unit -> unit + val _dsource : unit -> unit val _dparsetree : unit -> unit val _drawlambda : unit -> unit val _dlambda : unit -> unit @@ -152,6 +154,7 @@ module type Optcomp_options = sig val _where : unit -> unit val _nopervasives : unit -> unit + val _dsource : unit -> unit val _dparsetree : unit -> unit val _drawlambda : unit -> unit val _dlambda : unit -> unit @@ -198,6 +201,7 @@ module type Opttop_options = sig val _warn_error : string -> unit val _warn_help : unit -> unit + val _dsource : unit -> unit val _dparsetree : unit -> unit val _drawlambda : unit -> unit val _dlambda : unit -> unit diff --git a/driver/optcompile.ml b/driver/optcompile.ml index 9bd1d9b05..1c0a540ae 100644 --- a/driver/optcompile.ml +++ b/driver/optcompile.ml @@ -79,6 +79,7 @@ let interface ppf sourcefile outputprefix = let ast = Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast; + if !Clflags.dump_source then fprintf ppf "%a@." Pprintast.signature ast; let tsg = Typemod.transl_signature initial_env ast in let sg = tsg.sig_type in if !Clflags.print_types then @@ -123,10 +124,12 @@ let implementation ppf sourcefile outputprefix = if !Clflags.print_types then ignore( Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number ++ print_if ppf Clflags.dump_parsetree Printast.implementation + ++ print_if ppf Clflags.dump_source Pprintast.structure ++ Typemod.type_implementation sourcefile outputprefix modulename env) else begin Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number ++ print_if ppf Clflags.dump_parsetree Printast.implementation + ++ print_if ppf Clflags.dump_source Pprintast.structure ++ Typemod.type_implementation sourcefile outputprefix modulename env ++ Translmod.transl_store_implementation modulename +++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda diff --git a/driver/optmain.ml b/driver/optmain.ml index 9afdbb428..84d6fd02f 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -149,6 +149,7 @@ module Options = Main_args.Make_optcomp_options (struct let _where () = print_standard_library () let _nopervasives = set nopervasives + let _dsource = set dump_source let _dparsetree = set dump_parsetree let _drawlambda = set dump_rawlambda let _dlambda = set dump_lambda diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml index 98c73aad6..6ce6c31c9 100644 --- a/parsing/pprintast.ml +++ b/parsing/pprintast.ml @@ -2198,7 +2198,7 @@ let string_of_expression x = expression ppf x ; flush_str_formatter () ;; -let toplevel_phrase ppf x = +let top_phrase ppf x = pp_print_newline ppf () ; toplevel_phrase ppf x; fprintf ppf ";;" ; diff --git a/parsing/pprintast.mli b/parsing/pprintast.mli index ec89e3ad5..3a87faf4b 100644 --- a/parsing/pprintast.mli +++ b/parsing/pprintast.mli @@ -15,4 +15,4 @@ val signature: Format.formatter -> Parsetree.signature -> unit val expression: Format.formatter -> Parsetree.expression -> unit val pattern: Format.formatter -> Parsetree.pattern -> unit val core_type: Format.formatter -> Parsetree.core_type -> unit - +val top_phrase: Format.formatter -> Parsetree.toplevel_phrase -> unit diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml index eb9036bf6..b611094ca 100644 --- a/tools/ocamlcp.ml +++ b/tools/ocamlcp.ml @@ -90,6 +90,7 @@ module Options = Main_args.Make_bytecomp_options (struct let _warn_help = option "-warn-help" let _where = option "-where" let _nopervasives = option "-nopervasives" + let _dsource = option "-dsource" let _dparsetree = option "-dparsetree" let _drawlambda = option "-drawlambda" let _dlambda = option "-dlambda" diff --git a/tools/ocamloptp.ml b/tools/ocamloptp.ml index 8eb08f440..57f7085de 100644 --- a/tools/ocamloptp.ml +++ b/tools/ocamloptp.ml @@ -93,6 +93,7 @@ module Options = Main_args.Make_optcomp_options (struct let _where = option "-where" let _nopervasives = option "-nopervasives" + let _dsource = option "-dsource" let _dparsetree = option "-dparsetree" let _drawlambda = option "-drawlambda" let _dlambda = option "-dlambda" diff --git a/toplevel/opttoploop.ml b/toplevel/opttoploop.ml index 5634b38af..f05414d55 100644 --- a/toplevel/opttoploop.ml +++ b/toplevel/opttoploop.ml @@ -317,6 +317,7 @@ let use_file ppf name = List.iter (fun ph -> if !Clflags.dump_parsetree then Printast.top_phrase ppf ph; + if !Clflags.dump_source then Pprintast.top_phrase ppf ph; if not (execute_phrase !use_print_results ppf ph) then raise Exit) (!parse_use_file lb); true @@ -430,6 +431,7 @@ let loop ppf = first_line := true; let phr = try !parse_toplevel_phrase lb with Exit -> raise PPerror in if !Clflags.dump_parsetree then Printast.top_phrase ppf phr; + if !Clflags.dump_source then Pprintast.top_phrase ppf ph; ignore(execute_phrase true ppf phr) with | End_of_file -> exit 0 diff --git a/toplevel/opttopmain.ml b/toplevel/opttopmain.ml index f603981f6..4f5b29b72 100644 --- a/toplevel/opttopmain.ml +++ b/toplevel/opttopmain.ml @@ -86,6 +86,7 @@ module Options = Main_args.Make_opttop_options (struct let _warn_error s = Warnings.parse_options true s let _warn_help = Warnings.help_warnings + let _dsource = set dump_source let _dparsetree = set dump_parsetree let _drawlambda = set dump_rawlambda let _dlambda = set dump_lambda diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml index c528a5040..899ff307f 100644 --- a/toplevel/toploop.ml +++ b/toplevel/toploop.ml @@ -305,6 +305,7 @@ let use_file ppf name = List.iter (fun ph -> if !Clflags.dump_parsetree then Printast.top_phrase ppf ph; + if !Clflags.dump_source then Pprintast.top_phrase ppf ph; if not (execute_phrase !use_print_results ppf ph) then raise Exit) (!parse_use_file lb); true @@ -420,6 +421,7 @@ let loop ppf = first_line := true; let phr = try !parse_toplevel_phrase lb with Exit -> raise PPerror in if !Clflags.dump_parsetree then Printast.top_phrase ppf phr; + if !Clflags.dump_source then Pprintast.top_phrase ppf phr; Env.reset_cache_toplevel (); ignore(execute_phrase true ppf phr) with diff --git a/toplevel/topmain.ml b/toplevel/topmain.ml index e173f53a1..09f9daee8 100644 --- a/toplevel/topmain.ml +++ b/toplevel/topmain.ml @@ -82,6 +82,7 @@ module Options = Main_args.Make_bytetop_options (struct let _warn_error s = Warnings.parse_options true s let _warn_help = Warnings.help_warnings let _dparsetree = set dump_parsetree + let _dsource = set dump_source let _drawlambda = set dump_rawlambda let _dlambda = set dump_lambda let _dinstr = set dump_instr diff --git a/utils/clflags.ml b/utils/clflags.ml index 42ec3405b..30644c2ae 100644 --- a/utils/clflags.ml +++ b/utils/clflags.ml @@ -55,6 +55,7 @@ and dllpaths = ref ([] : string list) (* -dllpath *) and make_package = ref false (* -pack *) and for_package = ref (None: string option) (* -for-pack *) and error_size = ref 500 (* -error-size *) +let dump_source = ref false (* -dsource *) let dump_parsetree = ref false (* -dparsetree *) and dump_rawlambda = ref false (* -drawlambda *) and dump_lambda = ref false (* -dlambda *) diff --git a/utils/clflags.mli b/utils/clflags.mli index 1560964b3..5164197b0 100644 --- a/utils/clflags.mli +++ b/utils/clflags.mli @@ -52,6 +52,7 @@ val dllpaths : string list ref val make_package : bool ref val for_package : string option ref val error_size : int ref +val dump_source : bool ref val dump_parsetree : bool ref val dump_rawlambda : bool ref val dump_lambda : bool ref |