smarter generic_const: plain alias for non-dependent case (e.g. prospective datatype or record syntax);
authorwenzelm
Mon, 02 Apr 2012 20:50:41 +0200
changeset 48162daeaf4824e9a
parent 48161 daef54bad420
child 48163 4bab649dedf0
smarter generic_const: plain alias for non-dependent case (e.g. prospective datatype or record syntax);
src/Pure/Isar/named_target.ML
     1.1 --- a/src/Pure/Isar/named_target.ML	Mon Apr 02 20:12:17 2012 +0200
     1.2 +++ b/src/Pure/Isar/named_target.ML	Mon Apr 02 20:50:41 2012 +0200
     1.3 @@ -46,11 +46,38 @@
     1.4  
     1.5  (* consts in locale *)
     1.6  
     1.7 -fun generic_const same_shape prmode ((b, mx), t) =
     1.8 -  Proof_Context.generic_add_abbrev Print_Mode.internal (b, t)
     1.9 -  #-> (fn (const as Const (c, _), _) => same_shape ?
    1.10 -        (Proof_Context.generic_revert_abbrev (#1 prmode) c #>
    1.11 -          Morphism.form (Proof_Context.generic_notation true prmode [(const, mx)])));
    1.12 +fun generic_const same_shape prmode ((b, mx), t) context =
    1.13 +  let
    1.14 +    val const_alias =
    1.15 +      if same_shape then
    1.16 +        (case t of
    1.17 +          Const (c, T) =>
    1.18 +            let
    1.19 +              val thy = Context.theory_of context;
    1.20 +              val ctxt = Context.proof_of context;
    1.21 +              val t' = Syntax.check_term ctxt (Const (c, dummyT))
    1.22 +                |> singleton (Variable.polymorphic ctxt);
    1.23 +            in
    1.24 +              (case t' of
    1.25 +                Const (c', T') =>
    1.26 +                  if c = c' andalso Sign.typ_equiv thy (T, T') then SOME c else NONE
    1.27 +              | _ => NONE)
    1.28 +            end
    1.29 +        | _ => NONE)
    1.30 +      else NONE;
    1.31 +  in
    1.32 +    (case const_alias of
    1.33 +      SOME c =>
    1.34 +        context
    1.35 +        |> Context.mapping (Sign.const_alias b c) (Proof_Context.const_alias b c)
    1.36 +        |> Morphism.form (Proof_Context.generic_notation true prmode [(t, mx)])
    1.37 +    | NONE =>
    1.38 +        context
    1.39 +        |> Proof_Context.generic_add_abbrev Print_Mode.internal (b, t)
    1.40 +        |-> (fn (const as Const (c, _), _) => same_shape ?
    1.41 +              (Proof_Context.generic_revert_abbrev (#1 prmode) c #>
    1.42 +               Morphism.form (Proof_Context.generic_notation true prmode [(const, mx)]))))
    1.43 +  end;
    1.44  
    1.45  fun locale_const (Target {target, is_class, ...}) (prmode as (mode, _)) ((b, mx), rhs) =
    1.46    Generic_Target.locale_declaration target true (fn phi =>