more uniform alias vs. hide: proper check, allow to hide global names as well;
authorwenzelm
Mon, 17 Mar 2014 10:01:58 +0100
changeset 56168 088b64497a61
parent 56167 ac8098b0e458
child 56169 9b0dc5c704c9
more uniform alias vs. hide: proper check, allow to hide global names as well;
src/Pure/General/name_space.ML
--- a/src/Pure/General/name_space.ML	Sun Mar 16 13:34:35 2014 -0700
+++ b/src/Pure/General/name_space.ML	Mon Mar 17 10:01:58 2014 +0100
@@ -31,7 +31,6 @@
   val markup_extern: Proof.context -> T -> string -> Markup.T * xstring
   val pretty: Proof.context -> T -> string -> Pretty.T
   val completion: Context.generic -> T -> xstring * Position.T -> Completion.T
-  val hide: bool -> string -> T -> T
   val merge: T * T -> T
   type naming
   val conceal: naming -> naming
@@ -50,6 +49,7 @@
   val transform_binding: naming -> binding -> binding
   val full_name: naming -> binding -> string
   val base_name: binding -> string
+  val hide: bool -> string -> T -> T
   val alias: naming -> binding -> string -> T -> T
   val naming_of: Context.generic -> naming
   val map_naming: (naming -> naming) -> Context.generic -> Context.generic
@@ -258,25 +258,6 @@
   else Completion.none;
 
 
-(* hide *)
-
-fun hide fully name space =
-  if not (Long_Name.is_qualified name) then
-    error ("Attempt to hide global name " ^ quote name)
-  else if Long_Name.is_hidden name then
-    error ("Attempt to hide hidden name " ^ quote name)
-  else
-    space |> map_name_space (fn (kind, internals, entries) =>
-      let
-        val names = valid_accesses space name;
-        val internals' = internals
-          |> add_name' name name
-          |> fold (del_name name)
-            (if fully then names else inter (op =) [Long_Name.base_name name] names)
-          |> fold (del_name_extra name) (get_accesses space name);
-      in (kind, internals', entries) end);
-
-
 (* merge *)
 
 fun merge
@@ -395,21 +376,33 @@
   in pairself (map Long_Name.implode) (sfxs @ pfxs, sfxs) end;
 
 
+(* hide *)
+
+fun hide fully name space =
+  space |> map_name_space (fn (kind, internals, entries) =>
+    let
+      val _ = Change_Table.defined entries name orelse error (undefined kind name);
+      val names = valid_accesses space name;
+      val internals' = internals
+        |> add_name' name name
+        |> fold (del_name name)
+          (if fully then names else inter (op =) [Long_Name.base_name name] names)
+        |> fold (del_name_extra name) (get_accesses space name);
+    in (kind, internals', entries) end);
+
+
 (* alias *)
 
 fun alias naming binding name space =
-  let
-    val (accs, accs') = accesses naming binding;
-    val space' =
-      space |> map_name_space (fn (kind, internals, entries) =>
-        let
-          val _ = Change_Table.defined entries name orelse error (undefined kind name);
-          val internals' = internals |> fold (add_name name) accs;
-          val entries' = entries
-            |> Change_Table.map_entry name (fn (externals, entry) =>
-              (Library.merge (op =) (externals, accs'), entry))
-        in (kind, internals', entries') end);
-  in space' end;
+  space |> map_name_space (fn (kind, internals, entries) =>
+    let
+      val _ = Change_Table.defined entries name orelse error (undefined kind name);
+      val (accs, accs') = accesses naming binding;
+      val internals' = internals |> fold (add_name name) accs;
+      val entries' = entries
+        |> Change_Table.map_entry name (fn (externals, entry) =>
+          (Library.merge (op =) (externals, accs'), entry))
+    in (kind, internals', entries') end);