-dno-locations: hide source locations (and debug events) from IR dumps

This PR was tested with also the -dsel, -dlinear output (also fixed to
not-print locations), but the output is architecture-dependent so this
part of the test was removed.
This commit is contained in:
Gabriel Scherer 2019-12-24 13:35:42 +01:00
parent 96c3ed8859
commit 8938886721
19 changed files with 592 additions and 28 deletions

View File

@ -98,6 +98,10 @@ Working version
- #9107: improved error message for exceptions in module signature errors
(Gabriel Scherer, review by Florian Angeletti)
- #9208: -dno-locations option to hide source locations (and debug events)
from intermediate-representation dumps (-dfoo).
(Gabriel Scherer, review by Vincent Laviron)
### Internal/compiler-libs changes:
- #463: a new Misc.Magic_number module for user-friendly parsing

View File

@ -95,13 +95,17 @@ let phantom_defining_expr_opt ppf defining_expr =
| None -> Format.pp_print_string ppf "()"
| Some defining_expr -> phantom_defining_expr ppf defining_expr
let location d =
if not !Clflags.locations then ""
else Debuginfo.to_string d
let operation d = function
| Capply _ty -> "app" ^ Debuginfo.to_string d
| Capply _ty -> "app" ^ location d
| Cextcall(lbl, _ty, _alloc, _) ->
Printf.sprintf "extcall \"%s\"%s" lbl (Debuginfo.to_string d)
Printf.sprintf "extcall \"%s\"%s" lbl (location d)
| Cload (c, Asttypes.Immutable) -> Printf.sprintf "load %s" (chunk c)
| Cload (c, Asttypes.Mutable) -> Printf.sprintf "load_mut %s" (chunk c)
| Calloc -> "alloc" ^ Debuginfo.to_string d
| Calloc -> "alloc" ^ location d
| Cstore (c, init) ->
let init =
match init with
@ -135,8 +139,8 @@ let operation d = function
| Cfloatofint -> "floatofint"
| Cintoffloat -> "intoffloat"
| Ccmpf c -> Printf.sprintf "%sf" (float_comparison c)
| Craise k -> Lambda.raise_kind k ^ Debuginfo.to_string d
| Ccheckbound -> "checkbound" ^ Debuginfo.to_string d
| Craise k -> Lambda.raise_kind k ^ location d
| Ccheckbound -> "checkbound" ^ location d
let rec expr ppf = function
| Cconst_int (n, _dbg) -> fprintf ppf "%i" n
@ -144,7 +148,7 @@ let rec expr ppf = function
fprintf ppf "%s" (Nativeint.to_string n)
| Cblockheader(n, d) ->
fprintf ppf "block-hdr(%s)%s"
(Nativeint.to_string n) (Debuginfo.to_string d)
(Nativeint.to_string n) (location d)
| Cconst_float (n, _dbg) -> fprintf ppf "%F" n
| Cconst_symbol (s, _dbg) -> fprintf ppf "\"%s\"" s
| Cconst_pointer (n, _dbg) -> fprintf ppf "%ia" n
@ -262,7 +266,7 @@ let fundecl ppf f =
fprintf ppf "%a: %a" VP.print id machtype ty)
cases in
fprintf ppf "@[<1>(function%s %s@;<1 4>@[<1>(%a)@]@ @[%a@])@]@."
(Debuginfo.to_string f.fun_dbg) f.fun_name
(location f.fun_dbg) f.fun_name
print_cases f.fun_args sequence f.fun_body
let data_item ppf = function

View File

@ -70,7 +70,7 @@ let instr ppf i =
| Lraise k ->
fprintf ppf "%s %a" (Lambda.raise_kind k) reg i.arg.(0)
end;
if not (Debuginfo.is_none i.dbg) then
if not (Debuginfo.is_none i.dbg) && !Clflags.locations then
fprintf ppf " %s" (Debuginfo.to_string i.dbg)
let rec all_instr ppf i =
@ -80,7 +80,7 @@ let rec all_instr ppf i =
let fundecl ppf f =
let dbg =
if Debuginfo.is_none f.fun_dbg then
if Debuginfo.is_none f.fun_dbg || not !Clflags.locations then
""
else
" " ^ Debuginfo.to_string f.fun_dbg in

View File

