src/HOL/Ctr_Sugar.thy
author blanchet
Tue Nov 12 13:47:24 2013 +0100 (2013-11-12)
changeset 54398 100c0eaf63d5
parent 54397 f4b4fa25ce56
child 54615 62fb5af93fe2
permissions -rw-r--r--
moved 'Ctr_Sugar' further up the theory hierarchy, so that 'Datatype' can use it
blanchet@54397
     1
(*  Title:      HOL/Ctr_Sugar.thy
blanchet@49486
     2
    Author:     Jasmin Blanchette, TU Muenchen
blanchet@54397
     3
    Copyright   2012, 2013
blanchet@49075
     4
blanchet@51797
     5
Wrapping existing freely generated type's constructors.
blanchet@49075
     6
*)
blanchet@49075
     7
blanchet@51797
     8
header {* Wrapping Existing Freely Generated Type's Constructors *}
blanchet@49075
     9
blanchet@54006
    10
theory Ctr_Sugar
blanchet@54398
    11
imports HOL
blanchet@49075
    12
keywords
blanchet@54398
    13
  "print_case_translations" :: diag and
blanchet@51781
    14
  "wrap_free_constructors" :: thy_goal and
blanchet@52969
    15
  "no_discs_sels" and
blanchet@49633
    16
  "rep_compat"
blanchet@49075
    17
begin
blanchet@49075
    18
blanchet@54398
    19
consts
blanchet@54398
    20
  case_guard :: "bool \<Rightarrow> 'a \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b"
blanchet@54398
    21
  case_nil :: "'a \<Rightarrow> 'b"
blanchet@54398
    22
  case_cons :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"
blanchet@54398
    23
  case_elem :: "'a \<Rightarrow> 'b \<Rightarrow> 'a \<Rightarrow> 'b"
blanchet@54398
    24
  case_abs :: "('c \<Rightarrow> 'b) \<Rightarrow> 'b"
blanchet@54398
    25
declare [[coercion_args case_guard - + -]]
blanchet@54398
    26
declare [[coercion_args case_cons - -]]
blanchet@54398
    27
declare [[coercion_args case_abs -]]
blanchet@54398
    28
declare [[coercion_args case_elem - +]]
blanchet@54398
    29
blanchet@54398
    30
ML_file "Tools/case_translation.ML"
blanchet@54398
    31
setup Case_Translation.setup
blanchet@54398
    32
blanchet@49312
    33
lemma iffI_np: "\<lbrakk>x \<Longrightarrow> \<not> y; \<not> x \<Longrightarrow> y\<rbrakk> \<Longrightarrow> \<not> x \<longleftrightarrow> y"
blanchet@49312
    34
by (erule iffI) (erule contrapos_pn)
blanchet@49312
    35
blanchet@49486
    36
lemma iff_contradict:
blanchet@49486
    37
"\<not> P \<Longrightarrow> P \<longleftrightarrow> Q \<Longrightarrow> Q \<Longrightarrow> R"
blanchet@49486
    38
"\<not> Q \<Longrightarrow> P \<longleftrightarrow> Q \<Longrightarrow> P \<Longrightarrow> R"
blanchet@49486
    39
by blast+
blanchet@49486
    40
blanchet@54008
    41
ML_file "Tools/ctr_sugar_util.ML"
blanchet@54007
    42
ML_file "Tools/ctr_sugar_tactics.ML"
blanchet@54007
    43
ML_file "Tools/ctr_sugar.ML"
blanchet@49309
    44
blanchet@49075
    45
end