Source file `DerivUnit.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
type 'a pair = 'a Unit.pair = { ml : 'a; mli : 'a }

let pp_pair pp_v ppf { ml; mli } =
  let display what =
    Fmt.parens (fun ppf v ->
        Fmt.string ppf what;
        Fmt.sp ppf ();
        pp_v ppf v)
  in
  Format.fprintf ppf "%a@ %a" (display "ml") ml (display "mli") mli

type precision = Unit.precision = Exact | Approx

let pp_precision ppf = function
  | Exact -> Format.pp_print_string ppf "exact"
  | Approx -> Format.pp_print_string ppf "approx"

type m2l_kind = M2l.kind = Structure | Signature

let pp_m2l_kind ppf = function
  | Structure -> Format.pp_print_string ppf "structure"
  | Signature -> Format.pp_print_string ppf "signature"

type 'ext t = 'ext Unit.t = {
  path : Namespaced.t;  (** module path of the compilation unit *)
  src : Pkg.t;  (** source file of the compilation unit *)
  kind : m2l_kind;
  precision : precision;
  code : M2l.t;
  more : 'ext;
}

let pp pp_v ppf { path; src; kind; precision; code; more } =
  Format.fprintf ppf
    "@[<hov 2>%a:=@ src:%a@ kind:%a@ precision:%a@ @[code:@;\
     %a@]@ @[more:@;\
     %a@]@]"
    Namespaced.pp path Pkg.pp src pp_m2l_kind kind pp_precision precision M2l.pp
    code pp_v more

type ext = Unit.ext = { signature : Module.signature; dependencies : Deps.t }

let pp_ext ppf { signature; dependencies } =
  Format.fprintf ppf "(signature=%a@ deps=%a)" Module.pp_signature signature
    Deps.pp dependencies

type u = ext t

let pp_u ppf u = (pp pp_ext) ppf u

module Extras = struct
  (* Unit.pp and Unit.pp_input reset the formatter with @.
     So redefine without it (or dump to Fmt.str first)

     Unit.pp and Unit.pp_input uses [Pkg.pp_simple] which hides important details
     and looks especially weird as it tries to make a module out of
     C:\x\y\z (==> `C:.x.y.z`) *)

  let unit_pp ppf unit =
    Pp.fp ppf
      "@[<2>[@ path=%a;@ source=%a;@ m2l = @[%a@];@ signature=[ @[%a@] ];@ \
       dependencies=@[%a@]@ ]@]"
      Namespaced.pp unit.path Pkg.pp unit.src M2l.pp unit.code
      Module.pp_signature (Unit.signature unit) Deps.pp (Unit.deps unit)

  let unit_pp_input ppf unit =
    Pp.fp ppf "@[<hov2>[ path=%a;@ source=%a;@ m2l = @[%a@];@ ] @]"
      Namespaced.pp unit.path Pkg.pp unit.src M2l.pp unit.code
end