The unpac monorepo manager self-hosting as a monorepo using unpac
Remove the dump_ast tool. A better replacement is part of the standalone ppx_tools package.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14087 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
-137
-127
tools/dump_ast.ml
-127
tools/dump_ast.ml
···
1
-
(***********************************************************************)
2
-
(* *)
3
-
(* OCaml *)
4
-
(* *)
5
-
(* Alain Frisch, LexiFi *)
6
-
(* *)
7
-
(* Copyright 2012 Institut National de Recherche en Informatique et *)
8
-
(* en Automatique. All rights reserved. This file is distributed *)
9
-
(* under the terms of the Q Public License version 1.0. *)
10
-
(* *)
11
-
(***********************************************************************)
12
-
13
-
let autoopen_modules = ["Parsetree"; "Asttypes"; "Longident"; "Location"; "Lexing"]
14
-
let autoopen = ref true
15
-
16
-
let typ ty =
17
-
let ty = Parse.core_type (Lexing.from_string ty) in
18
-
let ty = Typetexp.transl_simple_type Env.initial false ty in
19
-
ty.Typedtree.ctyp_type
20
-
21
-
let show_value ty v =
22
-
let env = Env.initial in
23
-
let env = if !autoopen then List.fold_right Env.open_pers_signature autoopen_modules env else env in
24
-
Format.printf "%a@." (Toploop.print_value env (Obj.repr v)) (typ ty)
25
-
26
-
let dump_file fn =
27
-
let ic = open_in fn in
28
-
let buf = Lexing.from_channel ic in
29
-
if Filename.check_suffix fn ".mli"
30
-
then show_value "Parsetree.signature" (Parse.interface buf)
31
-
else show_value "Parsetree.structure" (Parse.implementation buf);
32
-
close_in ic
33
-
34
-
let dump_expr s =
35
-
show_value "Parsetree.expression" (Parse.expression (Lexing.from_string s))
36
-
37
-
let dump_type s =
38
-
show_value "Parsetree.core_type" (Parse.core_type (Lexing.from_string s))
39
-
40
-
let dump_pattern s =
41
-
show_value "Parsetree.pattern" (Parse.pattern (Lexing.from_string s))
42
-
43
-
(* Filtering of output *)
44
-
45
-
module Filter = struct
46
-
open Outcometree
47
-
48
-
let hidelocs = ref true
49
-
let hideattrs = ref true
50
-
51
-
let map_oval f = function
52
-
| Oval_array l -> Oval_array (List.map f l)
53
-
| Oval_constr (i, l) -> Oval_constr (i, List.map f l)
54
-
| Oval_list l -> Oval_list (List.map f l)
55
-
| Oval_record l -> Oval_record (List.map (fun (s, x) -> (s, f x)) l)
56
-
| Oval_tuple l -> Oval_tuple (List.map f l)
57
-
| Oval_variant (s, Some x) -> Oval_variant (s, Some (f x))
58
-
| x -> x
59
-
60
-
let ends_with s l =
61
-
let ll = String.length l and ls = String.length s in
62
-
ll >= ls && String.sub l (ll - ls) ls = s
63
-
64
-
let filter_field = function
65
-
| (Oide_ident l, Oval_list [])
66
-
when !hideattrs && ends_with "_attributes" l -> false
67
-
| (Oide_ident l, _)
68
-
when !hidelocs && (ends_with "_loc" l || l = "loc") -> false
69
-
| _ -> true
70
-
71
-
let rec filter_val x =
72
-
match map_oval filter_val x with
73
-
| Oval_record l -> Oval_record (List.filter filter_field l)
74
-
| x -> x
75
-
76
-
let () =
77
-
let old = !Oprint.out_value in
78
-
Oprint.out_value := (fun ppf v -> old ppf (filter_val v))
79
-
end
80
-
81
-
(* Command-line parsing *)
82
-
83
-
let args =
84
-
let open Arg in
85
-
[
86
-
"-noopen", Clear autoopen,
87
-
" Don't assume that default modules are opened";
88
-
89
-
"-locs", Clear Filter.hidelocs,
90
-
" Keep locations";
91
-
92
-
"-emptyattrs", Clear Filter.hideattrs,
93
-
" Keep empty attributes";
94
-
95
-
"-e", String dump_expr,
96
-
"<expr> Dump the AST for <expr>";
97
-
98
-
"-t", String dump_type,
99
-
"<type> Dump the AST for <type>";
100
-
101
-
"-p", String dump_pattern,
102
-
"<pattern> Dump the AST for <pattern>";
103
-
104
-
"-w", Int Format.set_margin,
105
-
"<width> Define the width (in characters) of the output"
106
-
]
107
-
108
-
let usage = "dump_ast [options] <.ml/.mli source files>\n"
109
-
110
-
let () =
111
-
let dir = Filename.dirname Sys.argv.(0) in
112
-
let c0 = Filename.concat dir in
113
-
let c1 = Filename.concat Config.standard_library in
114
-
115
-
if Sys.file_exists (c1 "compiler-libs/parsetree.cmi")
116
-
then Config.load_path := [c1 "compiler-libs"; Config.standard_library]
117
-
else if Sys.file_exists (c0 "../parsing/parsetree.cmi")
118
-
(* Running from a source tree. *)
119
-
then Config.load_path := [c0 "../parsing"; c0 "../stdlib"]
120
-
else (prerr_endline "Cannot locate parsetree.cmi"; exit 2);
121
-
122
-
Toploop.initialize_toplevel_env ();
123
-
Toploop.max_printer_depth := max_int;
124
-
Toploop.max_printer_steps := max_int;
125
-
126
-
try Arg.parse (Arg.align args) dump_file usage
127
-
with exn -> Errors.report_error Format.err_formatter exn