flambda-backend: Add dedicated printline-debugging support (#1308)

ocaml-flambda · May 2, 2023 · c0482d3 · c0482d3
1 parent 7b295b0
commit c0482d3
Show file tree

Hide file tree

Showing 12 changed files with 75 additions and 3 deletions.
diff --git a/.depend b/.depend
@@ -75,6 +75,13 @@ utils/consistbl.cmx : \
     utils/consistbl.cmi
 utils/consistbl.cmi : \
     utils/misc.cmi
+utils/debug.cmo : \
+    utils/clflags.cmi \
+    utils/debug.cmi
+utils/debug.cmx : \
+    utils/clflags.cmx \
+    utils/debug.cmi
+utils/debug.cmi :
 utils/diffing.cmo : \
     utils/misc.cmi \
     utils/diffing.cmi

diff --git a/compilerlibs/Makefile.compilerlibs b/compilerlibs/Makefile.compilerlibs
@@ -34,6 +34,7 @@ UTILS = \
   utils/local_store.cmo \
   utils/load_path.cmo \
   utils/clflags.cmo \
+  utils/debug.cmo \
   utils/language_extension.cmo \
   utils/profile.cmo \
   utils/terminfo.cmo \

diff --git a/driver/main_args.ml b/driver/main_args.ml
@@ -921,6 +921,10 @@ let mk_dstartup f =
   "-dstartup", Arg.Unit f, " (undocumented)"
 ;;
 
+let mk_debug_ocaml f =
+  "-debug-ocaml", Arg.Unit f, " Debugging output for the compiler\n\
+                               (internal use only)"
+
 let mk_opaque f =
   "-opaque", Arg.Unit f,
   " Does not generate cross-module optimization information\n\
@@ -1005,6 +1009,7 @@ module type Common_options = sig
   val _version : unit -> unit
   val _vnum : unit -> unit
   val _w : string -> unit
+  val _debug_ocaml : unit -> unit
 
   val anonymous : string -> unit
 end
@@ -1341,6 +1346,7 @@ struct
     mk_dprofile F._dprofile;
     mk_dump_into_file F._dump_into_file;
     mk_dump_dir F._dump_dir;
+    mk_debug_ocaml F._debug_ocaml;
 
     mk_args F._args;
     mk_args0 F._args0;
@@ -1409,6 +1415,7 @@ struct
     mk_drawlambda F._drawlambda;
     mk_dlambda F._dlambda;
     mk_dinstr F._dinstr;
+    mk_debug_ocaml F._debug_ocaml;
 
     mk_args F._args;
     mk_args0 F._args0;
@@ -1578,6 +1585,7 @@ struct
     mk_dump_into_file F._dump_into_file;
     mk_dump_dir F._dump_dir;
     mk_dump_pass F._dump_pass;
+    mk_debug_ocaml F._debug_ocaml;
 
     mk_args F._args;
     mk_args0 F._args0;
@@ -1686,6 +1694,8 @@ module Make_opttop_options (F : Opttop_options) = struct
     mk_dinterval F._dinterval;
     mk_dstartup F._dstartup;
     mk_dump_pass F._dump_pass;
+    mk_debug_ocaml F._debug_ocaml;
+
     mk_eval F._eval;
   ]
 end;;
@@ -1738,6 +1748,7 @@ struct
     mk_vnum F._vnum;
     mk_w F._w;
     mk__ F.anonymous;
+    mk_debug_ocaml F._debug_ocaml;
   ]
 end;;
 
@@ -1823,6 +1834,7 @@ module Default = struct
     let _unsafe_string = set unsafe_string
     let _w s =
       Warnings.parse_options false s |> Option.iter Location.(prerr_alert none)
+    let _debug_ocaml = set debug_ocaml
 
     let anonymous = Compenv.anonymous
 

diff --git a/driver/main_args.mli b/driver/main_args.mli
@@ -50,7 +50,7 @@ module type Common_options = sig
   val _version : unit -> unit
   val _vnum : unit -> unit
   val _w : string -> unit
-
+  val _debug_ocaml : unit -> unit
 
   val anonymous : string -> unit
 end

diff --git a/dune b/dune
@@ -60,7 +60,7 @@
  (modules
    ;; UTILS
    config build_path_prefix_map misc identifiable numbers arg_helper clflags
-   profile terminfo ccomp warnings consistbl strongly_connected_components
+   debug profile terminfo ccomp warnings consistbl strongly_connected_components
    targetint load_path int_replace_polymorphic_compare domainstate binutils
    local_store target_system compilation_unit import_info linkage_name symbol
    lazy_backtrack diffing diffing_with_keys language_extension

diff --git a/otherlibs/dynlink/Makefile b/otherlibs/dynlink/Makefile
@@ -80,6 +80,7 @@ COMPILERLIBS_SOURCES=\
   utils/local_store.ml \
   utils/load_path.ml \
   utils/clflags.ml \
+  utils/debug.ml \
   utils/language_extension.ml \
   utils/profile.ml \
   utils/consistbl.ml \

diff --git a/otherlibs/dynlink/dune b/otherlibs/dynlink/dune
@@ -31,6 +31,7 @@
     numbers
     arg_helper
     clflags
+    debug
     language_extension
     profile
     consistbl
@@ -109,6 +110,7 @@
 (copy_files ../../utils/numbers.ml)
 (copy_files ../../utils/arg_helper.ml)
 (copy_files ../../utils/clflags.ml)
+(copy_files ../../utils/debug.ml)
 (copy_files ../../utils/language_extension.ml)
 (copy_files ../../utils/profile.ml)
 (copy_files ../../utils/consistbl.ml)
@@ -165,6 +167,7 @@
 (copy_files ../../utils/numbers.mli)
 (copy_files ../../utils/arg_helper.mli)
 (copy_files ../../utils/clflags.mli)
+(copy_files ../../utils/debug.mli)
 (copy_files ../../utils/language_extension.mli)
 (copy_files ../../utils/profile.mli)
 (copy_files ../../utils/consistbl.mli)
@@ -263,6 +266,7 @@
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Numbers.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Profile.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Clflags.cmo
+      .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Debug.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Language_extension.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Terminfo.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Location.cmo
@@ -334,6 +338,7 @@
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Numbers.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Profile.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Clflags.cmx
+      .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Debug.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Language_extension.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Terminfo.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Location.cmx

diff --git a/tools/Makefile b/tools/Makefile
@@ -83,7 +83,7 @@ ocamldep.opt$(EXE): $(call byte2native, $(OCAMLDEP))
 # The profiler
 
 OCAMLPROF=config.cmo build_path_prefix_map.cmo misc.cmo identifiable.cmo \
-  numbers.cmo arg_helper.cmo clflags.cmo terminfo.cmo \
+  numbers.cmo arg_helper.cmo clflags.cmo debug.cmo terminfo.cmo \
   warnings.cmo location.cmo longident.cmo docstrings.cmo \
   syntaxerr.cmo ast_helper.cmo \
   language_extension.cmo extensions_parsing.cmo extensions.cmo \

diff --git a/utils/clflags.ml b/utils/clflags.ml
@@ -132,6 +132,7 @@ let dump_linear = ref false             (* -dlinear *)
 let dump_interval = ref false           (* -dinterval *)
 let keep_startup_file = ref false       (* -dstartup *)
 let dump_combine = ref false            (* -dcombine *)
+let debug_ocaml = ref false             (* -debug-ocaml *)
 let default_timings_precision  = 3
 let timings_precision = ref default_timings_precision (* -dtimings-precision *)
 let profile_columns : Profile.column list ref = ref [] (* -dprofile/-dtimings *)

diff --git a/utils/clflags.mli b/utils/clflags.mli
@@ -138,6 +138,7 @@ val dump_reload : bool ref
 val dump_scheduling : bool ref
 val dump_linear : bool ref
 val dump_interval : bool ref
+val debug_ocaml : bool ref
 val keep_startup_file : bool ref
 val dump_combine : bool ref
 val native_code : bool ref

diff --git a/utils/debug.ml b/utils/debug.ml
@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Richard Eisenberg, Jane Street, New York                *)
+(*                                                                        *)
+(*   Copyright 2023 Jane Street Group LLC                                 *)
+(*                                                                        *)
+(*   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 Format
+
+let print fmt =
+  if !Clflags.debug_ocaml
+  then printf (fmt ^^ "@.")
+  else ifprintf std_formatter fmt
diff --git a/utils/debug.mli b/utils/debug.mli
@@ -0,0 +1,24 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                Richard Eisenberg, Jane Street, New York                *)
+(*                                                                        *)
+(*   Copyright 2023 Jane Street Group LLC                                 *)
+(*                                                                        *)
+(*   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 Format
+
+(** Print some output to stdout, if [-debug-ocaml] is given on this
+    invocation of ocaml. Example:
+
+    {[
+       Debug.print "The type is %a" Printtyp.raw_type_expr ty
+    ]}
+*)
+val print : ('a, formatter, unit) format -> 'a