/usr/lib/ocaml/compiler-libs/typing/ident.ml is in ocaml-compiler-libs 3.12.1-2ubuntu2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | (***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id: ident.ml 9547 2010-01-22 12:48:24Z doligez $ *)
open Format
type t = { stamp: int; name: string; mutable flags: int }
let global_flag = 1
let predef_exn_flag = 2
(* A stamp of 0 denotes a persistent identifier *)
let currentstamp = ref 0
let create s =
incr currentstamp;
{ name = s; stamp = !currentstamp; flags = 0 }
let create_predef_exn s =
incr currentstamp;
{ name = s; stamp = !currentstamp; flags = predef_exn_flag }
let create_persistent s =
{ name = s; stamp = 0; flags = global_flag }
let rename i =
incr currentstamp;
{ i with stamp = !currentstamp }
let name i = i.name
let stamp i = i.stamp
let unique_name i = i.name ^ "_" ^ string_of_int i.stamp
let unique_toplevel_name i = i.name ^ "/" ^ string_of_int i.stamp
let persistent i = (i.stamp = 0)
let equal i1 i2 = i1.name = i2.name
let same i1 i2 = i1 = i2
(* Possibly more efficient version (with a real compiler, at least):
if i1.stamp <> 0
then i1.stamp = i2.stamp
else i2.stamp = 0 && i1.name = i2.name *)
let binding_time i = i.stamp
let current_time() = !currentstamp
let set_current_time t = currentstamp := max !currentstamp t
let reinit_level = ref (-1)
let reinit () =
if !reinit_level < 0
then reinit_level := !currentstamp
else currentstamp := !reinit_level
let hide i =
{ i with stamp = -1 }
let make_global i =
i.flags <- i.flags lor global_flag
let global i =
(i.flags land global_flag) <> 0
let is_predef_exn i =
(i.flags land predef_exn_flag) <> 0
let print ppf i =
match i.stamp with
| 0 -> fprintf ppf "%s!" i.name
| -1 -> fprintf ppf "%s#" i.name
| n -> fprintf ppf "%s/%i%s" i.name n (if global i then "g" else "")
type 'a tbl =
Empty
| Node of 'a tbl * 'a data * 'a tbl * int
and 'a data =
{ ident: t;
data: 'a;
previous: 'a data option }
let empty = Empty
(* Inline expansion of height for better speed
* let height = function
* Empty -> 0
* | Node(_,_,_,h) -> h
*)
let mknode l d r =
let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h
and hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in
Node(l, d, r, (if hl >= hr then hl + 1 else hr + 1))
let balance l d r =
let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h
and hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in
if hl > hr + 1 then
match l with
| Node (ll, ld, lr, _)
when (match ll with Empty -> 0 | Node(_,_,_,h) -> h) >=
(match lr with Empty -> 0 | Node(_,_,_,h) -> h) ->
mknode ll ld (mknode lr d r)
| Node (ll, ld, Node(lrl, lrd, lrr, _), _) ->
mknode (mknode ll ld lrl) lrd (mknode lrr d r)
| _ -> assert false
else if hr > hl + 1 then
match r with
| Node (rl, rd, rr, _)
when (match rr with Empty -> 0 | Node(_,_,_,h) -> h) >=
(match rl with Empty -> 0 | Node(_,_,_,h) -> h) ->
mknode (mknode l d rl) rd rr
| Node (Node (rll, rld, rlr, _), rd, rr, _) ->
mknode (mknode l d rll) rld (mknode rlr rd rr)
| _ -> assert false
else
mknode l d r
let rec add id data = function
Empty ->
Node(Empty, {ident = id; data = data; previous = None}, Empty, 1)
| Node(l, k, r, h) ->
let c = compare id.name k.ident.name in
if c = 0 then
Node(l, {ident = id; data = data; previous = Some k}, r, h)
else if c < 0 then
balance (add id data l) k r
else
balance l k (add id data r)
let rec find_stamp s = function
None ->
raise Not_found
| Some k ->
if k.ident.stamp = s then k.data else find_stamp s k.previous
let rec find_same id = function
Empty ->
raise Not_found
| Node(l, k, r, _) ->
let c = compare id.name k.ident.name in
if c = 0 then
if id.stamp = k.ident.stamp
then k.data
else find_stamp id.stamp k.previous
else
find_same id (if c < 0 then l else r)
let rec find_name name = function
Empty ->
raise Not_found
| Node(l, k, r, _) ->
let c = compare name k.ident.name in
if c = 0 then
k.data
else
find_name name (if c < 0 then l else r)
let rec keys_aux stack accu = function
Empty ->
begin match stack with
[] -> accu
| a :: l -> keys_aux l accu a
end
| Node(l, k, r, _) ->
keys_aux (l :: stack) (k.ident :: accu) r
let keys tbl = keys_aux [] [] tbl
|