-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:
parent
96c3ed8859
commit
8938886721
4
Changes
4
Changes
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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))))
|
|
@ -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)
|
|
@ -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)
|
|
@ -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)))
|
|
@ -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)
|
|
@ -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)
|
|
@ -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)
|
||||
;;
|
|
@ -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 =
|
||||
|
|
|
@ -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 *)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue