merged
authorboehmes
Sat, 31 May 2014 23:00:13 +0200
changeset 57146 728fa98b7fdf
parent 57145 7292a7258750 (current diff)
parent 57143 3e083fb1218a (diff)
child 57147 9d6f733ef456
merged
--- a/src/Pure/Isar/class.ML	Sat May 31 22:59:54 2014 +0200
+++ b/src/Pure/Isar/class.ML	Sat May 31 23:00:13 2014 +0200
@@ -316,10 +316,6 @@
 
 local
 
-fun target_extension f class b_mx_rhs =
-  Local_Theory.raw_theory (fn thy => f class (morphism thy class) b_mx_rhs thy)
-  #> synchronize_class_syntax_target class;
-
 fun class_const class prmode (b, rhs) =
   Generic_Target.locale_declaration class true (fn phi =>
     let
@@ -336,8 +332,7 @@
         orelse same_shape;
     in
       not is_canonical_class ? Generic_Target.generic_const same_shape prmode ((b', NoSyn), rhs')
-    end) #>
-  Generic_Target.const (fn (this, other) => other <> 0 andalso this <> other) prmode ((b, NoSyn), rhs);
+    end);
 
 fun dangling_params_for lthy class (type_params, term_params) =
   let
@@ -355,11 +350,11 @@
       #> snd
       #> pair def_thm);
 
-fun global_const dangling_params class phi ((b, mx), rhs) thy =
+fun canonical_const class phi dangling_params ((b, mx), rhs) thy =
   let
     val dangling_params' = map (Morphism.term phi) dangling_params;
     val b' = Morphism.binding phi b;
-    val b_def = Morphism.binding phi (Binding.suffix_name "_dict" b');
+    val b_def = Binding.suffix_name "_dict" b';
     val rhs' = Morphism.term phi rhs;
     val c' = Sign.full_name thy b';
     val ty' = map Term.fastype_of dangling_params' ---> Term.fastype_of rhs';
@@ -375,7 +370,7 @@
     |> Sign.add_const_constraint (c', SOME ty')
   end;
 
-fun global_abbrev prmode class phi ((b, mx), rhs) thy =
+fun canonical_abbrev class phi prmode ((b, mx), rhs) thy =
   let
     val unchecks = these_unchecks thy [class];
     val b' = Morphism.binding phi b;
@@ -396,15 +391,25 @@
 fun const class ((b, mx), lhs) params lthy =
   let
     val dangling_params = dangling_params_for lthy class params;
+    val phi = morphism (Proof_Context.theory_of lthy) class;
   in
     lthy
     |> class_const class Syntax.mode_default (b, lhs)
-    |> target_extension (global_const dangling_params) class ((b, mx), lhs)
+    |> Local_Theory.raw_theory (canonical_const class phi dangling_params ((b, mx), lhs))
+    |> Generic_Target.const (fn (this, other) => other <> 0 andalso this <> other) Syntax.mode_default ((b, NoSyn), lhs)
+    |> synchronize_class_syntax_target class
   end;
 
-fun abbrev class prmode ((b, mx), lhs) rhs' =
-  class_const class prmode (b, lhs)
-  #> target_extension (global_abbrev prmode) class ((b, mx), rhs');
+fun abbrev class prmode ((b, mx), lhs) rhs' lthy =
+  let
+    val phi = morphism (Proof_Context.theory_of lthy) class;
+  in
+    lthy
+    |> class_const class prmode (b, lhs)
+    |> Local_Theory.raw_theory (canonical_abbrev class phi prmode ((b, mx), rhs'))
+    |> Generic_Target.const (fn (this, other) => other <> 0 andalso this <> other) prmode ((b, NoSyn), lhs)
+    |> synchronize_class_syntax_target class
+  end;
 
 end;