# HG changeset patch
# User wenzelm
# Date 1165353289 -3600
# Node ID dd4e89123359c86fd8ff6c8752c3645b94da6f16
# Parent  734a9c3f562d7945421d62ecb466b80b8e04106d
notation/abbreviation: more serious handling of morphisms;

diff -r 734a9c3f562d -r dd4e89123359 src/Pure/Isar/local_theory.ML
--- a/src/Pure/Isar/local_theory.ML	Tue Dec 05 22:14:48 2006 +0100
+++ b/src/Pure/Isar/local_theory.ML	Tue Dec 05 22:14:49 2006 +0100
@@ -146,7 +146,7 @@
 fun target f = #2 o target_result (f #> pair ());
 
 
-(* primitive operations *)
+(* basic operations *)
 
 fun operation f lthy = f (#operations (get_lthy lthy)) lthy;
 fun operation1 f x = operation (fn ops => f ops x);
@@ -163,22 +163,29 @@
 val target_morphism = operation #target_morphism;
 val target_name = operation #target_name;
 
-
-(* derived operations *)
-
 fun def kind arg lthy = lthy |> defs kind [arg] |>> hd;
-
 fun note kind (a, ths) lthy = lthy |> notes kind [(a, [(ths, [])])] |>> hd;
 
-fun notation mode args = term_syntax (fn phi =>
-  let val args' = args |> map (fn (t, mx) => (Morphism.term phi t, mx))
-  in Context.mapping (Sign.add_notation mode args') (ProofContext.add_notation mode args') end);
+
+(* term syntax *)
+
+fun generic_notation mode args phi =
+  let
+    val args' = args |> filter (fn (t, _) => t aconv Morphism.term phi t);
+  in Context.mapping (Sign.add_notation mode args') (ProofContext.add_notation mode args') end;
+
+fun notation mode args = term_syntax (generic_notation mode args);
 
 fun abbrevs mode args = term_syntax (fn phi =>
-  let val args' = args |> map (fn ((c, mx), t) => ((Morphism.name phi c, mx), Morphism.term phi t))
+  let
+    val (mxs, args') = args |> map_filter (fn ((c, mx), t) =>
+        if t aconv Morphism.term phi t
+        then SOME (mx, ((Morphism.name phi c, NoSyn), t))
+        else NONE)
+      |> split_list;
   in
-    Context.mapping
-      (snd o Sign.add_abbrevs mode args') (snd o ProofContext.add_abbrevs mode args')
+    Context.mapping_result (Sign.add_abbrevs mode args') (ProofContext.add_abbrevs mode args')
+    #-> (fn abbrs => generic_notation mode (map #1 abbrs ~~ mxs) phi)
   end);