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 = |