src/Pure/Isar/proof_context.ML
changeset 19663 459848022d6e
parent 19585 70a1ce3b23ae
child 19673 853f5a3cc06e
equal deleted inserted replaced
19662:2f5d076fde32 19663:459848022d6e
    12   type context (*= Context.proof*)
    12   type context (*= Context.proof*)
    13   type export
    13   type export
    14   val theory_of: context -> theory
    14   val theory_of: context -> theory
    15   val init: theory -> context
    15   val init: theory -> context
    16   val full_name: context -> bstring -> string
    16   val full_name: context -> bstring -> string
       
    17   val consts_of: context -> Consts.T
    17   val set_body: bool -> context -> context
    18   val set_body: bool -> context -> context
    18   val restore_body: context -> context -> context
    19   val restore_body: context -> context -> context
    19   val set_syntax_mode: string * bool -> context -> context
    20   val set_syntax_mode: string * bool -> context -> context
    20   val restore_syntax_mode: context -> context -> context
    21   val restore_syntax_mode: context -> context -> context
    21   val assms_of: context -> term list
    22   val assms_of: context -> term list
   153   val export_view: cterm list -> context -> context -> thm -> thm
   154   val export_view: cterm list -> context -> context -> thm -> thm
   154   val add_cases: bool -> (string * RuleCases.T option) list -> context -> context
   155   val add_cases: bool -> (string * RuleCases.T option) list -> context -> context
   155   val apply_case: RuleCases.T -> context -> (string * term list) list * context
   156   val apply_case: RuleCases.T -> context -> (string * term list) list * context
   156   val get_case: context -> string -> string option list -> RuleCases.T
   157   val get_case: context -> string -> string option list -> RuleCases.T
   157   val expand_abbrevs: bool -> context -> context
   158   val expand_abbrevs: bool -> context -> context
   158   val add_abbrevs: string * bool -> (bstring * string * mixfix) list -> context -> context
   159   val add_const_syntax: string * bool -> (string * mixfix) list -> context -> context
   159   val add_abbrevs_i: string * bool -> (bstring * term * mixfix) list -> context -> context
   160   val add_abbrevs: string * bool -> (bstring * term * mixfix) list -> context -> context
   160   val verbose: bool ref
   161   val verbose: bool ref
   161   val setmp_verbose: ('a -> 'b) -> 'a -> 'b
   162   val setmp_verbose: ('a -> 'b) -> 'a -> 'b
   162   val print_syntax: context -> unit
   163   val print_syntax: context -> unit
   163   val print_binds: context -> unit
   164   val print_binds: context -> unit
   164   val print_lthms: context -> unit
   165   val print_lthms: context -> unit
  1106 val cert_vars_legacy = prep_vars cert_typ true true;
  1107 val cert_vars_legacy = prep_vars cert_typ true true;
  1107 
  1108 
  1108 end;
  1109 end;
  1109 
  1110 
  1110 
  1111 
       
  1112 (* const syntax *)
       
  1113 
       
  1114 fun add_const_syntax prmode args ctxt =
       
  1115   ctxt |> map_syntax
       
  1116     (LocalSyntax.add_modesyntax (theory_of ctxt) prmode
       
  1117       (map (pair false o Consts.syntax (consts_of ctxt)) args));
       
  1118 
       
  1119 
  1111 (* abbreviations *)
  1120 (* abbreviations *)
  1112 
  1121 
  1113 val expand_abbrevs = map_consts o apsnd o Consts.expand_abbrevs;
  1122 val expand_abbrevs = map_consts o apsnd o Consts.expand_abbrevs;
  1114 
  1123 
  1115 local
  1124 fun add_abbrevs prmode = fold (fn (raw_c, raw_t, raw_mx) => fn ctxt =>
  1116 
  1125   let
  1117 fun gen_abbrevs prep_vars prep_term (mode, inout) = fold (fn (raw_c, raw_t, raw_mx) => fn ctxt =>
  1126     val ([(c, _, mx)], _) = cert_vars [(raw_c, NONE, raw_mx)] ctxt;
  1118   let
       
  1119     val ([(c, _, mx)], _) = prep_vars [(raw_c, NONE, raw_mx)] ctxt;
       
  1120     val (c', b) = Syntax.mixfix_const (full_name ctxt c) mx;
  1127     val (c', b) = Syntax.mixfix_const (full_name ctxt c) mx;
  1121     val [t] = polymorphic ctxt [prep_term (ctxt |> expand_abbrevs false) raw_t];
  1128     val [t] = polymorphic ctxt [cert_term (ctxt |> expand_abbrevs false) raw_t];
  1122     val T = Term.fastype_of t;
  1129     val T = Term.fastype_of t;
  1123     val _ =
  1130     val _ =
  1124       if null (hidden_polymorphism t T) then ()
  1131       if null (hidden_polymorphism t T) then ()
  1125       else error ("Extra type variables on rhs of abbreviation: " ^ quote c);
  1132       else error ("Extra type variables on rhs of abbreviation: " ^ quote c);
  1126   in
  1133   in
  1127     ctxt
  1134     ctxt
  1128     |> declare_term t
  1135     |> declare_term t
  1129     |> map_consts
  1136     |> map_consts
  1130       (apsnd (Consts.abbreviate (pp ctxt) (tsig_of ctxt) (naming_of ctxt) mode ((c, t), b)))
  1137       (apsnd (Consts.abbreviate (pp ctxt) (tsig_of ctxt) (naming_of ctxt) (#1 prmode) ((c, t), b)))
  1131     |> map_syntax (fn syntax => syntax
  1138     |> map_syntax (LocalSyntax.add_modesyntax (theory_of ctxt) prmode [(false, (c', T, mx))])
  1132         |> LocalSyntax.set_mode (mode, inout)
       
  1133         |> LocalSyntax.add_syntax (theory_of ctxt) [(false, (c', T, mx))]
       
  1134         |> LocalSyntax.restore_mode syntax)
       
  1135   end);
  1139   end);
  1136 
       
  1137 in
       
  1138 
       
  1139 val add_abbrevs = gen_abbrevs read_vars read_term;
       
  1140 val add_abbrevs_i = gen_abbrevs cert_vars cert_term;
       
  1141 
       
  1142 end;
       
  1143 
  1140 
  1144 
  1141 
  1145 (* fixes *)
  1142 (* fixes *)
  1146 
  1143 
  1147 local
  1144 local