src/Pure/Isar/code_unit.ML
changeset 31089 11001968caae
parent 31036 64ff53fc0c0c
child 31090 3be41b271023
equal deleted inserted replaced
31088:36a011423fcc 31089:11001968caae
    36 
    36 
    37   (*code equations*)
    37   (*code equations*)
    38   val assert_eqn: theory -> thm -> thm
    38   val assert_eqn: theory -> thm -> thm
    39   val mk_eqn: theory -> thm -> thm * bool
    39   val mk_eqn: theory -> thm -> thm * bool
    40   val assert_linear: (string -> bool) -> thm * bool -> thm * bool
    40   val assert_linear: (string -> bool) -> thm * bool -> thm * bool
    41   val const_eqn: thm -> string
    41   val const_eqn: theory -> thm -> string
    42   val const_typ_eqn: thm -> string * typ
    42   val const_typ_eqn: thm -> string * typ
    43   val head_eqn: theory -> thm -> string * ((string * sort) list * typ)
    43   val typscheme_eqn: theory -> thm -> (string * sort) list * typ
    44   val expand_eta: theory -> int -> thm -> thm
    44   val expand_eta: theory -> int -> thm -> thm
    45   val rewrite_eqn: simpset -> thm -> thm
    45   val rewrite_eqn: simpset -> thm -> thm
    46   val rewrite_head: thm list -> thm -> thm
    46   val rewrite_head: thm list -> thm -> thm
    47   val norm_args: theory -> thm list -> thm list 
    47   val norm_args: theory -> thm list -> thm list 
    48   val norm_varnames: theory -> thm list -> thm list
    48   val norm_varnames: theory -> thm list -> thm list
   388             ^ quote c ^ ",\n in equation\n" ^ Display.string_of_thm thm)
   388             ^ quote c ^ ",\n in equation\n" ^ Display.string_of_thm thm)
   389       | t => t) args;
   389       | t => t) args;
   390   in thm end;
   390   in thm end;
   391 
   391 
   392 fun assert_linear is_cons (thm, false) = (thm, false)
   392 fun assert_linear is_cons (thm, false) = (thm, false)
   393   | assert_linear is_cons (thm, true) = if snd (add_linear (assert_pat is_cons thm)) then (thm, true)
   393   | assert_linear is_cons (thm, true) = if snd (add_linear (assert_pat is_cons thm))
       
   394       then (thm, true)
   394       else bad_thm
   395       else bad_thm
   395         ("Duplicate variables on left hand side of code equation:\n"
   396         ("Duplicate variables on left hand side of code equation:\n"
   396           ^ Display.string_of_thm thm);
   397           ^ Display.string_of_thm thm);
   397 
   398 
   398 
       
   399 fun mk_eqn thy = add_linear o assert_eqn thy o AxClass.unoverload thy
       
   400   o LocalDefs.meta_rewrite_rule (ProofContext.init thy);
       
   401 
       
   402 val const_typ_eqn = dest_Const o fst o strip_comb o fst o Logic.dest_equals o Thm.plain_prop_of;
   399 val const_typ_eqn = dest_Const o fst o strip_comb o fst o Logic.dest_equals o Thm.plain_prop_of;
   403 val const_eqn = fst o const_typ_eqn;
   400 
   404 fun head_eqn thy thm = let val (c, ty) = const_typ_eqn thm in (c, typscheme thy (c, ty)) end;
   401 fun typscheme_eqn thy = typscheme thy o const_typ_eqn;
       
   402 
       
   403 (*permissive wrt. to overloaded constants!*)
       
   404 fun mk_eqn thy = add_linear o assert_eqn thy o LocalDefs.meta_rewrite_rule (ProofContext.init thy);
       
   405 fun const_eqn thy = AxClass.unoverload_const thy o const_typ_eqn;
   405 
   406 
   406 
   407 
   407 (* case cerificates *)
   408 (* case cerificates *)
   408 
   409 
   409 fun case_certificate thm =
   410 fun case_certificate thm =