diff options
Diffstat (limited to 'typing/ident.ml')
| -rw-r--r-- | typing/ident.ml | 172 |
1 files changed, 0 insertions, 172 deletions
diff --git a/typing/ident.ml b/typing/ident.ml deleted file mode 100644 index ccc132f094..0000000000 --- a/typing/ident.ml +++ /dev/null @@ -1,172 +0,0 @@ -(***********************************************************************) -(* *) -(* 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$ *) - -open Format - -type t = { stamp: int; name: string; mutable global: bool } - -(* A stamp of 0 denotes a persistent identifier *) - -let currentstamp = ref 0 - -let create s = - incr currentstamp; - { name = s; stamp = !currentstamp; global = false } - -let create_persistent s = - { name = s; stamp = 0; global = true } - -let rename i = - incr currentstamp; - { i with stamp = !currentstamp } - -let name i = i.name - -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.global <- true - -let global i = - i.global - -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 i.global 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 |