package odoc

  1. Overview
  2. Docs
package odoc
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file typedtree_traverse.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
#if OCAML_VERSION >= (4, 14, 0)

module Analysis = struct
  type annotation =
    | LocalDefinition of Ident.t
    | Value of Path.t
    | Module of Path.t
    | ModuleType of Path.t
    | Type of Path.t

  let expr poses expr =
    let exp_loc = expr.Typedtree.exp_loc in
    if exp_loc.loc_ghost then ()
    else
      match expr.exp_desc with
#if defined OXCAML
      | Texp_ident (p, _, _, _, _, _) ->
#else
      | Texp_ident (p, _, _) ->
#endif
          poses := (Value p, exp_loc) :: !poses
      | _ -> ()

  let pat env (type a) poses : a Typedtree.general_pattern -> unit = function
    | { Typedtree.pat_desc; pat_loc; _ } when not pat_loc.loc_ghost ->
        let maybe_localvalue id loc =
          match Ident_env.identifier_of_loc env loc with
          | None -> Some (LocalDefinition id, loc)
          | Some _ -> None
        in
        let () =
          match pat_desc with
#if defined OXCAML
          | Tpat_var (id, loc, _uid, _, _) -> (
#elif OCAML_VERSION >= (5, 2, 0)
          | Tpat_var (id, loc, _uid) -> (
#else
          | Tpat_var (id, loc) -> (
#endif
              match maybe_localvalue id loc.loc with
              | Some x -> poses := x :: !poses
              | None -> ())
#if defined OXCAML
          | Tpat_alias (_, id, loc, _uid, _, _, _) -> (
#elif OCAML_VERSION >= (5, 4, 0)
          | Tpat_alias (_, id, loc, _uid, _ty) -> (
#elif OCAML_VERSION >= (5, 2, 0)
          | Tpat_alias (_, id, loc, _uid) -> (
#else
          | Tpat_alias (_, id, loc) -> (
#endif
              match maybe_localvalue id loc.loc with
              | Some x -> poses := x :: !poses
              | None -> ())
          | _ -> ()
        in
        ()
    | _ -> ()

  let module_binding env poses = function
    | { Typedtree.mb_id = Some id; mb_loc; _ } when not mb_loc.loc_ghost -> (
        match Ident_env.identifier_of_loc env mb_loc with
        | None -> poses := (LocalDefinition id, mb_loc) :: !poses
        | Some _ -> ())
    | _ -> ()

  let module_expr poses mod_expr =
    match mod_expr with
    | { Typedtree.mod_desc = Tmod_ident (p, _); mod_loc; _ }
      when not mod_loc.loc_ghost ->
        poses := (Module p, mod_loc) :: !poses
    | _ -> ()

  let module_type poses mty_expr =
    match mty_expr with
    | { Typedtree.mty_desc = Tmty_ident (p, _); mty_loc; _ }
      when not mty_loc.loc_ghost ->
        poses := (ModuleType p, mty_loc) :: !poses
    | _ -> ()

  let core_type poses ctyp_expr =
    match ctyp_expr with
    | { Typedtree.ctyp_desc = Ttyp_constr (p, _, _); ctyp_loc; _ }
      when not ctyp_loc.loc_ghost ->
        poses := (Type p, ctyp_loc) :: !poses
    | _ -> ()
end

let of_cmt env structure =
  let poses = ref [] in
  let iter = Tast_iterator.default_iterator in
  let module_expr iterator mod_expr =
    Analysis.module_expr poses mod_expr;
    iter.module_expr iterator mod_expr
  in
  let expr iterator e =
    Analysis.expr poses e;
    iter.expr iterator e
  in
  let pat iterator e =
    Analysis.pat env poses e;
    iter.pat iterator e
  in
  let typ iterator ctyp_expr =
    Analysis.core_type poses ctyp_expr;
    iter.typ iterator ctyp_expr
  in
  let module_type iterator mty =
    Analysis.module_type poses mty;
    iter.module_type iterator mty
  in
  let module_binding iterator mb =
    Analysis.module_binding env poses mb;
    iter.module_binding iterator mb
  in
  let iterator =
    {
      iter with
      expr;
      pat;
      module_expr;
      typ;
      module_type;
      module_binding;
    }
  in
  iterator.structure iterator structure;
  !poses

#else

#endif