Source file `strengthen.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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
(* Note for future improvement (suggested by @lpw25):

   You can actually do something even more interesting with that case for strengthening.

   If you have:
   [module type S = sig type t end]

   and you want to strengthen [S] with the module path [M] then you can produce:
   [S with type t = M.t]

   The compiler doesn't do this because it doesn't actually have a representation for `with` in its type algebra
   (`with` is always just expanded away right after parsing). But since we do have a representation for it,
   this is probably the best thing to produce in this case.
*)

open Component
open Delayed

let rec signature :
    Cpath.module_ ->
    ?canonical:Odoc_model.Paths.Path.Module.t ->
    Signature.t ->
    Signature.t =
 fun prefix ?canonical sg ->
  let sg', strengthened_modules, strengthened_module_types =
    sig_items prefix ?canonical sg
  in
  let substs =
    List.fold_left
      (fun s mid -> Subst.path_invalidate_module (mid :> Ident.module_) s)
      Subst.identity strengthened_modules
  in
  (* A strengthened module type, like a strengthened module, is replaced by a
     path back to the prefix and so no longer has an expansion of its own.
     Invalidate paths pointing at it too, so they are re-resolved through that
     path to the module type that does. *)
  let substs =
    List.fold_left
      (fun s mtid ->
        Subst.path_invalidate_module_type (mtid :> Ident.module_type) s)
      substs strengthened_module_types
  in
  Subst.signature substs sg'

and sig_items prefix ?canonical sg =
  let open Signature in
  let items, ids, mtids =
    List.fold_left
      (fun (items, s, mts) item ->
        match item with
        | Module (id, r, m) ->
            let name = Ident.Name.typed_module id in
            let canonical =
              match canonical with
              | Some p -> Some (`Dot (p, name))
              | None -> None
            in
            let m' () = module_ ?canonical (`Dot (prefix, name)) (get m) in
            (Module (id, r, put m') :: items, id :: s, mts)
        | ModuleType (id, mt) ->
            ( ModuleType
                ( id,
                  put (fun () ->
                      module_type
                        (`DotMT (prefix, Ident.Name.typed_module_type id))
                        (get mt)) )
              :: items,
              s,
              id :: mts )
        | Type (id, r, t) ->
            ( Type
                ( id,
                  r,
                  put (fun () ->
                      type_decl
                        (`DotT (prefix, Ident.Name.typed_type id))
                        (get t)) )
              :: items,
              s,
              mts )
        | Include i ->
            let i', strengthened, strengthened_mts = include_ prefix i in
            (Include i' :: items, strengthened @ s, strengthened_mts @ mts)
        | Exception _ | TypExt _ | Value _ | Class _ | ClassType _
        | ModuleSubstitution _ | TypeSubstitution _ | ModuleTypeSubstitution _
        | Comment _ | Open _ ->
            (item :: items, s, mts))
      ([], [], []) sg.items
  in
  ({ sg with items = List.rev items }, ids, mtids)

and module_ :
    ?canonical:Odoc_model.Paths.Path.Module.t ->
    Cpath.module_ ->
    Component.Module.t ->
    Component.Module.t =
 fun ?canonical prefix m -> { m with canonical; type_ = Alias (prefix, None) }

(* nuke the expansion as this could otherwise lead to inconsistencies - e.g. 'AlreadyASig' *)
and module_type :
    Cpath.module_type -> Component.ModuleType.t -> Component.ModuleType.t =
 fun prefix m ->
  let expr = Some (ModuleType.Path { p_path = prefix; p_expansion = None }) in
  { m with expr }

and type_decl : Cpath.type_ -> TypeDecl.t -> TypeDecl.t =
 fun path t ->
  let equation =
    let e = t.TypeDecl.equation in
    let open TypeDecl.Equation in
    let constr_params =
      List.map
        (fun { Odoc_model.Lang.TypeDecl.desc; _ } ->
          match desc with
          | Odoc_model.Lang.TypeDecl.Var x -> TypeExpr.Var x
          | Any -> Any)
        e.params
    in
    let manifest =
      match e.manifest with
      | None -> Some (TypeExpr.Constr (path, constr_params))
      | _ -> e.manifest
    in
    {
      params = e.params;
      private_ = e.private_;
      manifest;
      constraints = e.constraints;
      kind = e.kind;
    }
  in
  { t with equation }

and include_ :
    Cpath.module_ ->
    Include.t ->
    Include.t * Ident.module_ list * Ident.module_type list =
 fun path i ->
  let expansion_, strengthened, strengthened_mts =
    sig_items path i.expansion_
  in
  ( { i with expansion_; strengthened = Some path },
    strengthened,
    strengthened_mts )
Source file strengthen.ml

Source file `strengthen.ml`
