# HG changeset patch # User boehmes # Date 1401570013 -7200 # Node ID 728fa98b7fdf6dee1e0e9543fa0a51acd3fd45e4 # Parent 7292a7258750c355c1ca84b01b5497630de1ceb5# Parent 3e083fb1218aa9f70163316c886452b62842bcd3 merged diff -r 7292a7258750 -r 728fa98b7fdf src/Pure/Isar/class.ML --- 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;