Source file cmi.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
#0 "cmi.mlp"
(** Extract module level definitions from cmi files *)
let cmi_infos path =
Cmi_format.read_cmi path
let rec mmap f l = match l with
| [] -> []
| a :: q -> f a @ mmap f q
open Types
module Ident = struct
#14 "cmi.mlp"
let name x = Ident.name x
#16 "cmi.mlp"
#19 "cmi.mlp"
let make x = x
#22 "cmi.mlp"
let pure x = Some x
end
#25 "cmi.mlp"
let bind id mt = let open M2l in
Bind {name= Ident.make id; expr = Constraint(Abstract,mt)}
let bind_sig id mt = let open M2l in
Bind_sig { name = Ident.make id; expr = Option.( mt >< Abstract)}
let module_declaration module_type id md = bind id @@ module_type md.md_type
let module_type_declaration module_type id mtd =
bind_sig id Option.( mtd.mtd_type >>| module_type)
module P = Path
module L = Longident
let rec path_to_lid = function
| P.Pident s -> L.Lident (Ident.name s)
#42 "cmi.mlp"
| P.Pdot (p,s) -> L.Ldot(path_to_lid p,s)
#44 "cmi.mlp"
| P.Papply (f,x) -> L.Lapply (path_to_lid f, path_to_lid x)
#46 "cmi.mlp"
| P.Pextra_ty (ty, ) -> path_to_lid ty
#48 "cmi.mlp"
#50 "cmi.mlp"
let from_path x = Longident_converter.from_lid (path_to_lid x)
module Arg = Module.Arg
let rec signitem =
function
| Sig_value _
| Sig_type _
| Sig_typext _
| Sig_class _
| Sig_class_type _ -> []
#64 "cmi.mlp"
| Sig_module (id, _, md, _, _) ->
#66 "cmi.mlp"
[module_declaration module_type Ident.(pure (name id)) md]
#68 "cmi.mlp"
#70 "cmi.mlp"
| Sig_modtype (id, mtd, _ ) ->
#72 "cmi.mlp"
[module_type_declaration module_type Ident.(pure (name id)) mtd]
#74 "cmi.mlp"
and signature x = mmap signitem x
and module_type = function
| Mty_ident p -> M2l.Ident (from_path p)
| Mty_signature s -> M2l.Sig (List.map Loc.nowhere @@ signature s)
#80 "cmi.mlp"
| Mty_functor (arg, mt) ->
#87 "cmi.mlp"
let open M2l in
let arg = match arg with
| Named(name,mt) ->
Some {Arg.name = Option.fmap Ident.name name ; signature = module_type mt }
| Unit -> None
in
Fun { arg; body = module_type mt }
#97 "cmi.mlp"
#99 "cmi.mlp"
| Mty_alias p ->
#101 "cmi.mlp"
M2l.Alias (Paths.Expr.concrete @@ from_path p)
#103 "cmi.mlp"
let m2l path =
let cm2i = cmi_infos path in
List.map Loc.nowhere @@ signature @@ cm2i.cmi_sign