# HG changeset patch # User wenzelm # Date 1333392641 -7200 # Node ID daeaf4824e9a4292a950bc5b700f501ffb6ded8d # Parent daef54bad4203b3cca7e62dbc8d155bb3195a9c3 smarter generic_const: plain alias for non-dependent case (e.g. prospective datatype or record syntax); diff -r daef54bad420 -r daeaf4824e9a src/Pure/Isar/named_target.ML --- a/src/Pure/Isar/named_target.ML Mon Apr 02 20:12:17 2012 +0200 +++ b/src/Pure/Isar/named_target.ML Mon Apr 02 20:50:41 2012 +0200 @@ -46,11 +46,38 @@ (* consts in locale *) -fun generic_const same_shape prmode ((b, mx), t) = - Proof_Context.generic_add_abbrev Print_Mode.internal (b, t) - #-> (fn (const as Const (c, _), _) => same_shape ? - (Proof_Context.generic_revert_abbrev (#1 prmode) c #> - Morphism.form (Proof_Context.generic_notation true prmode [(const, mx)]))); +fun generic_const same_shape prmode ((b, mx), t) context = + let + val const_alias = + if same_shape then + (case t of + Const (c, T) => + let + val thy = Context.theory_of context; + val ctxt = Context.proof_of context; + val t' = Syntax.check_term ctxt (Const (c, dummyT)) + |> singleton (Variable.polymorphic ctxt); + in + (case t' of + Const (c', T') => + if c = c' andalso Sign.typ_equiv thy (T, T') then SOME c else NONE + | _ => NONE) + end + | _ => NONE) + else NONE; + in + (case const_alias of + SOME c => + context + |> Context.mapping (Sign.const_alias b c) (Proof_Context.const_alias b c) + |> Morphism.form (Proof_Context.generic_notation true prmode [(t, mx)]) + | NONE => + context + |> Proof_Context.generic_add_abbrev Print_Mode.internal (b, t) + |-> (fn (const as Const (c, _), _) => same_shape ? + (Proof_Context.generic_revert_abbrev (#1 prmode) c #> + Morphism.form (Proof_Context.generic_notation true prmode [(const, mx)])))) + end; fun locale_const (Target {target, is_class, ...}) (prmode as (mode, _)) ((b, mx), rhs) = Generic_Target.locale_declaration target true (fn phi =>