l4/pkg/ocaml/ocaml/contrib/ocamldoc/odoc_name.ml

   1 (***********************************************************************)
   2 (*                             OCamldoc                                *)
   3 (*                                                                     *)
   4 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
   5 (*                                                                     *)
   6 (*  Copyright 2001 Institut National de Recherche en Informatique et   *)
   7 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   8 (*  under the terms of the Q Public License version 1.0.               *)
   9 (*                                                                     *)
  10 (***********************************************************************)
  11
  12 (* $Id: odoc_name.ml 9185 2009-03-12 18:21:08Z doligez $ *)
  13
  14 (** Representation of element names. *)
  15
  16 let infix_chars = [ '|' ;
  17                     '<' ;
  18                     '>' ;
  19                     '@' ;
  20                     '^' ;
  21                     '&' ;
  22                     '+' ;
  23                     '-' ;
  24                     '*' ;
  25                     '/' ;
  26                     '$' ;
  27                     '%' ;
  28                     '=' ;
  29                     ':' ;
  30                     '~' ;
  31                     '!' ;
  32                   ]
  33
  34 type t = string
  35
  36 let parens_if_infix name =
  37   match name with
  38   | "" -> ""
  39   | s when s.[0] = '*' || s.[String.length s - 1] = '*' -> "( " ^ s ^ " )"
  40   | s when List.mem s.[0] infix_chars -> "(" ^ s ^ ")"
  41   | "or" | "mod" | "land" | "lor" | "lxor" | "lsl" | "lsr" | "asr" ->
  42      "(" ^ name ^ ")"
  43   | _ -> name
  44 ;;
  45
  46 let cut name =
  47   match name with
  48     "" -> ("", "")
  49   | s ->
  50       let len = String.length s in
  51       match s.[len-1] with
  52         ')' ->
  53           (
  54            let j = ref 0 in
  55            let buf = [|Buffer.create len ; Buffer.create len |] in
  56            for i = 0 to len - 1 do
  57              match s.[i] with
  58                '.' when !j = 0 ->
  59                  if i < len - 1 then
  60                    match s.[i+1] with
  61                      '(' ->
  62                        j := 1
  63                    | _ ->
  64                        Buffer.add_char buf.(!j) '.'
  65                  else
  66                    Buffer.add_char buf.(!j) s.[i]
  67              | c ->
  68                  Buffer.add_char buf.(!j) c
  69            done;
  70            (Buffer.contents buf.(0), Buffer.contents buf.(1))
  71           )
  72       | _ ->
  73           match List.rev (Str.split (Str.regexp_string ".") s) with
  74             [] -> ("", "")
  75           | h :: q ->
  76               (String.concat "." (List.rev q), h)
  77
  78 let simple name = snd (cut name)
  79 let father name = fst (cut name)
  80
  81 let concat n1 n2 = n1^"."^n2
  82
  83 let head_and_tail n =
  84   try
  85     let pos = String.index n '.' in
  86     if pos > 0 then
  87       let h = String.sub n 0 pos in
  88       try
  89         ignore (String.index h '(');
  90         (n, "")
  91       with
  92         Not_found ->
  93           let len = String.length n in
  94           if pos >= (len - 1) then
  95             (h, "")
  96           else
  97             (h, String.sub n (pos + 1) (len - pos - 1))
  98     else
  99       (n, "")
 100   with
 101     Not_found -> (n, "")
 102
 103 let head n = fst (head_and_tail n)
 104 let tail n = snd (head_and_tail n)
 105
 106 let depth name =
 107   try
 108     List.length (Str.split (Str.regexp "\\.") name)
 109   with
 110     _ -> 1
 111
 112 let prefix n1 n2 =
 113   (n1 <> n2) &
 114   (try
 115     let len1 = String.length n1 in
 116     ((String.sub n2 0 len1) = n1) &
 117     (n2.[len1] = '.')
 118   with _ -> false)
 119
 120 let rec get_relative_raw n1 n2 =
 121   let (f1,s1) = head_and_tail n1 in
 122   let (f2,s2) = head_and_tail n2 in
 123   if f1 = f2 then
 124     if f2 = s2 or s2 = "" then
 125       s2
 126     else
 127       if f1 = s1 or s1 = "" then
 128         s2
 129       else
 130         get_relative_raw s1 s2
 131   else
 132     n2
 133
 134 let get_relative n1 n2 =
 135   if prefix n1 n2 then
 136     let len1 = String.length n1 in
 137     try
 138       String.sub n2 (len1+1) ((String.length n2) - len1 - 1)
 139     with
 140       _ -> n2
 141   else
 142     n2
 143
 144 let hide_given_modules l s =
 145   let rec iter = function
 146       [] -> s
 147     | h :: q ->
 148         let s2 = get_relative h s in
 149         if s = s2 then
 150           iter q
 151         else
 152           s2
 153   in
 154   iter l
 155
 156 let qualified name = String.contains name '.'
 157
 158 let from_ident ident = Ident.name ident
 159
 160
 161 let from_path path = Path.name path
 162
 163 let to_path n =
 164   match
 165     List.fold_left
 166       (fun acc_opt -> fun s ->
 167         match acc_opt with
 168           None -> Some (Path.Pident (Ident.create s))
 169         | Some acc -> Some (Path.Pdot (acc, s, 0)))
 170       None
 171       (Str.split (Str.regexp "\\.") n)
 172   with
 173     None -> raise (Failure "to_path")
 174   | Some p -> p
 175
 176 let from_longident = Odoc_misc.string_of_longident
 177