improved internal representation;
authorwenzelm
Sun, 28 Dec 1997 15:00:20 +0100
changeset 4490 14cd07c16e02
parent 4489 749600cb5573
child 4491 34a53d0c8e8d
improved internal representation;
src/Pure/name_space.ML
--- a/src/Pure/name_space.ML	Sun Dec 28 14:58:56 1997 +0100
+++ b/src/Pure/name_space.ML	Sun Dec 28 15:00:20 1997 +0100
@@ -11,7 +11,7 @@
 
 signature NAME_SPACE =
 sig
-  val separator: string         (*single char!*)
+  val separator: string                 (*single char*)
   val unpack: string -> string list
   val pack: string list -> string
   val base: string -> string
@@ -19,9 +19,9 @@
   type T
   val dest: T -> string list
   val empty: T
-  val extend: string list * T -> T
+  val declared: T -> string -> bool
+  val extend: T * string list -> T
   val merge: T * T -> T
-  val declared: T -> string -> bool
   val intern: T -> string -> string
   val extern: T -> string -> string
 end;
@@ -30,6 +30,15 @@
 struct
 
 
+(** utils **)
+
+fun prefixes1 [] = []
+  | prefixes1 (x :: xs) = map (cons x) ([] :: prefixes1 xs);
+
+fun suffixes1 xs = map rev (prefixes1 (rev xs));
+
+
+
 (** long identifiers **)
 
 val separator = ".";
@@ -40,64 +49,50 @@
 val base = last_elem o unpack;
 fun qualified name = length (unpack name) > 1;
 
+fun accesses name =
+  let
+    val uname = unpack name;
+    val (q, b) = split_last uname;
+    val sfxs = suffixes1 uname;
+    val pfxs = map (fn x => x @ [b]) (prefixes1 q);
+  in
+    map (rpair name o pack) (sfxs @ pfxs)
+  end;
+
 
 
 (** name spaces **)
 
-(* utils *)
-
-fun prefixes1 [] = []
-  | prefixes1 (x :: xs) = map (cons x) ([] :: prefixes1 xs);
-
-fun suffixes1 xs = map rev (prefixes1 (rev xs));
-
-
 (* datatype T *)
 
 datatype T =
-  NameSpace of string list list * string Symtab.table;
+  NameSpace of string Symtab.table;
 
-fun entries_of (NameSpace (entries, _)) = entries;
-fun tab_of (NameSpace (_, tab)) = tab;
+val empty = NameSpace Symtab.empty;
 
-fun make entries =
-  let
-    fun accesses [] = []
-      | accesses entry =
-          let
-            val p = pack entry;
-            val (q, b) = split_last entry;
-            val sfxs = suffixes1 entry;
-            val pfxs = map (fn x => x @ [b]) (prefixes1 q);
-          in
-            map (rpair p o pack) (sfxs @ pfxs)
-          end;
-    val mapping = filter_out (op =) (distinct_fst_string (flat (map accesses entries)));
-  in
-    NameSpace (entries, Symtab.make mapping)
-  end;
+(* FIXME !? *)
+fun dest (NameSpace tab) = map (fn (x, y) => x ^ " -> " ^ y) (Symtab.dest tab);
+fun dest (NameSpace tab) = map fst (Symtab.dest tab);
 
-fun dest space = rev (map pack (entries_of space));
+(* FIXME !? *)
+fun declared (NameSpace tab) name = is_some (Symtab.lookup (tab, name));
 
 
+(* extend, merge operations *)
 
-(* empty, extend, merge operations *)
-
-val empty = make [];
+fun add (tab, entry) = Symtab.update (entry, tab);
 
-fun extend (entries, space) =
-  make (map unpack (rev entries) @ entries_of space);
+fun extend (NameSpace tab, names) =
+  NameSpace (foldl add (tab, flat (map accesses names)));
 
-fun merge (space1, space2) =    (*2nd overrides 1st*)
-  make (merge_lists (entries_of space2) (entries_of space1));
-
-fun declared space name = unpack name mem (entries_of space);
+fun merge (NameSpace tab1, NameSpace tab2) =    (*2nd overrides 1st*)
+  NameSpace (foldl add (tab1, Symtab.dest tab2));
 
 
 (* intern / extern names *)
 
-fun intern space name =
-  if_none (Symtab.lookup (tab_of space, name)) name;
+fun intern (NameSpace tab) name =
+  if_none (Symtab.lookup (tab, name)) name;
 
 fun extern space name =
   let