# HG changeset patch
# User haftmann
# Date 1391412201 -3600
# Node ID 42cf5802d36a0ae50786ead283af58d679678d6a
# Parent  1e973b665b981420f96545804155a952f770dfc7
code generation: explicitly declared identifiers gain predence over implicit ones

diff -r 1e973b665b98 -r 42cf5802d36a src/Doc/IsarRef/HOL_Specific.thy
--- a/src/Doc/IsarRef/HOL_Specific.thy	Mon Feb 03 08:23:20 2014 +0100
+++ b/src/Doc/IsarRef/HOL_Specific.thy	Mon Feb 03 08:23:21 2014 +0100
@@ -2640,9 +2640,11 @@
   \item @{command (HOL) "code_identifier"} associates a a series of symbols
   (constants, type constructors, classes, class relations, instances,
   module names) with target-specific hints how these symbols shall be named.
-  \emph{Warning:} These hints are still subject to name disambiguation.
+  These hints gain precedence over names for symbols with no hints at all.
+  Conflicting hints are subject to name disambiguation.
   @{command (HOL) "code_modulename"} is a legacy variant for
-  @{command (HOL) "code_identifier"} on module names.  It is at the discretion
+  @{command (HOL) "code_identifier"} on module names.
+  \emph{Warning:} It is at the discretion
   of the user to ensure that name prefixes of identifiers in compound
   statements like type classes or datatypes are still the same.
 
diff -r 1e973b665b98 -r 42cf5802d36a src/Tools/Code/code_namespace.ML
--- a/src/Tools/Code/code_namespace.ML	Mon Feb 03 08:23:20 2014 +0100
+++ b/src/Tools/Code/code_namespace.ML	Mon Feb 03 08:23:21 2014 +0100
@@ -69,12 +69,16 @@
     | SOME prefix_name => if null force_module then prefix_name
         else (force_module, snd prefix_name);
 
+fun has_priority identifiers = is_some o Code_Symbol.lookup identifiers;
+
 fun build_proto_program { empty, add_stmt, add_dep } program =
   empty
   |> Code_Symbol.Graph.fold (fn (sym, (stmt, _)) => add_stmt sym stmt) program
   |> Code_Symbol.Graph.fold (fn (sym, (_, (_, syms))) =>
       Code_Symbol.Graph.Keys.fold (add_dep sym) syms) program;
 
+fun prioritize has_priority = uncurry append o List.partition has_priority;
+
 
 (** flat program structure **)
 
@@ -90,6 +94,7 @@
     val prep_sym = prep_symbol ctxt { module_namespace = module_namespace,
       force_module = Long_Name.explode module_name, identifiers = identifiers }
       #>> Long_Name.implode;
+    val sym_priority = has_priority identifiers;
 
     (* distribute statements over hierarchy *)
     fun add_stmt sym stmt =
@@ -117,7 +122,8 @@
         val gr' = (Code_Symbol.Graph.map_node sym o apfst) (K base') gr;
       in (gr', nsp') end;
     fun declarations gr = (gr, empty_nsp)
-      |> fold (fn sym => declare sym (Code_Symbol.Graph.get_node gr sym)) (Code_Symbol.Graph.keys gr) 
+      |> fold (fn sym => declare sym (Code_Symbol.Graph.get_node gr sym))
+          (prioritize sym_priority (Code_Symbol.Graph.keys gr))
       |> fst
       |> (Code_Symbol.Graph.map o K o apsnd) modify_stmt;
     val flat_program = proto_program
@@ -176,7 +182,8 @@
     val module_namespace = build_module_namespace ctxt { module_prefix = "",
       module_name = module_name, identifiers = identifiers, reserved = reserved } program;
     val prep_sym = prep_symbol ctxt { module_namespace = module_namespace,
-      force_module = Long_Name.explode module_name, identifiers = identifiers };
+      force_module = Long_Name.explode module_name, identifiers = identifiers }
+    val sym_priority = has_priority identifiers;
 
     (* building empty module hierarchy *)
     val empty_module = (empty_data, Code_Symbol.Graph.empty);
@@ -223,9 +230,12 @@
     (* name declarations, data and statement modifications *)
     fun make_declarations nsps (data, nodes) =
       let
-        val (module_fragments, stmt_syms) = List.partition
-          (fn sym => case Code_Symbol.Graph.get_node nodes sym
-            of (_, Module _) => true | _ => false) (Code_Symbol.Graph.keys nodes);
+        val (module_fragments, stmt_syms) =
+          Code_Symbol.Graph.keys nodes
+          |> List.partition
+              (fn sym => case Code_Symbol.Graph.get_node nodes sym
+                of (_, Module _) => true | _ => false)
+          |> pairself (prioritize sym_priority)
         fun declare namify sym (nsps, nodes) =
           let
             val (base, node) = Code_Symbol.Graph.get_node nodes sym;