@ -228,7 +228,7 @@ let rec instr ppf i =
| Iraise k ->
fprintf ppf "%s %a" (Lambda.raise_kind k) reg i.arg.(0)
end;
if not (Debuginfo.is_none i.dbg) then
if not (Debuginfo.is_none i.dbg) && !Clflags.locations then
fprintf ppf "%s" (Debuginfo.to_string i.dbg);
begin match i.next.desc with
Iend -> ()
@ -237,7 +237,7 @@ let rec instr ppf i =
let fundecl ppf f =
let dbg =
if Debuginfo.is_none f.fun_dbg then
if Debuginfo.is_none f.fun_dbg || not !Clflags.locations then
""
else
" " ^ Debuginfo.to_string f.fun_dbg in

View File

@ -706,6 +706,14 @@ let mk_dunique_ids f =
"-dunique-ids", Arg.Unit f, " (undocumented)"
;;
let mk_dno_locations f =
"-dno-locations", Arg.Unit f, " (undocumented)"
;;
let mk_dlocations f =
"-dlocations", Arg.Unit f, " (undocumented)"
;;
let mk_dsource f =
"-dsource", Arg.Unit f, " (undocumented)"
;;
@ -922,6 +930,9 @@ module type Core_options = sig
val _dno_unique_ids : unit -> unit
val _dunique_ids : unit -> unit
val _dno_locations : unit -> unit
val _dlocations : unit -> unit
val _dsource : unit -> unit
val _dparsetree : unit -> unit
val _dtypedtree : unit -> unit
@ -1214,6 +1225,8 @@ struct
mk_use_prims F._use_prims;
mk_dno_unique_ids F._dno_unique_ids;
mk_dunique_ids F._dunique_ids;
mk_dno_locations F._dno_locations;
mk_dlocations F._dlocations;
mk_dsource F._dsource;
mk_dparsetree F._dparsetree;
mk_dtypedtree F._dtypedtree;
@ -1279,6 +1292,8 @@ struct
mk_dno_unique_ids F._dno_unique_ids;
mk_dunique_ids F._dunique_ids;
mk_dno_locations F._dno_locations;
mk_dlocations F._dlocations;
mk_dsource F._dsource;
mk_dparsetree F._dparsetree;
mk_dtypedtree F._dtypedtree;
@ -1406,6 +1421,8 @@ struct
mk_match_context_rows F._match_context_rows;
mk_dno_unique_ids F._dno_unique_ids;
mk_dunique_ids F._dunique_ids;
mk_dno_locations F._dno_locations;
mk_dlocations F._dlocations;
mk_dsource F._dsource;
mk_dparsetree F._dparsetree;
mk_dtypedtree F._dtypedtree;
@ -1678,12 +1695,14 @@ module Default = struct
let _I dir = include_dirs := (dir :: (!include_dirs))
let _color = Misc.set_or_ignore color_reader.parse color
let _dlambda = set dump_lambda
let _dno_unique_ids = clear unique_ids
let _dparsetree = set dump_parsetree
let _drawlambda = set dump_rawlambda
let _dsource = set dump_source
let _dtypedtree = set dump_typedtree
let _dunique_ids = set unique_ids
let _dno_unique_ids = clear unique_ids
let _dlocations = set locations
let _dno_locations = clear locations
let _error_style =
Misc.set_or_ignore error_style_reader.parse error_style
let _nopervasives = set nopervasives

View File

@ -60,6 +60,8 @@ module type Core_options = sig
val _dno_unique_ids : unit -> unit
val _dunique_ids : unit -> unit
val _dno_locations : unit -> unit
val _dlocations : unit -> unit
val _dsource : unit -> unit
val _dparsetree : unit -> unit
val _dtypedtree : unit -> unit

View File

@ -625,13 +625,20 @@ let rec lam ppf = function
| Lev_module_definition ident ->
Format.asprintf "module-defn(%a)" Ident.print ident
in
fprintf ppf "@[<2>(%s %s(%i)%s:%i-%i@ %a)@]" kind
(* -dno-locations also hides the placement of debug events;
this is good for the readability of the resulting output (usually
the end-user goal when using -dno-locations), as it strongly
reduces the nesting level of subterms. *)
if not !Clflags.locations then lam ppf expr
else begin
fprintf ppf "@[<2>(%s %s(%i)%s:%i-%i@ %a)@]" kind
ev.lev_loc.Location.loc_start.Lexing.pos_fname
ev.lev_loc.Location.loc_start.Lexing.pos_lnum
(if ev.lev_loc.Location.loc_ghost then "<ghost>" else "")
ev.lev_loc.Location.loc_start.Lexing.pos_cnum
ev.lev_loc.Location.loc_end.Lexing.pos_cnum
lam expr
end
| Lifused(id, expr) ->
fprintf ppf "@[<2>(ifused@ %a@ %a)@]" Ident.print id lam expr

