File: odoc_name.ml

package info (click to toggle)
ocaml 4.05.0-11
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 27,060 kB
  • sloc: ml: 199,255; ansic: 44,187; sh: 5,611; makefile: 4,958; lisp: 4,223; asm: 4,220; awk: 306; perl: 87; fortran: 21; cs: 9; sed: 9
file content (226 lines) | stat: -rw-r--r-- 5,883 bytes parent folder | download | duplicates (2)
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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
(**************************************************************************)
(*                                                                        *)
(*                                 OCaml                                  *)
(*                                                                        *)
(*             Maxence Guesdon, projet Cristal, INRIA Rocquencourt        *)
(*                                                                        *)
(*   Copyright 2001 Institut National de Recherche en Informatique et     *)
(*     en Automatique.                                                    *)
(*                                                                        *)
(*   All rights reserved.  This file is distributed under the terms of    *)
(*   the GNU Lesser General Public License version 2.1, with the          *)
(*   special exception on linking described in the file LICENSE.          *)
(*                                                                        *)
(**************************************************************************)

(** Representation of element names. *)

let infix_chars = [ '|' ;
                    '<' ;
                    '>' ;
                    '@' ;
                    '^' ;
                    '&' ;
                    '+' ;
                    '-' ;
                    '*' ;
                    '/' ;
                    '$' ;
                    '%' ;
                    '=' ;
                    ':' ;
                    '~' ;
                    '!' ;
                    '.' ;
                    '#' ;
                  ]

type t = string

let strip_string s =
  let len = String.length s in
  let rec iter_first n =
    if n >= len then
      None
    else
      match s.[n] with
        ' ' | '\t' | '\n' | '\r' -> iter_first (n+1)
      | _ -> Some n
  in
  match iter_first 0 with
    None -> ""
  | Some first ->
      let rec iter_last n =
        if n <= first then
          None
        else
          match s.[n] with
            ' ' | '\t' | '\n' | '\r' -> iter_last (n-1)
          | _ -> Some n
      in
      match iter_last (len-1) with
        None -> String.sub s first 1
      | Some last -> String.sub s first ((last-first)+1)

let parens_if_infix name =
  match strip_string name with
  | "" -> ""
  | s when s.[0] = '*' || s.[String.length s - 1] = '*' -> "( " ^ s ^ " )"
  | s when List.mem s.[0] infix_chars -> "(" ^ s ^ ")"
  | "or" | "mod" | "land" | "lor" | "lxor" | "lsl" | "lsr" | "asr" ->
     "(" ^ name ^ ")"
  | name -> name
;;

let cut name =
  match name with
    "" -> ("", "")
  | s ->
      let len = String.length s in
      match s.[len-1] with
        ')' ->
          (
           let j = ref 0 in
           let buf = [|Buffer.create len ; Buffer.create len |] in
           for i = 0 to len - 1 do
             match s.[i] with
               '.' when !j = 0 ->
                 if i < len - 1 then
                   match s.[i+1] with
                     '(' ->
                       j := 1
                   | _ ->
                       Buffer.add_char buf.(!j) '.'
                 else
                   Buffer.add_char buf.(!j) s.[i]
             | c ->
                 Buffer.add_char buf.(!j) c
           done;
           (Buffer.contents buf.(0), Buffer.contents buf.(1))
          )
      | _ ->
          match List.rev (Str.split (Str.regexp_string ".") s) with
            [] -> ("", "")
          | h :: q ->
              (String.concat "." (List.rev q), h)

let simple name = snd (cut name)
let father name = fst (cut name)

let concat n1 n2 = n1^"."^n2

let normalize_name name =
  let (p,s) = cut name in
  let len = String.length s in
  let s =
    if len >= 2 &&
      s.[0] = '(' && s.[len - 1] = ')'
    then
      parens_if_infix (strip_string (String.sub s 1 (len - 2)))
    else
      s
  in
  match p with
    "" -> s
  | p -> concat p s
  ;;

let head_and_tail n =
  try
    let pos = String.index n '.' in
    if pos > 0 then
      let h = String.sub n 0 pos in
      try
        ignore (String.index h '(');
        (n, "")
      with
        Not_found ->
          let len = String.length n in
          if pos >= (len - 1) then
            (h, "")
          else
            (h, String.sub n (pos + 1) (len - pos - 1))
    else
      (n, "")
  with
    Not_found -> (n, "")

let head n = fst (head_and_tail n)

let depth name =
  try
    List.length (Str.split (Str.regexp "\\.") name)
  with
    _ -> 1

let prefix n1 n2 =
  (n1 <> n2) &&
  (try
    let len1 = String.length n1 in
    ((String.sub n2 0 len1) = n1) &&
    (n2.[len1] = '.')
  with _ -> false)

let rec get_relative_raw n1 n2 =
  let (f1,s1) = head_and_tail n1 in
  let (f2,s2) = head_and_tail n2 in
  if f1 = f2 then
    if f2 = s2 || s2 = "" then
      s2
    else
      if f1 = s1 || s1 = "" then
        s2
      else
        get_relative_raw s1 s2
  else
    n2

let get_relative n1 n2 =
  if prefix n1 n2 then
    let len1 = String.length n1 in
    try
      String.sub n2 (len1+1) ((String.length n2) - len1 - 1)
    with
      _ -> n2
  else
    n2

let hide_given_modules l s =
  let rec iter = function
      [] -> s
    | h :: q ->
        let s2 = get_relative h s in
        if s = s2 then
          iter q
        else
          s2
  in
  iter l

let qualified name = String.contains name '.'

let from_ident ident = Ident.name ident


let from_path path = Path.name path

let to_path n =
  match
    List.fold_left
      (fun acc_opt -> fun s ->
        match acc_opt with
          None -> Some (Path.Pident (Ident.create s))
        | Some acc -> Some (Path.Pdot (acc, s, 0)))
      None
      (Str.split (Str.regexp "\\.") n)
  with
    None -> raise (Failure "to_path")
  | Some p -> p

let from_longident = Odoc_misc.string_of_longident

module Set = Set.Make (struct
  type z = t
  type t = z
  let compare = String.compare
end)