Source file cmi.ml

#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, _extra) -> 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 _ (*val … *)
  | Sig_type _ (* type … *)
  | Sig_typext _ (* type 字 += … *)
  | Sig_class _ (* class … *)
  | Sig_class_type _ (* class …*) -> []
#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