src/Pure/thm.ML
changeset 564 eec3a9222b50
parent 480 d74522d9437f
child 574 810da101bad2
equal deleted inserted replaced
563:e9bf62651beb 564:eec3a9222b50
    29   val rep_ctyp: ctyp -> {T: typ, sign: Sign.sg}
    29   val rep_ctyp: ctyp -> {T: typ, sign: Sign.sg}
    30   val term_of: cterm -> term
    30   val term_of: cterm -> term
    31   val typ_of: ctyp -> typ
    31   val typ_of: ctyp -> typ
    32   val cterm_fun: (term -> term) -> (cterm -> cterm)
    32   val cterm_fun: (term -> term) -> (cterm -> cterm)
    33   (*end of cterm/ctyp functions*)
    33   (*end of cterm/ctyp functions*)
    34 
    34   local open Sign.Syntax in
    35   (* FIXME *)
    35     val add_classes: (class * class list) list -> theory -> theory
    36   local open Sign.Syntax Sign.Syntax.Mixfix in  (* FIXME remove ...Mixfix *)
       
    37     val add_classes: (class list * class * class list) list -> theory -> theory
       
    38     val add_classrel: (class * class) list -> theory -> theory
    36     val add_classrel: (class * class) list -> theory -> theory
    39     val add_defsort: sort -> theory -> theory
    37     val add_defsort: sort -> theory -> theory
    40     val add_types: (string * int * mixfix) list -> theory -> theory
    38     val add_types: (string * int * mixfix) list -> theory -> theory
    41     val add_tyabbrs: (string * string list * string * mixfix) list
    39     val add_tyabbrs: (string * string list * string * mixfix) list
    42       -> theory -> theory
    40       -> theory -> theory
    57     val add_axioms_i: (string * term) list -> theory -> theory
    55     val add_axioms_i: (string * term) list -> theory -> theory
    58     val add_thyname: string -> theory -> theory
    56     val add_thyname: string -> theory -> theory
    59   end
    57   end
    60   val cert_axm: Sign.sg -> string * term -> string * term
    58   val cert_axm: Sign.sg -> string * term -> string * term
    61   val read_axm: Sign.sg -> string * string -> string * term
    59   val read_axm: Sign.sg -> string * string -> string * term
       
    60   val inferT_axm: Sign.sg -> string * term -> string * term
    62   val abstract_rule: string -> cterm -> thm -> thm
    61   val abstract_rule: string -> cterm -> thm -> thm
    63   val add_congs: meta_simpset * thm list -> meta_simpset
    62   val add_congs: meta_simpset * thm list -> meta_simpset
    64   val add_prems: meta_simpset * thm list -> meta_simpset
    63   val add_prems: meta_simpset * thm list -> meta_simpset
    65   val add_simps: meta_simpset * thm list -> meta_simpset
    64   val add_simps: meta_simpset * thm list -> meta_simpset
    66   val assume: cterm -> thm
    65   val assume: cterm -> thm
    77   val dest_state: thm * int -> (term*term)list * term list * term * term
    76   val dest_state: thm * int -> (term*term)list * term list * term * term
    78   val empty_mss: meta_simpset
    77   val empty_mss: meta_simpset
    79   val eq_assumption: int -> thm -> thm
    78   val eq_assumption: int -> thm -> thm
    80   val equal_intr: thm -> thm -> thm
    79   val equal_intr: thm -> thm -> thm
    81   val equal_elim: thm -> thm -> thm
    80   val equal_elim: thm -> thm -> thm
    82   val extend_theory: theory -> string
       
    83         -> (class * class list) list * sort
       
    84            * (string list * int)list
       
    85            * (string * string list * string) list
       
    86            * (string list * (sort list * class))list
       
    87            * (string list * string)list * Sign.Syntax.sext option
       
    88         -> (string*string)list -> theory
       
    89   val extensional: thm -> thm
    81   val extensional: thm -> thm
    90   val flexflex_rule: thm -> thm Sequence.seq
    82   val flexflex_rule: thm -> thm Sequence.seq
    91   val flexpair_def: thm
    83   val flexpair_def: thm
    92   val forall_elim: cterm -> thm -> thm
    84   val forall_elim: cterm -> thm -> thm
    93   val forall_intr: cterm -> thm -> thm
    85   val forall_intr: cterm -> thm -> thm
   191         Cterm{sign=sign, T=T, maxidx=maxidx, t=B})
   183         Cterm{sign=sign, T=T, maxidx=maxidx, t=B})
   192   | dest_cimplies ct = raise TERM ("dest_cimplies", [term_of ct]);
   184   | dest_cimplies ct = raise TERM ("dest_cimplies", [term_of ct]);
   193 
   185 
   194 
   186 
   195 
   187 
   196 (** read cterms **)
   188 (** read cterms **)   (*exception ERROR*)     (* FIXME check *)
   197 
   189 
   198 (*read term, infer types, certify term*)
   190 (*read term, infer types, certify term*)
   199 
       
   200 fun read_def_cterm (sign, types, sorts) (a, T) =
   191 fun read_def_cterm (sign, types, sorts) (a, T) =
   201   let
   192   let
   202     val {tsig, const_tab, syn, ...} = Sign.rep_sg sign;
   193     val t = Syntax.read (#syn (Sign.rep_sg sign)) T a;
   203     val showtyp = Sign.string_of_typ sign;
   194     val (t', tye) = Sign.infer_types sign types sorts (t, T);
   204     val showterm = Sign.string_of_term sign;
       
   205 
       
   206     fun termerr [] = ""
       
   207       | termerr [t] = "\nInvolving this term:\n" ^ showterm t
       
   208       | termerr ts = "\nInvolving these terms:\n" ^ cat_lines (map showterm ts);
       
   209 
       
   210     val T' = Sign.certify_typ sign T
       
   211       handle TYPE (msg, _, _) => error msg;
       
   212     val t = Syntax.read syn T' a;
       
   213     val (t', tye) = Type.infer_types (tsig, const_tab, types, sorts, T', t)
       
   214       handle TYPE (msg, Ts, ts) => error ("Type checking error: " ^ msg ^ "\n"
       
   215         ^ cat_lines (map showtyp Ts) ^ termerr ts);
       
   216     val ct = cterm_of sign t' handle TERM (msg, _) => error msg;
   195     val ct = cterm_of sign t' handle TERM (msg, _) => error msg;
   217   in (ct, tye) end;
   196   in (ct, tye) end;
   218 
   197 
   219 fun read_cterm sign = #1 o read_def_cterm (sign, K None, K None);
   198 fun read_cterm sign = #1 o read_def_cterm (sign, K None, K None);
   220 
   199 
   373 
   352 
   374 fun read_axm sg (name, str) =
   353 fun read_axm sg (name, str) =
   375   (name, no_vars (term_of (read_cterm sg (str, propT))))
   354   (name, no_vars (term_of (read_cterm sg (str, propT))))
   376     handle ERROR => err_in_axm name;
   355     handle ERROR => err_in_axm name;
   377 
   356 
       
   357 fun inferT_axm sg (name, pre_tm) =
       
   358   (name, no_vars (#1 (Sign.infer_types sg (K None) (K None) (pre_tm, propT))))
       
   359     handle ERROR => err_in_axm name;
       
   360 
   378 
   361 
   379 (* extend axioms of a theory *)
   362 (* extend axioms of a theory *)
   380 
   363 
   381 fun ext_axms prep_axm axms (thy as Theory {sign, ...}) =
   364 fun ext_axms prep_axm axms (thy as Theory {sign, ...}) =
   382   let
   365   let
   386     ext_thy thy sign1 axioms
   369     ext_thy thy sign1 axioms
   387   end;
   370   end;
   388 
   371 
   389 val add_axioms = ext_axms read_axm;
   372 val add_axioms = ext_axms read_axm;
   390 val add_axioms_i = ext_axms cert_axm;
   373 val add_axioms_i = ext_axms cert_axm;
   391 
       
   392 
       
   393 (* extend theory (old) *)   (* FIXME remove *)
       
   394 
       
   395 (*converts Frees to Vars: axioms can be written without question marks*)
       
   396 fun prepare_axiom sign sP =
       
   397   Logic.varify (term_of (read_cterm sign (sP, propT)));
       
   398 
       
   399 (*read an axiom for a new theory*)
       
   400 fun read_ax sign (a, sP) =
       
   401   (a, prepare_axiom sign sP) handle ERROR => err_in_axm a;
       
   402 
       
   403 (*extension of a theory with given classes, types, constants and syntax;
       
   404   reads the axioms from strings: axpairs have the form (axname, axiom)*)
       
   405 fun extend_theory thy thyname ext axpairs =
       
   406   let
       
   407     val Theory {sign, ...} = thy;
       
   408 
       
   409     val sign1 = Sign.extend sign thyname ext;
       
   410     val axioms = map (read_ax sign1) axpairs;
       
   411   in
       
   412     writeln "WARNING: called obsolete function \"extend_theory\"";
       
   413     ext_thy thy sign1 axioms
       
   414   end;
       
   415 
   374 
   416 
   375 
   417 
   376 
   418 (** merge theories **)
   377 (** merge theories **)
   419 
   378