View File

@ -26,14 +26,16 @@ module Provenance = struct
}
let print ppf { module_path; location; original_ident; } =
Format.fprintf ppf "@[<hov 1>(\
@[<hov 1>(module_path@ %a)@]@ \
@[<hov 1>(location@ %a)@]@ \
@[<hov 1>(original_ident@ %a)@]\
)@]"
Path.print module_path
Debuginfo.print_compact location
Ident.print original_ident
let printf fmt = Format.fprintf ppf fmt in
printf "@[<hov 1>(";
printf "@[<hov 1>(module_path@ %a)@]@ "
Path.print module_path;
if !Clflags.locations then
printf "@[<hov 1>(location@ %a)@]@ "
Debuginfo.print_compact location;
printf "@[<hov 1>(original_ident@ %a)@]"
Ident.print original_ident;
printf ")@]"
let create ~module_path ~location ~original_ident =
{ module_path;

View File

@ -28,10 +28,13 @@ let fmt_position with_name f l =
;;
let fmt_location f loc =
let p_2nd_name = loc.loc_start.pos_fname <> loc.loc_end.pos_fname in
fprintf f "(%a..%a)" (fmt_position true) loc.loc_start
(fmt_position p_2nd_name) loc.loc_end;
if loc.loc_ghost then fprintf f " ghost";
if not !Clflags.locations then ()
else begin
let p_2nd_name = loc.loc_start.pos_fname <> loc.loc_end.pos_fname in
fprintf f "(%a..%a)" (fmt_position true) loc.loc_start
(fmt_position p_2nd_name) loc.loc_end;
if loc.loc_ghost then fprintf f " ghost";
end
;;
let rec fmt_longident_aux f x =

View File

@ -0,0 +1,176 @@
[
structure_item (test_locations.ml[42,1260+0]..[44,1298+34])
Pstr_value Rec
[
<def>
pattern (test_locations.ml[42,1260+8]..[42,1260+11])
Ppat_var "fib" (test_locations.ml[42,1260+8]..[42,1260+11])
expression (test_locations.ml[42,1260+14]..[44,1298+34])
Pexp_function
[
<case>
pattern (test_locations.ml[43,1283+4]..[43,1283+9])
Ppat_or
pattern (test_locations.ml[43,1283+4]..[43,1283+5])
Ppat_constant PConst_int (0,None)
pattern (test_locations.ml[43,1283+8]..[43,1283+9])
Ppat_constant PConst_int (1,None)
expression (test_locations.ml[43,1283+13]..[43,1283+14])
Pexp_constant PConst_int (1,None)
<case>
pattern (test_locations.ml[44,1298+4]..[44,1298+5])
Ppat_var "n" (test_locations.ml[44,1298+4]..[44,1298+5])
expression (test_locations.ml[44,1298+9]..[44,1298+34])
Pexp_apply
expression (test_locations.ml[44,1298+21]..[44,1298+22])
Pexp_ident "+" (test_locations.ml[44,1298+21]..[44,1298+22])
[
<arg>
Nolabel
expression (test_locations.ml[44,1298+9]..[44,1298+20])
Pexp_apply
expression (test_locations.ml[44,1298+9]..[44,1298+12])
Pexp_ident "fib" (test_locations.ml[44,1298+9]..[44,1298+12])
[
<arg>
Nolabel
expression (test_locations.ml[44,1298+13]..[44,1298+20])
Pexp_apply
expression (test_locations.ml[44,1298+16]..[44,1298+17])
Pexp_ident "-" (test_locations.ml[44,1298+16]..[44,1298+17])
[
<arg>
Nolabel
expression (test_locations.ml[44,1298+14]..[44,1298+15])
Pexp_ident "n" (test_locations.ml[44,1298+14]..[44,1298+15])
<arg>
Nolabel
expression (test_locations.ml[44,1298+18]..[44,1298+19])
Pexp_constant PConst_int (1,None)
]
]
<arg>
Nolabel
expression (test_locations.ml[44,1298+23]..[44,1298+34])
Pexp_apply
expression (test_locations.ml[44,1298+23]..[44,1298+26])
Pexp_ident "fib" (test_locations.ml[44,1298+23]..[44,1298+26])
[
<arg>
Nolabel
expression (test_locations.ml[44,1298+27]..[44,1298+34])
Pexp_apply
expression (test_locations.ml[44,1298+30]..[44,1298+31])
Pexp_ident "-" (test_locations.ml[44,1298+30]..[44,1298+31])
[
<arg>
Nolabel
expression (test_locations.ml[44,1298+28]..[44,1298+29])
Pexp_ident "n" (test_locations.ml[44,1298+28]..[44,1298+29])
<arg>
Nolabel
expression (test_locations.ml[44,1298+32]..[44,1298+33])
Pexp_constant PConst_int (2,None)
]
]
]
]
]
]
let rec fib = function | 0|1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
[
structure_item (test_locations.ml[42,1260+0]..test_locations.ml[44,1298+34])
Tstr_value Rec
[
<def>
pattern (test_locations.ml[42,1260+8]..test_locations.ml[42,1260+11])
Tpat_var "fib/80"
expression (test_locations.ml[42,1260+14]..test_locations.ml[44,1298+34])
Texp_function
Nolabel
[
<case>
pattern (test_locations.ml[43,1283+4]..test_locations.ml[43,1283+9])
Tpat_or
pattern (test_locations.ml[43,1283+4]..test_locations.ml[43,1283+5])
Tpat_constant Const_int 0
pattern (test_locations.ml[43,1283+8]..test_locations.ml[43,1283+9])
Tpat_constant Const_int 1
expression (test_locations.ml[43,1283+13]..test_locations.ml[43,1283+14])
Texp_constant Const_int 1
<case>
pattern (test_locations.ml[44,1298+4]..test_locations.ml[44,1298+5])
Tpat_var "n/81"
expression (test_locations.ml[44,1298+9]..test_locations.ml[44,1298+34])
Texp_apply
expression (test_locations.ml[44,1298+21]..test_locations.ml[44,1298+22])
Texp_ident "Stdlib!.+"
[
<arg>
Nolabel
expression (test_locations.ml[44,1298+9]..test_locations.ml[44,1298+20])
Texp_apply
expression (test_locations.ml[44,1298+9]..test_locations.ml[44,1298+12])
Texp_ident "fib/80"
[
<arg>
Nolabel
expression (test_locations.ml[44,1298+13]..test_locations.ml[44,1298+20])
Texp_apply
expression (test_locations.ml[44,1298+16]..test_locations.ml[44,1298+17])
Texp_ident "Stdlib!.-"
[
<arg>
Nolabel
expression (test_locations.ml[44,1298+14]..test_locations.ml[44,1298+15])
Texp_ident "n/81"
<arg>
Nolabel
expression (test_locations.ml[44,1298+18]..test_locations.ml[44,1298+19])
Texp_constant Const_int 1
]
]
<arg>
Nolabel
expression (test_locations.ml[44,1298+23]..test_locations.ml[44,1298+34])
Texp_apply
expression (test_locations.ml[44,1298+23]..test_locations.ml[44,1298+26])
Texp_ident "fib/80"
[
<arg>
Nolabel
expression (test_locations.ml[44,1298+27]..test_locations.ml[44,1298+34])
Texp_apply
expression (test_locations.ml[44,1298+30]..test_locations.ml[44,1298+31])
Texp_ident "Stdlib!.-"
[
<arg>
Nolabel
expression (test_locations.ml[44,1298+28]..test_locations.ml[44,1298+29])
Texp_ident "n/81"
<arg>
Nolabel
expression (test_locations.ml[44,1298+32]..test_locations.ml[44,1298+33])
Texp_constant Const_int 2
]
]
]
]
]
]
(setglobal Test_locations!
(letrec
(fib/80
(function n/81[int] : int
(funct-body test_locations.ml(42):1274-1332
(if (isout 1 n/81)
(before test_locations.ml(44):1307-1332
(+
(after test_locations.ml(44):1307-1318
(apply fib/80 (- n/81 1)))
(after test_locations.ml(44):1321-1332
(apply fib/80 (- n/81 2)))))
(before test_locations.ml(43):1296-1297 1)))))
(pseudo _none_(0)<ghost>:-1--1 (makeblock 0 fib/80))))

View File

@ -0,0 +1,31 @@
cmm:
(data)
(data
int 3063
"camlTest_locations__1":
addr "camlTest_locations__fib_80"
int 3)
(data int 1792 global "camlTest_locations" "camlTest_locations": int 1)
(data
global "camlTest_locations__gc_roots"
"camlTest_locations__gc_roots":
addr "camlTest_locations"
int 0)
(function{test_locations.ml:42,14-72} camlTest_locations__fib_80 (n/81: val)
(if (<a 3 n/81)
(+
(+
(app{test_locations.ml:44,9-20} "camlTest_locations__fib_80"
(+ n/81 -2) val)
(app{test_locations.ml:44,23-34} "camlTest_locations__fib_80"
(+ n/81 -4) val))
-1)
3))
(function camlTest_locations__entry ()
(let clos/84 "camlTest_locations__1"
(store val(root-init) "camlTest_locations" clos/84))
1a)
(data)

View File

@ -0,0 +1,38 @@
cmm:
(data)
(data
int 3063
global "camlTest_locations__set_of_closures_29"
"camlTest_locations__set_of_closures_29":
global "camlTest_locations__fib_5_closure"
"camlTest_locations__fib_5_closure":
addr "camlTest_locations__fib_5"
int 3)
(data
global "camlTest_locations__gc_roots"
"camlTest_locations__gc_roots":
int 0)
(function{test_locations.ml:42,14-72} camlTest_locations__fib_5 (n/84: val)
(if (<a 3 n/84)
(let
Paddint_arg/91
(app{test_locations.ml:44,23-34} "camlTest_locations__fib_5"
(+ n/84 -4) val)
(+
(+
(app{test_locations.ml:44,9-20} "camlTest_locations__fib_5"
(+ n/84 -2) val)
Paddint_arg/91)
-1))
3))
(data
int 1792
global "camlTest_locations"
"camlTest_locations":
addr "camlTest_locations__fib_5_closure")
(data)
(function camlTest_locations__entry () 1a)
(data)

View File

@ -0,0 +1,169 @@
[
structure_item
Pstr_value Rec
[
<def>
pattern
Ppat_var "fib"
expression
Pexp_function
[
<case>
pattern
Ppat_or
pattern
Ppat_constant PConst_int (0,None)
pattern
Ppat_constant PConst_int (1,None)
expression
Pexp_constant PConst_int (1,None)
<case>
pattern
Ppat_var "n"
expression
Pexp_apply
expression
Pexp_ident "+"
[
<arg>
Nolabel
expression
Pexp_apply
expression
Pexp_ident "fib"
[
<arg>
Nolabel
expression
Pexp_apply
expression
Pexp_ident "-"
[
<arg>
Nolabel
expression
Pexp_ident "n"
<arg>
Nolabel
expression
Pexp_constant PConst_int (1,None)
]
]
<arg>
Nolabel
expression
Pexp_apply
expression
Pexp_ident "fib"
[
<arg>
Nolabel
expression
Pexp_apply
expression
Pexp_ident "-"
[
<arg>
Nolabel
expression
Pexp_ident "n"
<arg>
Nolabel
expression
Pexp_constant PConst_int (2,None)
]
]
]
]
]
]
let rec fib = function | 0|1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
[
structure_item
Tstr_value Rec
[
<def>
pattern
Tpat_var "fib/80"
expression
Texp_function
Nolabel
[
<case>
pattern
Tpat_or
pattern
Tpat_constant Const_int 0
pattern
Tpat_constant Const_int 1
expression
Texp_constant Const_int 1
<case>
pattern
Tpat_var "n/81"
expression
Texp_apply
expression
Texp_ident "Stdlib!.+"
[
<arg>
Nolabel
expression
Texp_apply
expression
Texp_ident "fib/80"
[
<arg>
Nolabel
expression
Texp_apply
expression
Texp_ident "Stdlib!.-"
[
<arg>
Nolabel
expression
Texp_ident "n/81"
<arg>
Nolabel
expression
Texp_constant Const_int 1
]
]
<arg>
Nolabel
expression
Texp_apply
expression
Texp_ident "fib/80"
[
<arg>
Nolabel
expression
Texp_apply
expression
Texp_ident "Stdlib!.-"
[
<arg>
Nolabel
expression
Texp_ident "n/81"
<arg>
Nolabel
expression
Texp_constant Const_int 2
]
]
]
]
]
]
(setglobal Test_locations!
(letrec
(fib/80
(function n/81[int] : int
(if (isout 1 n/81)
(+ (apply fib/80 (- n/81 1)) (apply fib/80 (- n/81 2))) 1)))
(makeblock 0 fib/80)))

View File

@ -0,0 +1,28 @@
cmm:
(data)
(data
int 3063
"camlTest_locations__1":
addr "camlTest_locations__fib_80"
int 3)
(data int 1792 global "camlTest_locations" "camlTest_locations": int 1)
(data
global "camlTest_locations__gc_roots"
"camlTest_locations__gc_roots":
addr "camlTest_locations"
int 0)
(function camlTest_locations__fib_80 (n/81: val)
(if (<a 3 n/81)
(+
(+ (app "camlTest_locations__fib_80" (+ n/81 -2) val)
(app "camlTest_locations__fib_80" (+ n/81 -4) val))
-1)
3))
(function camlTest_locations__entry ()
(let clos/84 "camlTest_locations__1"
(store val(root-init) "camlTest_locations" clos/84))
1a)
(data)

View File

@ -0,0 +1,31 @@
cmm:
(data)
(data
int 3063
global "camlTest_locations__set_of_closures_29"
"camlTest_locations__set_of_closures_29":
global "camlTest_locations__fib_5_closure"
"camlTest_locations__fib_5_closure":
addr "camlTest_locations__fib_5"
int 3)
(data
global "camlTest_locations__gc_roots"
"camlTest_locations__gc_roots":
int 0)
(function camlTest_locations__fib_5 (n/84: val)
(if (<a 3 n/84)
(let Paddint_arg/91 (app "camlTest_locations__fib_5" (+ n/84 -4) val)
(+ (+ (app "camlTest_locations__fib_5" (+ n/84 -2) val) Paddint_arg/91)
-1))
3))
(data
int 1792
global "camlTest_locations"
"camlTest_locations":
addr "camlTest_locations__fib_5_closure")
(data)
(function camlTest_locations__entry () 1a)
(data)

View File

@ -0,0 +1,45 @@
(* TEST
compile_only="true"
* setup-ocamlc.byte-build-env
** ocamlc.byte
flags="-g -dno-locations -dsource -dparsetree -dtypedtree -dlambda"
*** check-ocamlc.byte-output
compiler_reference =
"${test_source_directory}/test_locations.dno-locations.ocamlc.reference"
* setup-ocamlopt.byte-build-env
** ocamlopt.byte
flags="-g -dno-locations -dcmm"
*** no-flambda
**** check-ocamlopt.byte-output
compiler_reference =
"${test_source_directory}/test_locations.dno-locations.ocamlopt.clambda.reference"
*** flambda
**** check-ocamlc.byte-output
compiler_reference =
"${test_source_directory}/test_locations.dno-locations.ocamlopt.flambda.reference"
* setup-ocamlc.byte-build-env
** ocamlc.byte
flags="-g -dlocations -dsource -dparsetree -dtypedtree -dlambda"
*** check-ocamlc.byte-output
compiler_reference =
"${test_source_directory}/test_locations.dlocations.ocamlc.reference"
* setup-ocamlopt.byte-build-env
** ocamlopt.byte
flags="-g -dlocations -dcmm"
*** no-flambda
**** check-ocamlopt.byte-output
compiler_reference =
"${test_source_directory}/test_locations.dlocations.ocamlopt.clambda.reference"
*** flambda
**** check-ocamlc.byte-output
compiler_reference =
"${test_source_directory}/test_locations.dlocations.ocamlopt.flambda.reference"
*)
let rec fib = function
| 0 | 1 -> 1
| n -> fib (n - 1) + fib (n - 2)
;;

View File

@ -27,8 +27,11 @@ let fmt_position f l =
;;
let fmt_location f loc =
fprintf f "(%a..%a)" fmt_position loc.loc_start fmt_position loc.loc_end;
if loc.loc_ghost then fprintf f " ghost";
if not !Clflags.locations then ()
else begin
fprintf f "(%a..%a)" fmt_position loc.loc_start fmt_position loc.loc_end;
if loc.loc_ghost then fprintf f " ghost";
end
;;
let rec fmt_longident_aux f x =

View File

@ -95,7 +95,8 @@ and for_package = ref (None: string option) (* -for-pack *)
and error_size = ref 500 (* -error-size *)
and float_const_prop = ref true (* -no-float-const-prop *)
and transparent_modules = ref false (* -trans-mod *)
let unique_ids = ref true
let unique_ids = ref true (* -d(no-)unique-ds *)
let locations = ref true (* -d(no-)locations *)
let dump_source = ref false (* -dsource *)
let dump_parsetree = ref false (* -dparsetree *)
and dump_typedtree = ref false (* -dtypedtree *)

View File

@ -123,6 +123,7 @@ val error_size : int ref
val float_const_prop : bool ref
val transparent_modules : bool ref
val unique_ids : bool ref
val locations : bool ref
val dump_source : bool ref
val dump_parsetree : bool ref
val dump_typedtree : bool ref