two target language numeral types: integer and natural, as replacement for code_numeral;
authorhaftmann
Fri Feb 15 08:31:31 2013 +0100 (2013-02-15)
changeset 511430a2371e7ced3
parent 51142 ac9e909fe55d
child 51144 0ede9e2266a8
two target language numeral types: integer and natural, as replacement for code_numeral;
former theory HOL/Library/Code_Numeral_Types replaces HOL/Code_Numeral;
refined stack of theories implementing int and/or nat by target language numerals;
reduced number of target language numeral types to exactly one
NEWS
src/Doc/Classes/Classes.thy
src/Doc/Classes/Setup.thy
src/Doc/Codegen/Adaptation.thy
src/Doc/Codegen/Foundations.thy
src/HOL/Code_Evaluation.thy
src/HOL/Code_Numeral.thy
src/HOL/Codegenerator_Test/Candidates_Pretty.thy
src/HOL/Codegenerator_Test/Generate_Pretty.thy
src/HOL/Decision_Procs/Approximation.thy
src/HOL/Decision_Procs/Cooper.thy
src/HOL/Decision_Procs/Ferrack.thy
src/HOL/Decision_Procs/MIR.thy
src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy
src/HOL/Imperative_HOL/Array.thy
src/HOL/Imperative_HOL/Heap_Monad.thy
src/HOL/Imperative_HOL/ex/Imperative_Quicksort.thy
src/HOL/Imperative_HOL/ex/Linked_Lists.thy
src/HOL/Int.thy
src/HOL/Lazy_Sequence.thy
src/HOL/Library/Cardinality.thy
src/HOL/Library/Code_Binary_Nat.thy
src/HOL/Library/Code_Char_chr.thy
src/HOL/Library/Code_Integer.thy
src/HOL/Library/Code_Natural.thy
src/HOL/Library/Code_Numeral_Types.thy
src/HOL/Library/Code_Real_Approx_By_Float.thy
src/HOL/Library/Code_Target_Int.thy
src/HOL/Library/Code_Target_Nat.thy
src/HOL/Library/DAList.thy
src/HOL/Library/Efficient_Nat.thy
src/HOL/Library/IArray.thy
src/HOL/Library/Multiset.thy
src/HOL/Library/Predicate_Compile_Alternative_Defs.thy
src/HOL/Library/Predicate_Compile_Quickcheck.thy
src/HOL/Limited_Sequence.thy
src/HOL/Num.thy
src/HOL/Predicate.thy
src/HOL/Predicate_Compile_Examples/Predicate_Compile_Tests.thy
src/HOL/Proofs/Extraction/Euclid.thy
src/HOL/Proofs/Extraction/Pigeonhole.thy
src/HOL/Proofs/Lambda/WeakNorm.thy
src/HOL/Quickcheck_Benchmark/Needham_Schroeder_Base.thy
src/HOL/Quickcheck_Examples/Completeness.thy
src/HOL/Quickcheck_Examples/Hotel_Example.thy
src/HOL/Quickcheck_Exhaustive.thy
src/HOL/Quickcheck_Narrowing.thy
src/HOL/Quickcheck_Random.thy
src/HOL/ROOT
src/HOL/Random.thy
src/HOL/Random_Pred.thy
src/HOL/Random_Sequence.thy
src/HOL/Rat.thy
src/HOL/Tools/Nitpick/nitpick_hol.ML
src/HOL/Tools/Predicate_Compile/predicate_compile_compilations.ML
src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML
src/HOL/Tools/Predicate_Compile/predicate_compile_quickcheck.ML
src/HOL/Tools/Qelim/cooper.ML
src/HOL/Tools/Qelim/cooper_procedure.ML
src/HOL/Tools/Quickcheck/exhaustive_generators.ML
src/HOL/Tools/Quickcheck/narrowing_generators.ML
src/HOL/Tools/Quickcheck/quickcheck_common.ML
src/HOL/Tools/Quickcheck/random_generators.ML
src/HOL/Tools/hologic.ML
src/HOL/Tools/record.ML
src/HOL/Word/Word.thy
src/HOL/ex/Code_Binary_Nat_examples.thy
src/HOL/ex/IArray_Examples.thy
src/Tools/Code/code_haskell.ML
src/Tools/Code/code_ml.ML
src/Tools/Code/code_printer.ML
src/Tools/Code/code_scala.ML
     1.1 --- a/NEWS	Fri Feb 15 08:31:30 2013 +0100
     1.2 +++ b/NEWS	Fri Feb 15 08:31:31 2013 +0100
     1.3 @@ -170,6 +170,18 @@
     1.4  
     1.5  *** HOL ***
     1.6  
     1.7 +* Numeric types mapped by default to target language numerals:
     1.8 +natural (replaces former code_numeral) and integer (replaces
     1.9 +former code_int).  Conversions are available as integer_of_natural /
    1.10 +natural_of_integer / integer_of_nat / nat_of_integer (in HOL) and
    1.11 +Code_Numeral.integer_of_natural / Code_Numeral.natural_of_integer (in ML).
    1.12 +INCOMPATIBILITY.
    1.13 +
    1.14 +* Discontinued theories Code_Integer and Efficient_Nat by a more
    1.15 +fine-grain stack of theories Code_Target_Int, Code_Binary_Nat,
    1.16 +Code_Target_Nat and Code_Target_Numeral.  See the tutorial on
    1.17 +code generation for details.  INCOMPATIBILITY.
    1.18 +
    1.19  * Sledgehammer:
    1.20  
    1.21    - Added MaSh relevance filter based on machine-learning; see the
     2.1 --- a/src/Doc/Classes/Classes.thy	Fri Feb 15 08:31:30 2013 +0100
     2.2 +++ b/src/Doc/Classes/Classes.thy	Fri Feb 15 08:31:31 2013 +0100
     2.3 @@ -600,7 +600,6 @@
     2.4  text {*
     2.5    \noindent This maps to Haskell as follows:
     2.6  *}
     2.7 -(*<*)code_include %invisible Haskell "Natural" -(*>*)
     2.8  text %quotetypewriter {*
     2.9    @{code_stmts example (Haskell)}
    2.10  *}
    2.11 @@ -616,7 +615,6 @@
    2.12  text {*
    2.13    \noindent In Scala, implicts are used as dictionaries:
    2.14  *}
    2.15 -(*<*)code_include %invisible Scala "Natural" -(*>*)
    2.16  text %quotetypewriter {*
    2.17    @{code_stmts example (Scala)}
    2.18  *}
    2.19 @@ -640,3 +638,4 @@
    2.20  *}
    2.21  
    2.22  end
    2.23 +
     3.1 --- a/src/Doc/Classes/Setup.thy	Fri Feb 15 08:31:30 2013 +0100
     3.2 +++ b/src/Doc/Classes/Setup.thy	Fri Feb 15 08:31:31 2013 +0100
     3.3 @@ -1,5 +1,5 @@
     3.4  theory Setup
     3.5 -imports Main "~~/src/HOL/Library/Code_Integer"
     3.6 +imports Main
     3.7  begin
     3.8  
     3.9  ML_file "../antiquote_setup.ML"
    3.10 @@ -37,4 +37,4 @@
    3.11    end
    3.12  *}
    3.13  
    3.14 -end
    3.15 \ No newline at end of file
    3.16 +end
     4.1 --- a/src/Doc/Codegen/Adaptation.thy	Fri Feb 15 08:31:30 2013 +0100
     4.2 +++ b/src/Doc/Codegen/Adaptation.thy	Fri Feb 15 08:31:31 2013 +0100
     4.3 @@ -125,11 +125,30 @@
     4.4  
     4.5    \begin{description}
     4.6  
     4.7 -    \item[@{text "Code_Integer"}] represents @{text HOL} integers by
     4.8 -       big integer literals in target languages.
     4.9 +    \item[@{theory "Code_Numeral"}] provides additional numeric
    4.10 +       types @{typ integer} and @{typ natural} isomorphic to types
    4.11 +       @{typ int} and @{typ nat} respectively.  Type @{typ integer}
    4.12 +       is mapped to target-language built-in integers; @{typ natural}
    4.13 +       is implemented as abstract type over @{typ integer}.
    4.14 +       Useful for code setups which involve e.g.~indexing
    4.15 +       of target-language arrays.  Part of @{text "HOL-Main"}.
    4.16 +
    4.17 +    \item[@{text "Code_Target_Int"}] implements type @{typ int}
    4.18 +       by @{typ integer} and thus by target-language built-in integers.
    4.19  
    4.20 -    \item[@{text "Code_Char"}] represents @{text HOL} characters by
    4.21 -       character literals in target languages.
    4.22 +    \item[@{text "Code_Binary_Nat"}] \label{eff_nat} implements type
    4.23 +       @{typ nat} using a binary rather than a linear representation,
    4.24 +       which yields a considerable speedup for computations.
    4.25 +       Pattern matching with @{term "0\<Colon>nat"} / @{const "Suc"} is eliminated
    4.26 +       by a preprocessor.
    4.27 +
    4.28 +    \item[@{text "Code_Target_Nat"}] implements type @{typ int}
    4.29 +       by @{typ integer} and thus by target-language built-in integers;
    4.30 +       contains @{text "Code_Binary_Nat"} as a prerequisite.
    4.31 +
    4.32 +    \item[@{text "Code_Target_Numeral"}] is a convenience node
    4.33 +       containing both @{text "Code_Target_Nat"} and
    4.34 +       @{text "Code_Target_Int"}.
    4.35  
    4.36      \item[@{text "Code_Char_chr"}] like @{text "Code_Char"}, but
    4.37         also offers treatment of character codes; includes @{text
    4.38 @@ -141,10 +160,8 @@
    4.39         @{const "Suc"} is eliminated; includes @{text "Code_Integer"}
    4.40         and @{text "Code_Numeral"}.
    4.41  
    4.42 -    \item[@{theory "Code_Numeral"}] provides an additional datatype
    4.43 -       @{typ index} which is mapped to target-language built-in
    4.44 -       integers.  Useful for code setups which involve e.g.~indexing
    4.45 -       of target-language arrays.  Part of @{text "HOL-Main"}.
    4.46 +    \item[@{text "Code_Char"}] represents @{text HOL} characters by
    4.47 +       character literals in target languages.
    4.48  
    4.49      \item[@{theory "String"}] provides an additional datatype @{typ
    4.50         String.literal} which is isomorphic to strings; @{typ
     5.1 --- a/src/Doc/Codegen/Foundations.thy	Fri Feb 15 08:31:30 2013 +0100
     5.2 +++ b/src/Doc/Codegen/Foundations.thy	Fri Feb 15 08:31:31 2013 +0100
     5.3 @@ -117,7 +117,7 @@
     5.4    interface, transforming a list of function theorems to another list
     5.5    of function theorems, provided that neither the heading constant nor
     5.6    its type change.  The @{term "0\<Colon>nat"} / @{const Suc} pattern
     5.7 -  elimination implemented in theory @{text Efficient_Nat} (see
     5.8 +  elimination implemented in theory @{text Code_Binary_Nat} (see
     5.9    \secref{eff_nat}) uses this interface.
    5.10  
    5.11    \noindent The current setup of the preprocessor may be inspected
     6.1 --- a/src/HOL/Code_Evaluation.thy	Fri Feb 15 08:31:30 2013 +0100
     6.2 +++ b/src/HOL/Code_Evaluation.thy	Fri Feb 15 08:31:31 2013 +0100
     6.3 @@ -158,10 +158,16 @@
     6.4      else termify (numeral :: num \<Rightarrow> nat) <\<cdot>> term_of_num_semiring (2::nat) n)"
     6.5    by (simp only: term_of_anything)
     6.6  
     6.7 -lemma (in term_syntax) term_of_code_numeral_code [code]:
     6.8 -  "term_of (k::code_numeral) = (
     6.9 -    if k = 0 then termify (0 :: code_numeral)
    6.10 -    else termify (numeral :: num \<Rightarrow> code_numeral) <\<cdot>> term_of_num_semiring (2::code_numeral) k)"
    6.11 +lemma (in term_syntax) term_of_natural_code [code]:
    6.12 +  "term_of (k::natural) = (
    6.13 +    if k = 0 then termify (0 :: natural)
    6.14 +    else termify (numeral :: num \<Rightarrow> natural) <\<cdot>> term_of_num_semiring (2::natural) k)"
    6.15 +  by (simp only: term_of_anything)
    6.16 +
    6.17 +lemma (in term_syntax) term_of_integer_code [code]:
    6.18 +  "term_of (k::integer) = (if k = 0 then termify (0 :: integer)
    6.19 +    else if k < 0 then termify (neg_numeral :: num \<Rightarrow> integer) <\<cdot>> term_of_num_semiring (2::integer) (- k)
    6.20 +    else termify (numeral :: num \<Rightarrow> integer) <\<cdot>> term_of_num_semiring (2::integer) k)"
    6.21    by (simp only: term_of_anything)
    6.22  
    6.23  lemma (in term_syntax) term_of_int_code [code]:
    6.24 @@ -199,3 +205,4 @@
    6.25  hide_const (open) Const App Abs Free termify valtermify term_of term_of_num_semiring tracing
    6.26  
    6.27  end
    6.28 +
     7.1 --- a/src/HOL/Code_Numeral.thy	Fri Feb 15 08:31:30 2013 +0100
     7.2 +++ b/src/HOL/Code_Numeral.thy	Fri Feb 15 08:31:31 2013 +0100
     7.3 @@ -1,337 +1,614 @@
     7.4 -(* Author: Florian Haftmann, TU Muenchen *)
     7.5 +(*  Title:      HOL/Code_Numeral.thy
     7.6 +    Author:     Florian Haftmann, TU Muenchen
     7.7 +*)
     7.8  
     7.9 -header {* Type of target language numerals *}
    7.10 +header {* Numeric types for code generation onto target language numerals only *}
    7.11  
    7.12  theory Code_Numeral
    7.13 -imports Nat_Transfer Divides
    7.14 +imports Nat_Transfer Divides Lifting
    7.15 +begin
    7.16 +
    7.17 +subsection {* Type of target language integers *}
    7.18 +
    7.19 +typedef integer = "UNIV \<Colon> int set"
    7.20 +  morphisms int_of_integer integer_of_int ..
    7.21 +
    7.22 +setup_lifting (no_code) type_definition_integer
    7.23 +
    7.24 +lemma integer_eq_iff:
    7.25 +  "k = l \<longleftrightarrow> int_of_integer k = int_of_integer l"
    7.26 +  by transfer rule
    7.27 +
    7.28 +lemma integer_eqI:
    7.29 +  "int_of_integer k = int_of_integer l \<Longrightarrow> k = l"
    7.30 +  using integer_eq_iff [of k l] by simp
    7.31 +
    7.32 +lemma int_of_integer_integer_of_int [simp]:
    7.33 +  "int_of_integer (integer_of_int k) = k"
    7.34 +  by transfer rule
    7.35 +
    7.36 +lemma integer_of_int_int_of_integer [simp]:
    7.37 +  "integer_of_int (int_of_integer k) = k"
    7.38 +  by transfer rule
    7.39 +
    7.40 +instantiation integer :: ring_1
    7.41  begin
    7.42  
    7.43 -text {*
    7.44 -  Code numerals are isomorphic to HOL @{typ nat} but
    7.45 -  mapped to target-language builtin numerals.
    7.46 -*}
    7.47 +lift_definition zero_integer :: integer
    7.48 +  is "0 :: int"
    7.49 +  .
    7.50 +
    7.51 +declare zero_integer.rep_eq [simp]
    7.52  
    7.53 -subsection {* Datatype of target language numerals *}
    7.54 +lift_definition one_integer :: integer
    7.55 +  is "1 :: int"
    7.56 +  .
    7.57 +
    7.58 +declare one_integer.rep_eq [simp]
    7.59  
    7.60 -typedef code_numeral = "UNIV \<Colon> nat set"
    7.61 -  morphisms nat_of of_nat ..
    7.62 +lift_definition plus_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
    7.63 +  is "plus :: int \<Rightarrow> int \<Rightarrow> int"
    7.64 +  .
    7.65 +
    7.66 +declare plus_integer.rep_eq [simp]
    7.67  
    7.68 -lemma of_nat_nat_of [simp]:
    7.69 -  "of_nat (nat_of k) = k"
    7.70 -  by (rule nat_of_inverse)
    7.71 +lift_definition uminus_integer :: "integer \<Rightarrow> integer"
    7.72 +  is "uminus :: int \<Rightarrow> int"
    7.73 +  .
    7.74 +
    7.75 +declare uminus_integer.rep_eq [simp]
    7.76  
    7.77 -lemma nat_of_of_nat [simp]:
    7.78 -  "nat_of (of_nat n) = n"
    7.79 -  by (rule of_nat_inverse) (rule UNIV_I)
    7.80 +lift_definition minus_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
    7.81 +  is "minus :: int \<Rightarrow> int \<Rightarrow> int"
    7.82 +  .
    7.83 +
    7.84 +declare minus_integer.rep_eq [simp]
    7.85  
    7.86 -lemma [measure_function]:
    7.87 -  "is_measure nat_of" by (rule is_measure_trivial)
    7.88 +lift_definition times_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
    7.89 +  is "times :: int \<Rightarrow> int \<Rightarrow> int"
    7.90 +  .
    7.91 +
    7.92 +declare times_integer.rep_eq [simp]
    7.93  
    7.94 -lemma code_numeral:
    7.95 -  "(\<And>n\<Colon>code_numeral. PROP P n) \<equiv> (\<And>n\<Colon>nat. PROP P (of_nat n))"
    7.96 -proof
    7.97 -  fix n :: nat
    7.98 -  assume "\<And>n\<Colon>code_numeral. PROP P n"
    7.99 -  then show "PROP P (of_nat n)" .
   7.100 -next
   7.101 -  fix n :: code_numeral
   7.102 -  assume "\<And>n\<Colon>nat. PROP P (of_nat n)"
   7.103 -  then have "PROP P (of_nat (nat_of n))" .
   7.104 -  then show "PROP P n" by simp
   7.105 +instance proof
   7.106 +qed (transfer, simp add: algebra_simps)+
   7.107 +
   7.108 +end
   7.109 +
   7.110 +lemma [transfer_rule]:
   7.111 +  "fun_rel HOL.eq cr_integer (of_nat :: nat \<Rightarrow> int) (of_nat :: nat \<Rightarrow> integer)"
   7.112 +  by (unfold of_nat_def [abs_def])  transfer_prover
   7.113 +
   7.114 +lemma [transfer_rule]:
   7.115 +  "fun_rel HOL.eq cr_integer (\<lambda>k :: int. k :: int) (of_int :: int \<Rightarrow> integer)"
   7.116 +proof -
   7.117 +  have "fun_rel HOL.eq cr_integer (of_int :: int \<Rightarrow> int) (of_int :: int \<Rightarrow> integer)"
   7.118 +    by (unfold of_int_of_nat [abs_def]) transfer_prover
   7.119 +  then show ?thesis by (simp add: id_def)
   7.120  qed
   7.121  
   7.122 -lemma code_numeral_case:
   7.123 -  assumes "\<And>n. k = of_nat n \<Longrightarrow> P"
   7.124 -  shows P
   7.125 -  by (rule assms [of "nat_of k"]) simp
   7.126 -
   7.127 -lemma code_numeral_induct_raw:
   7.128 -  assumes "\<And>n. P (of_nat n)"
   7.129 -  shows "P k"
   7.130 +lemma [transfer_rule]:
   7.131 +  "fun_rel HOL.eq cr_integer (numeral :: num \<Rightarrow> int) (numeral :: num \<Rightarrow> integer)"
   7.132  proof -
   7.133 -  from assms have "P (of_nat (nat_of k))" .
   7.134 +  have "fun_rel HOL.eq cr_integer (numeral :: num \<Rightarrow> int) (\<lambda>n. of_int (numeral n))"
   7.135 +    by transfer_prover
   7.136    then show ?thesis by simp
   7.137  qed
   7.138  
   7.139 -lemma nat_of_inject [simp]:
   7.140 -  "nat_of k = nat_of l \<longleftrightarrow> k = l"
   7.141 -  by (rule nat_of_inject)
   7.142 +lemma [transfer_rule]:
   7.143 +  "fun_rel HOL.eq cr_integer (neg_numeral :: num \<Rightarrow> int) (neg_numeral :: num \<Rightarrow> integer)"
   7.144 +  by (unfold neg_numeral_def [abs_def]) transfer_prover
   7.145 +
   7.146 +lemma [transfer_rule]:
   7.147 +  "fun_rel HOL.eq (fun_rel HOL.eq cr_integer) (Num.sub :: _ \<Rightarrow> _ \<Rightarrow> int) (Num.sub :: _ \<Rightarrow> _ \<Rightarrow> integer)"
   7.148 +  by (unfold Num.sub_def [abs_def]) transfer_prover
   7.149 +
   7.150 +lemma int_of_integer_of_nat [simp]:
   7.151 +  "int_of_integer (of_nat n) = of_nat n"
   7.152 +  by transfer rule
   7.153 +
   7.154 +lift_definition integer_of_nat :: "nat \<Rightarrow> integer"
   7.155 +  is "of_nat :: nat \<Rightarrow> int"
   7.156 +  .
   7.157 +
   7.158 +lemma integer_of_nat_eq_of_nat [code]:
   7.159 +  "integer_of_nat = of_nat"
   7.160 +  by transfer rule
   7.161 +
   7.162 +lemma int_of_integer_integer_of_nat [simp]:
   7.163 +  "int_of_integer (integer_of_nat n) = of_nat n"
   7.164 +  by transfer rule
   7.165 +
   7.166 +lift_definition nat_of_integer :: "integer \<Rightarrow> nat"
   7.167 +  is Int.nat
   7.168 +  .
   7.169  
   7.170 -lemma of_nat_inject [simp]:
   7.171 -  "of_nat n = of_nat m \<longleftrightarrow> n = m"
   7.172 -  by (rule of_nat_inject) (rule UNIV_I)+
   7.173 +lemma nat_of_integer_of_nat [simp]:
   7.174 +  "nat_of_integer (of_nat n) = n"
   7.175 +  by transfer simp
   7.176 +
   7.177 +lemma int_of_integer_of_int [simp]:
   7.178 +  "int_of_integer (of_int k) = k"
   7.179 +  by transfer simp
   7.180 +
   7.181 +lemma nat_of_integer_integer_of_nat [simp]:
   7.182 +  "nat_of_integer (integer_of_nat n) = n"
   7.183 +  by transfer simp
   7.184 +
   7.185 +lemma integer_of_int_eq_of_int [simp, code_abbrev]:
   7.186 +  "integer_of_int = of_int"
   7.187 +  by transfer (simp add: fun_eq_iff)
   7.188  
   7.189 -instantiation code_numeral :: zero
   7.190 +lemma of_int_integer_of [simp]:
   7.191 +  "of_int (int_of_integer k) = (k :: integer)"
   7.192 +  by transfer rule
   7.193 +
   7.194 +lemma int_of_integer_numeral [simp]:
   7.195 +  "int_of_integer (numeral k) = numeral k"
   7.196 +  by transfer rule
   7.197 +
   7.198 +lemma int_of_integer_neg_numeral [simp]:
   7.199 +  "int_of_integer (neg_numeral k) = neg_numeral k"
   7.200 +  by transfer rule
   7.201 +
   7.202 +lemma int_of_integer_sub [simp]:
   7.203 +  "int_of_integer (Num.sub k l) = Num.sub k l"
   7.204 +  by transfer rule
   7.205 +
   7.206 +instantiation integer :: "{ring_div, equal, linordered_idom}"
   7.207  begin
   7.208  
   7.209 -definition [simp, code del]:
   7.210 -  "0 = of_nat 0"
   7.211 +lift_definition div_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
   7.212 +  is "Divides.div :: int \<Rightarrow> int \<Rightarrow> int"
   7.213 +  .
   7.214 +
   7.215 +declare div_integer.rep_eq [simp]
   7.216 +
   7.217 +lift_definition mod_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
   7.218 +  is "Divides.mod :: int \<Rightarrow> int \<Rightarrow> int"
   7.219 +  .
   7.220 +
   7.221 +declare mod_integer.rep_eq [simp]
   7.222 +
   7.223 +lift_definition abs_integer :: "integer \<Rightarrow> integer"
   7.224 +  is "abs :: int \<Rightarrow> int"
   7.225 +  .
   7.226 +
   7.227 +declare abs_integer.rep_eq [simp]
   7.228  
   7.229 -instance ..
   7.230 +lift_definition sgn_integer :: "integer \<Rightarrow> integer"
   7.231 +  is "sgn :: int \<Rightarrow> int"
   7.232 +  .
   7.233 +
   7.234 +declare sgn_integer.rep_eq [simp]
   7.235 +
   7.236 +lift_definition less_eq_integer :: "integer \<Rightarrow> integer \<Rightarrow> bool"
   7.237 +  is "less_eq :: int \<Rightarrow> int \<Rightarrow> bool"
   7.238 +  .
   7.239 +
   7.240 +lift_definition less_integer :: "integer \<Rightarrow> integer \<Rightarrow> bool"
   7.241 +  is "less :: int \<Rightarrow> int \<Rightarrow> bool"
   7.242 +  .
   7.243 +
   7.244 +lift_definition equal_integer :: "integer \<Rightarrow> integer \<Rightarrow> bool"
   7.245 +  is "HOL.equal :: int \<Rightarrow> int \<Rightarrow> bool"
   7.246 +  .
   7.247 +
   7.248 +instance proof
   7.249 +qed (transfer, simp add: algebra_simps equal less_le_not_le [symmetric] mult_strict_right_mono linear)+
   7.250  
   7.251  end
   7.252  
   7.253 -definition Suc where [simp]:
   7.254 -  "Suc k = of_nat (Nat.Suc (nat_of k))"
   7.255 +lemma [transfer_rule]:
   7.256 +  "fun_rel cr_integer (fun_rel cr_integer cr_integer) (min :: _ \<Rightarrow> _ \<Rightarrow> int) (min :: _ \<Rightarrow> _ \<Rightarrow> integer)"
   7.257 +  by (unfold min_def [abs_def]) transfer_prover
   7.258 +
   7.259 +lemma [transfer_rule]:
   7.260 +  "fun_rel cr_integer (fun_rel cr_integer cr_integer) (max :: _ \<Rightarrow> _ \<Rightarrow> int) (max :: _ \<Rightarrow> _ \<Rightarrow> integer)"
   7.261 +  by (unfold max_def [abs_def]) transfer_prover
   7.262 +
   7.263 +lemma int_of_integer_min [simp]:
   7.264 +  "int_of_integer (min k l) = min (int_of_integer k) (int_of_integer l)"
   7.265 +  by transfer rule
   7.266 +
   7.267 +lemma int_of_integer_max [simp]:
   7.268 +  "int_of_integer (max k l) = max (int_of_integer k) (int_of_integer l)"
   7.269 +  by transfer rule
   7.270  
   7.271 -rep_datatype "0 \<Colon> code_numeral" Suc
   7.272 -proof -
   7.273 -  fix P :: "code_numeral \<Rightarrow> bool"
   7.274 -  fix k :: code_numeral
   7.275 -  assume "P 0" then have init: "P (of_nat 0)" by simp
   7.276 -  assume "\<And>k. P k \<Longrightarrow> P (Suc k)"
   7.277 -    then have "\<And>n. P (of_nat n) \<Longrightarrow> P (Suc (of_nat n))" .
   7.278 -    then have step: "\<And>n. P (of_nat n) \<Longrightarrow> P (of_nat (Nat.Suc n))" by simp
   7.279 -  from init step have "P (of_nat (nat_of k))"
   7.280 -    by (induct ("nat_of k")) simp_all
   7.281 -  then show "P k" by simp
   7.282 -qed simp_all
   7.283 +lemma nat_of_integer_non_positive [simp]:
   7.284 +  "k \<le> 0 \<Longrightarrow> nat_of_integer k = 0"
   7.285 +  by transfer simp
   7.286 +
   7.287 +lemma of_nat_of_integer [simp]:
   7.288 +  "of_nat (nat_of_integer k) = max 0 k"
   7.289 +  by transfer auto
   7.290 +
   7.291  
   7.292 -declare code_numeral_case [case_names nat, cases type: code_numeral]
   7.293 -declare code_numeral.induct [case_names nat, induct type: code_numeral]
   7.294 +subsection {* Code theorems for target language integers *}
   7.295 +
   7.296 +text {* Constructors *}
   7.297  
   7.298 -lemma code_numeral_decr [termination_simp]:
   7.299 -  "k \<noteq> of_nat 0 \<Longrightarrow> nat_of k - Nat.Suc 0 < nat_of k"
   7.300 -  by (cases k) simp
   7.301 +definition Pos :: "num \<Rightarrow> integer"
   7.302 +where
   7.303 +  [simp, code_abbrev]: "Pos = numeral"
   7.304 +
   7.305 +lemma [transfer_rule]:
   7.306 +  "fun_rel HOL.eq cr_integer numeral Pos"
   7.307 +  by simp transfer_prover
   7.308  
   7.309 -lemma [simp, code]:
   7.310 -  "code_numeral_size = nat_of"
   7.311 -proof (rule ext)
   7.312 -  fix k
   7.313 -  have "code_numeral_size k = nat_size (nat_of k)"
   7.314 -    by (induct k rule: code_numeral.induct) (simp_all del: zero_code_numeral_def Suc_def, simp_all)
   7.315 -  also have "nat_size (nat_of k) = nat_of k" by (induct ("nat_of k")) simp_all
   7.316 -  finally show "code_numeral_size k = nat_of k" .
   7.317 -qed
   7.318 +definition Neg :: "num \<Rightarrow> integer"
   7.319 +where
   7.320 +  [simp, code_abbrev]: "Neg = neg_numeral"
   7.321 +
   7.322 +lemma [transfer_rule]:
   7.323 +  "fun_rel HOL.eq cr_integer neg_numeral Neg"
   7.324 +  by simp transfer_prover
   7.325 +
   7.326 +code_datatype "0::integer" Pos Neg
   7.327 +
   7.328 +
   7.329 +text {* Auxiliary operations *}
   7.330 +
   7.331 +lift_definition dup :: "integer \<Rightarrow> integer"
   7.332 +  is "\<lambda>k::int. k + k"
   7.333 +  .
   7.334  
   7.335 -lemma [simp, code]:
   7.336 -  "size = nat_of"
   7.337 -proof (rule ext)
   7.338 -  fix k
   7.339 -  show "size k = nat_of k"
   7.340 -  by (induct k) (simp_all del: zero_code_numeral_def Suc_def, simp_all)
   7.341 -qed
   7.342 +lemma dup_code [code]:
   7.343 +  "dup 0 = 0"
   7.344 +  "dup (Pos n) = Pos (Num.Bit0 n)"
   7.345 +  "dup (Neg n) = Neg (Num.Bit0 n)"
   7.346 +  by (transfer, simp only: neg_numeral_def numeral_Bit0 minus_add_distrib)+
   7.347 +
   7.348 +lift_definition sub :: "num \<Rightarrow> num \<Rightarrow> integer"
   7.349 +  is "\<lambda>m n. numeral m - numeral n :: int"
   7.350 +  .
   7.351  
   7.352 -lemmas [code del] = code_numeral.recs code_numeral.cases
   7.353 -
   7.354 -lemma [code]:
   7.355 -  "HOL.equal k l \<longleftrightarrow> HOL.equal (nat_of k) (nat_of l)"
   7.356 -  by (cases k, cases l) (simp add: equal)
   7.357 -
   7.358 -lemma [code nbe]:
   7.359 -  "HOL.equal (k::code_numeral) k \<longleftrightarrow> True"
   7.360 -  by (rule equal_refl)
   7.361 +lemma sub_code [code]:
   7.362 +  "sub Num.One Num.One = 0"
   7.363 +  "sub (Num.Bit0 m) Num.One = Pos (Num.BitM m)"
   7.364 +  "sub (Num.Bit1 m) Num.One = Pos (Num.Bit0 m)"
   7.365 +  "sub Num.One (Num.Bit0 n) = Neg (Num.BitM n)"
   7.366 +  "sub Num.One (Num.Bit1 n) = Neg (Num.Bit0 n)"
   7.367 +  "sub (Num.Bit0 m) (Num.Bit0 n) = dup (sub m n)"
   7.368 +  "sub (Num.Bit1 m) (Num.Bit1 n) = dup (sub m n)"
   7.369 +  "sub (Num.Bit1 m) (Num.Bit0 n) = dup (sub m n) + 1"
   7.370 +  "sub (Num.Bit0 m) (Num.Bit1 n) = dup (sub m n) - 1"
   7.371 +  by (transfer, simp add: dbl_def dbl_inc_def dbl_dec_def)+
   7.372  
   7.373  
   7.374 -subsection {* Basic arithmetic *}
   7.375 +text {* Implementations *}
   7.376  
   7.377 -instantiation code_numeral :: "{minus, linordered_semidom, semiring_div, linorder}"
   7.378 -begin
   7.379 -
   7.380 -definition [simp, code del]:
   7.381 -  "(1\<Colon>code_numeral) = of_nat 1"
   7.382 +lemma one_integer_code [code, code_unfold]:
   7.383 +  "1 = Pos Num.One"
   7.384 +  by simp
   7.385  
   7.386 -definition [simp, code del]:
   7.387 -  "n + m = of_nat (nat_of n + nat_of m)"
   7.388 -
   7.389 -definition [simp, code del]:
   7.390 -  "n - m = of_nat (nat_of n - nat_of m)"
   7.391 -
   7.392 -definition [simp, code del]:
   7.393 -  "n * m = of_nat (nat_of n * nat_of m)"
   7.394 -
   7.395 -definition [simp, code del]:
   7.396 -  "n div m = of_nat (nat_of n div nat_of m)"
   7.397 +lemma plus_integer_code [code]:
   7.398 +  "k + 0 = (k::integer)"
   7.399 +  "0 + l = (l::integer)"
   7.400 +  "Pos m + Pos n = Pos (m + n)"
   7.401 +  "Pos m + Neg n = sub m n"
   7.402 +  "Neg m + Pos n = sub n m"
   7.403 +  "Neg m + Neg n = Neg (m + n)"
   7.404 +  by (transfer, simp)+
   7.405  
   7.406 -definition [simp, code del]:
   7.407 -  "n mod m = of_nat (nat_of n mod nat_of m)"
   7.408 -
   7.409 -definition [simp, code del]:
   7.410 -  "n \<le> m \<longleftrightarrow> nat_of n \<le> nat_of m"
   7.411 -
   7.412 -definition [simp, code del]:
   7.413 -  "n < m \<longleftrightarrow> nat_of n < nat_of m"
   7.414 -
   7.415 -instance proof
   7.416 -qed (auto simp add: code_numeral distrib_right intro: mult_commute)
   7.417 +lemma uminus_integer_code [code]:
   7.418 +  "uminus 0 = (0::integer)"
   7.419 +  "uminus (Pos m) = Neg m"
   7.420 +  "uminus (Neg m) = Pos m"
   7.421 +  by simp_all
   7.422  
   7.423 -end
   7.424 -
   7.425 -lemma nat_of_numeral [simp]: "nat_of (numeral k) = numeral k"
   7.426 -  by (induct k rule: num_induct) (simp_all add: numeral_inc)
   7.427 +lemma minus_integer_code [code]:
   7.428 +  "k - 0 = (k::integer)"
   7.429 +  "0 - l = uminus (l::integer)"
   7.430 +  "Pos m - Pos n = sub m n"
   7.431 +  "Pos m - Neg n = Pos (m + n)"
   7.432 +  "Neg m - Pos n = Neg (m + n)"
   7.433 +  "Neg m - Neg n = sub n m"
   7.434 +  by (transfer, simp)+
   7.435  
   7.436 -definition Num :: "num \<Rightarrow> code_numeral"
   7.437 -  where [simp, code_abbrev]: "Num = numeral"
   7.438 +lemma abs_integer_code [code]:
   7.439 +  "\<bar>k\<bar> = (if (k::integer) < 0 then - k else k)"
   7.440 +  by simp
   7.441  
   7.442 -code_datatype "0::code_numeral" Num
   7.443 -
   7.444 -lemma one_code_numeral_code [code]:
   7.445 -  "(1\<Colon>code_numeral) = Numeral1"
   7.446 +lemma sgn_integer_code [code]:
   7.447 +  "sgn k = (if k = 0 then 0 else if (k::integer) < 0 then - 1 else 1)"
   7.448    by simp
   7.449  
   7.450 -lemma [code_abbrev]: "Numeral1 = (1\<Colon>code_numeral)"
   7.451 -  using one_code_numeral_code ..
   7.452 +lemma times_integer_code [code]:
   7.453 +  "k * 0 = (0::integer)"
   7.454 +  "0 * l = (0::integer)"
   7.455 +  "Pos m * Pos n = Pos (m * n)"
   7.456 +  "Pos m * Neg n = Neg (m * n)"
   7.457 +  "Neg m * Pos n = Neg (m * n)"
   7.458 +  "Neg m * Neg n = Pos (m * n)"
   7.459 +  by simp_all
   7.460 +
   7.461 +definition divmod_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer \<times> integer"
   7.462 +where
   7.463 +  "divmod_integer k l = (k div l, k mod l)"
   7.464 +
   7.465 +lemma fst_divmod [simp]:
   7.466 +  "fst (divmod_integer k l) = k div l"
   7.467 +  by (simp add: divmod_integer_def)
   7.468 +
   7.469 +lemma snd_divmod [simp]:
   7.470 +  "snd (divmod_integer k l) = k mod l"
   7.471 +  by (simp add: divmod_integer_def)
   7.472 +
   7.473 +definition divmod_abs :: "integer \<Rightarrow> integer \<Rightarrow> integer \<times> integer"
   7.474 +where
   7.475 +  "divmod_abs k l = (\<bar>k\<bar> div \<bar>l\<bar>, \<bar>k\<bar> mod \<bar>l\<bar>)"
   7.476 +
   7.477 +lemma fst_divmod_abs [simp]:
   7.478 +  "fst (divmod_abs k l) = \<bar>k\<bar> div \<bar>l\<bar>"
   7.479 +  by (simp add: divmod_abs_def)
   7.480 +
   7.481 +lemma snd_divmod_abs [simp]:
   7.482 +  "snd (divmod_abs k l) = \<bar>k\<bar> mod \<bar>l\<bar>"
   7.483 +  by (simp add: divmod_abs_def)
   7.484  
   7.485 -lemma plus_code_numeral_code [code nbe]:
   7.486 -  "of_nat n + of_nat m = of_nat (n + m)"
   7.487 -  by simp
   7.488 +lemma divmod_abs_terminate_code [code]:
   7.489 +  "divmod_abs (Neg k) (Neg l) = divmod_abs (Pos k) (Pos l)"
   7.490 +  "divmod_abs (Neg k) (Pos l) = divmod_abs (Pos k) (Pos l)"
   7.491 +  "divmod_abs (Pos k) (Neg l) = divmod_abs (Pos k) (Pos l)"
   7.492 +  "divmod_abs j 0 = (0, \<bar>j\<bar>)"
   7.493 +  "divmod_abs 0 j = (0, 0)"
   7.494 +  by (simp_all add: prod_eq_iff)
   7.495 +
   7.496 +lemma divmod_abs_rec_code [code]:
   7.497 +  "divmod_abs (Pos k) (Pos l) =
   7.498 +    (let j = sub k l in
   7.499 +       if j < 0 then (0, Pos k)
   7.500 +       else let (q, r) = divmod_abs j (Pos l) in (q + 1, r))"
   7.501 +  apply (simp add: prod_eq_iff Let_def prod_case_beta)
   7.502 +  apply transfer
   7.503 +  apply (simp add: sub_non_negative sub_negative div_pos_pos_trivial mod_pos_pos_trivial div_pos_geq mod_pos_geq)
   7.504 +  done
   7.505  
   7.506 -lemma minus_code_numeral_code [code nbe]:
   7.507 -  "of_nat n - of_nat m = of_nat (n - m)"
   7.508 +lemma divmod_integer_code [code]:
   7.509 +  "divmod_integer k l =
   7.510 +    (if k = 0 then (0, 0) else if l = 0 then (0, k) else
   7.511 +    (apsnd \<circ> times \<circ> sgn) l (if sgn k = sgn l
   7.512 +      then divmod_abs k l
   7.513 +      else (let (r, s) = divmod_abs k l in
   7.514 +        if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
   7.515 +proof -
   7.516 +  have aux1: "\<And>k l::int. sgn k = sgn l \<longleftrightarrow> k = 0 \<and> l = 0 \<or> 0 < l \<and> 0 < k \<or> l < 0 \<and> k < 0"
   7.517 +    by (auto simp add: sgn_if)
   7.518 +  have aux2: "\<And>q::int. - int_of_integer k = int_of_integer l * q \<longleftrightarrow> int_of_integer k = int_of_integer l * - q" by auto
   7.519 +  show ?thesis
   7.520 +    by (simp add: prod_eq_iff integer_eq_iff prod_case_beta aux1)
   7.521 +      (auto simp add: zdiv_zminus1_eq_if zmod_zminus1_eq_if div_minus_right mod_minus_right aux2)
   7.522 +qed
   7.523 +
   7.524 +lemma div_integer_code [code]:
   7.525 +  "k div l = fst (divmod_integer k l)"
   7.526    by simp
   7.527  
   7.528 -lemma times_code_numeral_code [code nbe]:
   7.529 -  "of_nat n * of_nat m = of_nat (n * m)"
   7.530 -  by simp
   7.531 -
   7.532 -lemma less_eq_code_numeral_code [code nbe]:
   7.533 -  "of_nat n \<le> of_nat m \<longleftrightarrow> n \<le> m"
   7.534 -  by simp
   7.535 -
   7.536 -lemma less_code_numeral_code [code nbe]:
   7.537 -  "of_nat n < of_nat m \<longleftrightarrow> n < m"
   7.538 +lemma mod_integer_code [code]:
   7.539 +  "k mod l = snd (divmod_integer k l)"
   7.540    by simp
   7.541  
   7.542 -lemma code_numeral_zero_minus_one:
   7.543 -  "(0::code_numeral) - 1 = 0"
   7.544 -  by simp
   7.545 +lemma equal_integer_code [code]:
   7.546 +  "HOL.equal 0 (0::integer) \<longleftrightarrow> True"
   7.547 +  "HOL.equal 0 (Pos l) \<longleftrightarrow> False"
   7.548 +  "HOL.equal 0 (Neg l) \<longleftrightarrow> False"
   7.549 +  "HOL.equal (Pos k) 0 \<longleftrightarrow> False"
   7.550 +  "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l"
   7.551 +  "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False"
   7.552 +  "HOL.equal (Neg k) 0 \<longleftrightarrow> False"
   7.553 +  "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False"
   7.554 +  "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l"
   7.555 +  by (simp_all add: equal)
   7.556 +
   7.557 +lemma equal_integer_refl [code nbe]:
   7.558 +  "HOL.equal (k::integer) k \<longleftrightarrow> True"
   7.559 +  by (fact equal_refl)
   7.560  
   7.561 -lemma Suc_code_numeral_minus_one:
   7.562 -  "Suc n - 1 = n"
   7.563 -  by simp
   7.564 +lemma less_eq_integer_code [code]:
   7.565 +  "0 \<le> (0::integer) \<longleftrightarrow> True"
   7.566 +  "0 \<le> Pos l \<longleftrightarrow> True"
   7.567 +  "0 \<le> Neg l \<longleftrightarrow> False"
   7.568 +  "Pos k \<le> 0 \<longleftrightarrow> False"
   7.569 +  "Pos k \<le> Pos l \<longleftrightarrow> k \<le> l"
   7.570 +  "Pos k \<le> Neg l \<longleftrightarrow> False"
   7.571 +  "Neg k \<le> 0 \<longleftrightarrow> True"
   7.572 +  "Neg k \<le> Pos l \<longleftrightarrow> True"
   7.573 +  "Neg k \<le> Neg l \<longleftrightarrow> l \<le> k"
   7.574 +  by simp_all
   7.575 +
   7.576 +lemma less_integer_code [code]:
   7.577 +  "0 < (0::integer) \<longleftrightarrow> False"
   7.578 +  "0 < Pos l \<longleftrightarrow> True"
   7.579 +  "0 < Neg l \<longleftrightarrow> False"
   7.580 +  "Pos k < 0 \<longleftrightarrow> False"
   7.581 +  "Pos k < Pos l \<longleftrightarrow> k < l"
   7.582 +  "Pos k < Neg l \<longleftrightarrow> False"
   7.583 +  "Neg k < 0 \<longleftrightarrow> True"
   7.584 +  "Neg k < Pos l \<longleftrightarrow> True"
   7.585 +  "Neg k < Neg l \<longleftrightarrow> l < k"
   7.586 +  by simp_all
   7.587  
   7.588 -lemma of_nat_code [code]:
   7.589 -  "of_nat = Nat.of_nat"
   7.590 -proof
   7.591 -  fix n :: nat
   7.592 -  have "Nat.of_nat n = of_nat n"
   7.593 -    by (induct n) simp_all
   7.594 -  then show "of_nat n = Nat.of_nat n"
   7.595 -    by (rule sym)
   7.596 +lift_definition integer_of_num :: "num \<Rightarrow> integer"
   7.597 +  is "numeral :: num \<Rightarrow> int"
   7.598 +  .
   7.599 +
   7.600 +lemma integer_of_num [code]:
   7.601 +  "integer_of_num num.One = 1"
   7.602 +  "integer_of_num (num.Bit0 n) = (let k = integer_of_num n in k + k)"
   7.603 +  "integer_of_num (num.Bit1 n) = (let k = integer_of_num n in k + k + 1)"
   7.604 +  by (transfer, simp only: numeral.simps Let_def)+
   7.605 +
   7.606 +lift_definition num_of_integer :: "integer \<Rightarrow> num"
   7.607 +  is "num_of_nat \<circ> nat"
   7.608 +  .
   7.609 +
   7.610 +lemma num_of_integer_code [code]:
   7.611 +  "num_of_integer k = (if k \<le> 1 then Num.One
   7.612 +     else let
   7.613 +       (l, j) = divmod_integer k 2;
   7.614 +       l' = num_of_integer l;
   7.615 +       l'' = l' + l'
   7.616 +     in if j = 0 then l'' else l'' + Num.One)"
   7.617 +proof -
   7.618 +  {
   7.619 +    assume "int_of_integer k mod 2 = 1"
   7.620 +    then have "nat (int_of_integer k mod 2) = nat 1" by simp
   7.621 +    moreover assume *: "1 < int_of_integer k"
   7.622 +    ultimately have **: "nat (int_of_integer k) mod 2 = 1" by (simp add: nat_mod_distrib)
   7.623 +    have "num_of_nat (nat (int_of_integer k)) =
   7.624 +      num_of_nat (2 * (nat (int_of_integer k) div 2) + nat (int_of_integer k) mod 2)"
   7.625 +      by simp
   7.626 +    then have "num_of_nat (nat (int_of_integer k)) =
   7.627 +      num_of_nat (nat (int_of_integer k) div 2 + nat (int_of_integer k) div 2 + nat (int_of_integer k) mod 2)"
   7.628 +      by (simp add: mult_2)
   7.629 +    with ** have "num_of_nat (nat (int_of_integer k)) =
   7.630 +      num_of_nat (nat (int_of_integer k) div 2 + nat (int_of_integer k) div 2 + 1)"
   7.631 +      by simp
   7.632 +  }
   7.633 +  note aux = this
   7.634 +  show ?thesis
   7.635 +    by (auto simp add: num_of_integer_def nat_of_integer_def Let_def prod_case_beta
   7.636 +      not_le integer_eq_iff less_eq_integer_def
   7.637 +      nat_mult_distrib nat_div_distrib num_of_nat_One num_of_nat_plus_distrib
   7.638 +       mult_2 [where 'a=nat] aux add_One)
   7.639  qed
   7.640  
   7.641 -lemma code_numeral_not_eq_zero: "i \<noteq> of_nat 0 \<longleftrightarrow> i \<ge> 1"
   7.642 -  by (cases i) auto
   7.643 -
   7.644 -definition nat_of_aux :: "code_numeral \<Rightarrow> nat \<Rightarrow> nat" where
   7.645 -  "nat_of_aux i n = nat_of i + n"
   7.646 -
   7.647 -lemma nat_of_aux_code [code]:
   7.648 -  "nat_of_aux i n = (if i = 0 then n else nat_of_aux (i - 1) (Nat.Suc n))"
   7.649 -  by (auto simp add: nat_of_aux_def code_numeral_not_eq_zero)
   7.650 -
   7.651 -lemma nat_of_code [code]:
   7.652 -  "nat_of i = nat_of_aux i 0"
   7.653 -  by (simp add: nat_of_aux_def)
   7.654 -
   7.655 -definition div_mod :: "code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral \<times> code_numeral" where
   7.656 -  [code del]: "div_mod n m = (n div m, n mod m)"
   7.657 -
   7.658 -lemma [code]:
   7.659 -  "div_mod n m = (if m = 0 then (0, n) else (n div m, n mod m))"
   7.660 -  unfolding div_mod_def by auto
   7.661 -
   7.662 -lemma [code]:
   7.663 -  "n div m = fst (div_mod n m)"
   7.664 -  unfolding div_mod_def by simp
   7.665 -
   7.666 -lemma [code]:
   7.667 -  "n mod m = snd (div_mod n m)"
   7.668 -  unfolding div_mod_def by simp
   7.669 -
   7.670 -definition int_of :: "code_numeral \<Rightarrow> int" where
   7.671 -  "int_of = Nat.of_nat o nat_of"
   7.672 -
   7.673 -lemma int_of_code [code]:
   7.674 -  "int_of k = (if k = 0 then 0
   7.675 -    else (if k mod 2 = 0 then 2 * int_of (k div 2) else 2 * int_of (k div 2) + 1))"
   7.676 +lemma nat_of_integer_code [code]:
   7.677 +  "nat_of_integer k = (if k \<le> 0 then 0
   7.678 +     else let
   7.679 +       (l, j) = divmod_integer k 2;
   7.680 +       l' = nat_of_integer l;
   7.681 +       l'' = l' + l'
   7.682 +     in if j = 0 then l'' else l'' + 1)"
   7.683  proof -
   7.684 -  have "(nat_of k div 2) * 2 + nat_of k mod 2 = nat_of k" 
   7.685 -    by (rule mod_div_equality)
   7.686 -  then have "int ((nat_of k div 2) * 2 + nat_of k mod 2) = int (nat_of k)" 
   7.687 -    by simp
   7.688 -  then have "int (nat_of k) = int (nat_of k div 2) * 2 + int (nat_of k mod 2)" 
   7.689 -    unfolding of_nat_mult of_nat_add by simp
   7.690 -  then show ?thesis by (auto simp add: int_of_def mult_ac)
   7.691 +  obtain j where "k = integer_of_int j"
   7.692 +  proof
   7.693 +    show "k = integer_of_int (int_of_integer k)" by simp
   7.694 +  qed
   7.695 +  moreover have "2 * (j div 2) = j - j mod 2"
   7.696 +    by (simp add: zmult_div_cancel mult_commute)
   7.697 +  ultimately show ?thesis
   7.698 +    by (auto simp add: split_def Let_def mod_integer_def nat_of_integer_def not_le
   7.699 +      nat_add_distrib [symmetric] Suc_nat_eq_nat_zadd1)
   7.700 +      (auto simp add: mult_2 [symmetric])
   7.701  qed
   7.702  
   7.703 +lemma int_of_integer_code [code]:
   7.704 +  "int_of_integer k = (if k < 0 then - (int_of_integer (- k))
   7.705 +     else if k = 0 then 0
   7.706 +     else let
   7.707 +       (l, j) = divmod_integer k 2;
   7.708 +       l' = 2 * int_of_integer l
   7.709 +     in if j = 0 then l' else l' + 1)"
   7.710 +  by (auto simp add: split_def Let_def integer_eq_iff zmult_div_cancel)
   7.711  
   7.712 -hide_const (open) of_nat nat_of Suc int_of
   7.713 +lemma integer_of_int_code [code]:
   7.714 +  "integer_of_int k = (if k < 0 then - (integer_of_int (- k))
   7.715 +     else if k = 0 then 0
   7.716 +     else let
   7.717 +       (l, j) = divmod_int k 2;
   7.718 +       l' = 2 * integer_of_int l
   7.719 +     in if j = 0 then l' else l' + 1)"
   7.720 +  by (auto simp add: split_def Let_def integer_eq_iff zmult_div_cancel)
   7.721 +
   7.722 +hide_const (open) Pos Neg sub dup divmod_abs
   7.723  
   7.724  
   7.725 -subsection {* Code generator setup *}
   7.726 +subsection {* Serializer setup for target language integers *}
   7.727  
   7.728 -text {* Implementation of code numerals by bounded integers *}
   7.729 +code_reserved Eval int Integer abs
   7.730  
   7.731 -code_type code_numeral
   7.732 -  (SML "int")
   7.733 +code_type integer
   7.734 +  (SML "IntInf.int")
   7.735    (OCaml "Big'_int.big'_int")
   7.736    (Haskell "Integer")
   7.737    (Scala "BigInt")
   7.738 +  (Eval "int")
   7.739  
   7.740 -code_instance code_numeral :: equal
   7.741 +code_instance integer :: equal
   7.742    (Haskell -)
   7.743  
   7.744 -setup {*
   7.745 -  Numeral.add_code @{const_name Num}
   7.746 -    false Code_Printer.literal_naive_numeral "SML"
   7.747 -  #> fold (Numeral.add_code @{const_name Num}
   7.748 -    false Code_Printer.literal_numeral) ["OCaml", "Haskell", "Scala"]
   7.749 -*}
   7.750 -
   7.751 -code_reserved SML Int int
   7.752 -code_reserved Eval Integer
   7.753 -
   7.754 -code_const "0::code_numeral"
   7.755 +code_const "0::integer"
   7.756    (SML "0")
   7.757    (OCaml "Big'_int.zero'_big'_int")
   7.758    (Haskell "0")
   7.759    (Scala "BigInt(0)")
   7.760  
   7.761 -code_const "plus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   7.762 -  (SML "Int.+/ ((_),/ (_))")
   7.763 +setup {*
   7.764 +  fold (Numeral.add_code @{const_name Code_Numeral.Pos}
   7.765 +    false Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
   7.766 +*}
   7.767 +
   7.768 +setup {*
   7.769 +  fold (Numeral.add_code @{const_name Code_Numeral.Neg}
   7.770 +    true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
   7.771 +*}
   7.772 +
   7.773 +code_const "plus :: integer \<Rightarrow> _ \<Rightarrow> _"
   7.774 +  (SML "IntInf.+ ((_), (_))")
   7.775    (OCaml "Big'_int.add'_big'_int")
   7.776    (Haskell infixl 6 "+")
   7.777    (Scala infixl 7 "+")
   7.778    (Eval infixl 8 "+")
   7.779  
   7.780 -code_const "minus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   7.781 -  (SML "Int.max/ (0 : int,/ Int.-/ ((_),/ (_)))")
   7.782 -  (OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int/ (Big'_int.sub'_big'_int/ _/ _)")
   7.783 -  (Haskell "Prelude.max/ (0 :: Integer)/ (_/ -/ _)")
   7.784 -  (Scala "!(_/ -/ _).max(0)")
   7.785 -  (Eval "Integer.max/ 0/ (_/ -/ _)")
   7.786 +code_const "uminus :: integer \<Rightarrow> _"
   7.787 +  (SML "IntInf.~")
   7.788 +  (OCaml "Big'_int.minus'_big'_int")
   7.789 +  (Haskell "negate")
   7.790 +  (Scala "!(- _)")
   7.791 +  (Eval "~/ _")
   7.792 +
   7.793 +code_const "minus :: integer \<Rightarrow> _"
   7.794 +  (SML "IntInf.- ((_), (_))")
   7.795 +  (OCaml "Big'_int.sub'_big'_int")
   7.796 +  (Haskell infixl 6 "-")
   7.797 +  (Scala infixl 7 "-")
   7.798 +  (Eval infixl 8 "-")
   7.799  
   7.800 -code_const "times \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   7.801 -  (SML "Int.*/ ((_),/ (_))")
   7.802 +code_const Code_Numeral.dup
   7.803 +  (SML "IntInf.*/ (2,/ (_))")
   7.804 +  (OCaml "Big'_int.mult'_big'_int/ (Big'_int.big'_int'_of'_int/ 2)")
   7.805 +  (Haskell "!(2 * _)")
   7.806 +  (Scala "!(2 * _)")
   7.807 +  (Eval "!(2 * _)")
   7.808 +
   7.809 +code_const Code_Numeral.sub
   7.810 +  (SML "!(raise/ Fail/ \"sub\")")
   7.811 +  (OCaml "failwith/ \"sub\"")
   7.812 +  (Haskell "error/ \"sub\"")
   7.813 +  (Scala "!sys.error(\"sub\")")
   7.814 +
   7.815 +code_const "times :: integer \<Rightarrow> _ \<Rightarrow> _"
   7.816 +  (SML "IntInf.* ((_), (_))")
   7.817    (OCaml "Big'_int.mult'_big'_int")
   7.818    (Haskell infixl 7 "*")
   7.819    (Scala infixl 8 "*")
   7.820 -  (Eval infixl 8 "*")
   7.821 +  (Eval infixl 9 "*")
   7.822  
   7.823 -code_const Code_Numeral.div_mod
   7.824 -  (SML "!(fn n => fn m =>/ if m = 0/ then (0, n) else/ (Int.div (n, m), Int.mod (n, m)))")
   7.825 +code_const Code_Numeral.divmod_abs
   7.826 +  (SML "IntInf.divMod/ (IntInf.abs _,/ IntInf.abs _)")
   7.827    (OCaml "Big'_int.quomod'_big'_int/ (Big'_int.abs'_big'_int _)/ (Big'_int.abs'_big'_int _)")
   7.828 -  (Haskell "divMod")
   7.829 +  (Haskell "divMod/ (abs _)/ (abs _)")
   7.830    (Scala "!((k: BigInt) => (l: BigInt) =>/ if (l == 0)/ (BigInt(0), k) else/ (k.abs '/% l.abs))")
   7.831 -  (Eval "!(fn n => fn m =>/ if m = 0/ then (0, n) else/ (Integer.div'_mod n m))")
   7.832 +  (Eval "Integer.div'_mod/ (abs _)/ (abs _)")
   7.833  
   7.834 -code_const "HOL.equal \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   7.835 -  (SML "!((_ : Int.int) = _)")
   7.836 +code_const "HOL.equal :: integer \<Rightarrow> _ \<Rightarrow> bool"
   7.837 +  (SML "!((_ : IntInf.int) = _)")
   7.838    (OCaml "Big'_int.eq'_big'_int")
   7.839    (Haskell infix 4 "==")
   7.840    (Scala infixl 5 "==")
   7.841 -  (Eval "!((_ : int) = _)")
   7.842 +  (Eval infixl 6 "=")
   7.843  
   7.844 -code_const "less_eq \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   7.845 -  (SML "Int.<=/ ((_),/ (_))")
   7.846 +code_const "less_eq :: integer \<Rightarrow> _ \<Rightarrow> bool"
   7.847 +  (SML "IntInf.<= ((_), (_))")
   7.848    (OCaml "Big'_int.le'_big'_int")
   7.849    (Haskell infix 4 "<=")
   7.850    (Scala infixl 4 "<=")
   7.851    (Eval infixl 6 "<=")
   7.852  
   7.853 -code_const "less \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   7.854 -  (SML "Int.</ ((_),/ (_))")
   7.855 +code_const "less :: integer \<Rightarrow> _ \<Rightarrow> bool"
   7.856 +  (SML "IntInf.< ((_), (_))")
   7.857    (OCaml "Big'_int.lt'_big'_int")
   7.858    (Haskell infix 4 "<")
   7.859    (Scala infixl 4 "<")
   7.860 @@ -346,5 +623,321 @@
   7.861  code_modulename Haskell
   7.862    Code_Numeral Arith
   7.863  
   7.864 +
   7.865 +subsection {* Type of target language naturals *}
   7.866 +
   7.867 +typedef natural = "UNIV \<Colon> nat set"
   7.868 +  morphisms nat_of_natural natural_of_nat ..
   7.869 +
   7.870 +setup_lifting (no_code) type_definition_natural
   7.871 +
   7.872 +lemma natural_eq_iff [termination_simp]:
   7.873 +  "m = n \<longleftrightarrow> nat_of_natural m = nat_of_natural n"
   7.874 +  by transfer rule
   7.875 +
   7.876 +lemma natural_eqI:
   7.877 +  "nat_of_natural m = nat_of_natural n \<Longrightarrow> m = n"
   7.878 +  using natural_eq_iff [of m n] by simp
   7.879 +
   7.880 +lemma nat_of_natural_of_nat_inverse [simp]:
   7.881 +  "nat_of_natural (natural_of_nat n) = n"
   7.882 +  by transfer rule
   7.883 +
   7.884 +lemma natural_of_nat_of_natural_inverse [simp]:
   7.885 +  "natural_of_nat (nat_of_natural n) = n"
   7.886 +  by transfer rule
   7.887 +
   7.888 +instantiation natural :: "{comm_monoid_diff, semiring_1}"
   7.889 +begin
   7.890 +
   7.891 +lift_definition zero_natural :: natural
   7.892 +  is "0 :: nat"
   7.893 +  .
   7.894 +
   7.895 +declare zero_natural.rep_eq [simp]
   7.896 +
   7.897 +lift_definition one_natural :: natural
   7.898 +  is "1 :: nat"
   7.899 +  .
   7.900 +
   7.901 +declare one_natural.rep_eq [simp]
   7.902 +
   7.903 +lift_definition plus_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
   7.904 +  is "plus :: nat \<Rightarrow> nat \<Rightarrow> nat"
   7.905 +  .
   7.906 +
   7.907 +declare plus_natural.rep_eq [simp]
   7.908 +
   7.909 +lift_definition minus_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
   7.910 +  is "minus :: nat \<Rightarrow> nat \<Rightarrow> nat"
   7.911 +  .
   7.912 +
   7.913 +declare minus_natural.rep_eq [simp]
   7.914 +
   7.915 +lift_definition times_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
   7.916 +  is "times :: nat \<Rightarrow> nat \<Rightarrow> nat"
   7.917 +  .
   7.918 +
   7.919 +declare times_natural.rep_eq [simp]
   7.920 +
   7.921 +instance proof
   7.922 +qed (transfer, simp add: algebra_simps)+
   7.923 +
   7.924 +end
   7.925 +
   7.926 +lemma [transfer_rule]:
   7.927 +  "fun_rel HOL.eq cr_natural (\<lambda>n::nat. n) (of_nat :: nat \<Rightarrow> natural)"
   7.928 +proof -
   7.929 +  have "fun_rel HOL.eq cr_natural (of_nat :: nat \<Rightarrow> nat) (of_nat :: nat \<Rightarrow> natural)"
   7.930 +    by (unfold of_nat_def [abs_def]) transfer_prover
   7.931 +  then show ?thesis by (simp add: id_def)
   7.932 +qed
   7.933 +
   7.934 +lemma [transfer_rule]:
   7.935 +  "fun_rel HOL.eq cr_natural (numeral :: num \<Rightarrow> nat) (numeral :: num \<Rightarrow> natural)"
   7.936 +proof -
   7.937 +  have "fun_rel HOL.eq cr_natural (numeral :: num \<Rightarrow> nat) (\<lambda>n. of_nat (numeral n))"
   7.938 +    by transfer_prover
   7.939 +  then show ?thesis by simp
   7.940 +qed
   7.941 +
   7.942 +lemma nat_of_natural_of_nat [simp]:
   7.943 +  "nat_of_natural (of_nat n) = n"
   7.944 +  by transfer rule
   7.945 +
   7.946 +lemma natural_of_nat_of_nat [simp, code_abbrev]:
   7.947 +  "natural_of_nat = of_nat"
   7.948 +  by transfer rule
   7.949 +
   7.950 +lemma of_nat_of_natural [simp]:
   7.951 +  "of_nat (nat_of_natural n) = n"
   7.952 +  by transfer rule
   7.953 +
   7.954 +lemma nat_of_natural_numeral [simp]:
   7.955 +  "nat_of_natural (numeral k) = numeral k"
   7.956 +  by transfer rule
   7.957 +
   7.958 +instantiation natural :: "{semiring_div, equal, linordered_semiring}"
   7.959 +begin
   7.960 +
   7.961 +lift_definition div_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
   7.962 +  is "Divides.div :: nat \<Rightarrow> nat \<Rightarrow> nat"
   7.963 +  .
   7.964 +
   7.965 +declare div_natural.rep_eq [simp]
   7.966 +
   7.967 +lift_definition mod_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
   7.968 +  is "Divides.mod :: nat \<Rightarrow> nat \<Rightarrow> nat"
   7.969 +  .
   7.970 +
   7.971 +declare mod_natural.rep_eq [simp]
   7.972 +
   7.973 +lift_definition less_eq_natural :: "natural \<Rightarrow> natural \<Rightarrow> bool"
   7.974 +  is "less_eq :: nat \<Rightarrow> nat \<Rightarrow> bool"
   7.975 +  .
   7.976 +
   7.977 +declare less_eq_natural.rep_eq [termination_simp]
   7.978 +
   7.979 +lift_definition less_natural :: "natural \<Rightarrow> natural \<Rightarrow> bool"
   7.980 +  is "less :: nat \<Rightarrow> nat \<Rightarrow> bool"
   7.981 +  .
   7.982 +
   7.983 +declare less_natural.rep_eq [termination_simp]
   7.984 +
   7.985 +lift_definition equal_natural :: "natural \<Rightarrow> natural \<Rightarrow> bool"
   7.986 +  is "HOL.equal :: nat \<Rightarrow> nat \<Rightarrow> bool"
   7.987 +  .
   7.988 +
   7.989 +instance proof
   7.990 +qed (transfer, simp add: algebra_simps equal less_le_not_le [symmetric] linear)+
   7.991 +
   7.992  end
   7.993  
   7.994 +lemma [transfer_rule]:
   7.995 +  "fun_rel cr_natural (fun_rel cr_natural cr_natural) (min :: _ \<Rightarrow> _ \<Rightarrow> nat) (min :: _ \<Rightarrow> _ \<Rightarrow> natural)"
   7.996 +  by (unfold min_def [abs_def]) transfer_prover
   7.997 +
   7.998 +lemma [transfer_rule]:
   7.999 +  "fun_rel cr_natural (fun_rel cr_natural cr_natural) (max :: _ \<Rightarrow> _ \<Rightarrow> nat) (max :: _ \<Rightarrow> _ \<Rightarrow> natural)"
  7.1000 +  by (unfold max_def [abs_def]) transfer_prover
  7.1001 +
  7.1002 +lemma nat_of_natural_min [simp]:
  7.1003 +  "nat_of_natural (min k l) = min (nat_of_natural k) (nat_of_natural l)"
  7.1004 +  by transfer rule
  7.1005 +
  7.1006 +lemma nat_of_natural_max [simp]:
  7.1007 +  "nat_of_natural (max k l) = max (nat_of_natural k) (nat_of_natural l)"
  7.1008 +  by transfer rule
  7.1009 +
  7.1010 +lift_definition natural_of_integer :: "integer \<Rightarrow> natural"
  7.1011 +  is "nat :: int \<Rightarrow> nat"
  7.1012 +  .
  7.1013 +
  7.1014 +lift_definition integer_of_natural :: "natural \<Rightarrow> integer"
  7.1015 +  is "of_nat :: nat \<Rightarrow> int"
  7.1016 +  .
  7.1017 +
  7.1018 +lemma natural_of_integer_of_natural [simp]:
  7.1019 +  "natural_of_integer (integer_of_natural n) = n"
  7.1020 +  by transfer simp
  7.1021 +
  7.1022 +lemma integer_of_natural_of_integer [simp]:
  7.1023 +  "integer_of_natural (natural_of_integer k) = max 0 k"
  7.1024 +  by transfer auto
  7.1025 +
  7.1026 +lemma int_of_integer_of_natural [simp]:
  7.1027 +  "int_of_integer (integer_of_natural n) = of_nat (nat_of_natural n)"
  7.1028 +  by transfer rule
  7.1029 +
  7.1030 +lemma integer_of_natural_of_nat [simp]:
  7.1031 +  "integer_of_natural (of_nat n) = of_nat n"
  7.1032 +  by transfer rule
  7.1033 +
  7.1034 +lemma [measure_function]:
  7.1035 +  "is_measure nat_of_natural"
  7.1036 +  by (rule is_measure_trivial)
  7.1037 +
  7.1038 +
  7.1039 +subsection {* Inductive represenation of target language naturals *}
  7.1040 +
  7.1041 +lift_definition Suc :: "natural \<Rightarrow> natural"
  7.1042 +  is Nat.Suc
  7.1043 +  .
  7.1044 +
  7.1045 +declare Suc.rep_eq [simp]
  7.1046 +
  7.1047 +rep_datatype "0::natural" Suc
  7.1048 +  by (transfer, fact nat.induct nat.inject nat.distinct)+
  7.1049 +
  7.1050 +lemma natural_case [case_names nat, cases type: natural]:
  7.1051 +  fixes m :: natural
  7.1052 +  assumes "\<And>n. m = of_nat n \<Longrightarrow> P"
  7.1053 +  shows P
  7.1054 +  using assms by transfer blast
  7.1055 +
  7.1056 +lemma [simp, code]:
  7.1057 +  "natural_size = nat_of_natural"
  7.1058 +proof (rule ext)
  7.1059 +  fix n
  7.1060 +  show "natural_size n = nat_of_natural n"
  7.1061 +    by (induct n) simp_all
  7.1062 +qed
  7.1063 +
  7.1064 +lemma [simp, code]:
  7.1065 +  "size = nat_of_natural"
  7.1066 +proof (rule ext)
  7.1067 +  fix n
  7.1068 +  show "size n = nat_of_natural n"
  7.1069 +    by (induct n) simp_all
  7.1070 +qed
  7.1071 +
  7.1072 +lemma natural_decr [termination_simp]:
  7.1073 +  "n \<noteq> 0 \<Longrightarrow> nat_of_natural n - Nat.Suc 0 < nat_of_natural n"
  7.1074 +  by transfer simp
  7.1075 +
  7.1076 +lemma natural_zero_minus_one:
  7.1077 +  "(0::natural) - 1 = 0"
  7.1078 +  by simp
  7.1079 +
  7.1080 +lemma Suc_natural_minus_one:
  7.1081 +  "Suc n - 1 = n"
  7.1082 +  by transfer simp
  7.1083 +
  7.1084 +hide_const (open) Suc
  7.1085 +
  7.1086 +
  7.1087 +subsection {* Code refinement for target language naturals *}
  7.1088 +
  7.1089 +lift_definition Nat :: "integer \<Rightarrow> natural"
  7.1090 +  is nat
  7.1091 +  .
  7.1092 +
  7.1093 +lemma [code_post]:
  7.1094 +  "Nat 0 = 0"
  7.1095 +  "Nat 1 = 1"
  7.1096 +  "Nat (numeral k) = numeral k"
  7.1097 +  by (transfer, simp)+
  7.1098 +
  7.1099 +lemma [code abstype]:
  7.1100 +  "Nat (integer_of_natural n) = n"
  7.1101 +  by transfer simp
  7.1102 +
  7.1103 +lemma [code abstract]:
  7.1104 +  "integer_of_natural (natural_of_nat n) = of_nat n"
  7.1105 +  by simp
  7.1106 +
  7.1107 +lemma [code abstract]:
  7.1108 +  "integer_of_natural (natural_of_integer k) = max 0 k"
  7.1109 +  by simp
  7.1110 +
  7.1111 +lemma [code_abbrev]:
  7.1112 +  "natural_of_integer (Code_Numeral.Pos k) = numeral k"
  7.1113 +  by transfer simp
  7.1114 +
  7.1115 +lemma [code abstract]:
  7.1116 +  "integer_of_natural 0 = 0"
  7.1117 +  by transfer simp
  7.1118 +
  7.1119 +lemma [code abstract]:
  7.1120 +  "integer_of_natural 1 = 1"
  7.1121 +  by transfer simp
  7.1122 +
  7.1123 +lemma [code abstract]:
  7.1124 +  "integer_of_natural (Code_Numeral.Suc n) = integer_of_natural n + 1"
  7.1125 +  by transfer simp
  7.1126 +
  7.1127 +lemma [code]:
  7.1128 +  "nat_of_natural = nat_of_integer \<circ> integer_of_natural"
  7.1129 +  by transfer (simp add: fun_eq_iff)
  7.1130 +
  7.1131 +lemma [code, code_unfold]:
  7.1132 +  "natural_case f g n = (if n = 0 then f else g (n - 1))"
  7.1133 +  by (cases n rule: natural.exhaust) (simp_all, simp add: Suc_def)
  7.1134 +
  7.1135 +declare natural.recs [code del]
  7.1136 +
  7.1137 +lemma [code abstract]:
  7.1138 +  "integer_of_natural (m + n) = integer_of_natural m + integer_of_natural n"
  7.1139 +  by transfer simp
  7.1140 +
  7.1141 +lemma [code abstract]:
  7.1142 +  "integer_of_natural (m - n) = max 0 (integer_of_natural m - integer_of_natural n)"
  7.1143 +  by transfer simp
  7.1144 +
  7.1145 +lemma [code abstract]:
  7.1146 +  "integer_of_natural (m * n) = integer_of_natural m * integer_of_natural n"
  7.1147 +  by transfer (simp add: of_nat_mult)
  7.1148 +
  7.1149 +lemma [code abstract]:
  7.1150 +  "integer_of_natural (m div n) = integer_of_natural m div integer_of_natural n"
  7.1151 +  by transfer (simp add: zdiv_int)
  7.1152 +
  7.1153 +lemma [code abstract]:
  7.1154 +  "integer_of_natural (m mod n) = integer_of_natural m mod integer_of_natural n"
  7.1155 +  by transfer (simp add: zmod_int)
  7.1156 +
  7.1157 +lemma [code]:
  7.1158 +  "HOL.equal m n \<longleftrightarrow> HOL.equal (integer_of_natural m) (integer_of_natural n)"
  7.1159 +  by transfer (simp add: equal)
  7.1160 +
  7.1161 +lemma [code nbe]:
  7.1162 +  "HOL.equal n (n::natural) \<longleftrightarrow> True"
  7.1163 +  by (simp add: equal)
  7.1164 +
  7.1165 +lemma [code]:
  7.1166 +  "m \<le> n \<longleftrightarrow> integer_of_natural m \<le> integer_of_natural n"
  7.1167 +  by transfer simp
  7.1168 +
  7.1169 +lemma [code]:
  7.1170 +  "m < n \<longleftrightarrow> integer_of_natural m < integer_of_natural n"
  7.1171 +  by transfer simp
  7.1172 +
  7.1173 +hide_const (open) Nat
  7.1174 +
  7.1175 +
  7.1176 +code_reflect Code_Numeral
  7.1177 +  datatypes natural = _
  7.1178 +  functions integer_of_natural natural_of_integer
  7.1179 +
  7.1180 +end
  7.1181 +
     8.1 --- a/src/HOL/Codegenerator_Test/Candidates_Pretty.thy	Fri Feb 15 08:31:30 2013 +0100
     8.2 +++ b/src/HOL/Codegenerator_Test/Candidates_Pretty.thy	Fri Feb 15 08:31:31 2013 +0100
     8.3 @@ -4,7 +4,7 @@
     8.4  header {* Generating code using pretty literals and natural number literals  *}
     8.5  
     8.6  theory Candidates_Pretty
     8.7 -imports Candidates Code_Char_ord Efficient_Nat
     8.8 +imports Candidates Code_Char_ord Code_Target_Numeral
     8.9  begin
    8.10  
    8.11  end
     9.1 --- a/src/HOL/Codegenerator_Test/Generate_Pretty.thy	Fri Feb 15 08:31:30 2013 +0100
     9.2 +++ b/src/HOL/Codegenerator_Test/Generate_Pretty.thy	Fri Feb 15 08:31:31 2013 +0100
     9.3 @@ -10,9 +10,6 @@
     9.4  lemma [code, code del]: "nat_of_char = nat_of_char" ..
     9.5  lemma [code, code del]: "char_of_nat = char_of_nat" ..
     9.6  
     9.7 -declare Quickcheck_Narrowing.one_code_int_code [code del]
     9.8 -declare Quickcheck_Narrowing.int_of_code [code del]
     9.9 -
    9.10  subsection {* Check whether generated code compiles *}
    9.11  
    9.12  text {*
    10.1 --- a/src/HOL/Decision_Procs/Approximation.thy	Fri Feb 15 08:31:30 2013 +0100
    10.2 +++ b/src/HOL/Decision_Procs/Approximation.thy	Fri Feb 15 08:31:31 2013 +0100
    10.3 @@ -9,7 +9,7 @@
    10.4    "~~/src/HOL/Library/Float"
    10.5    "~~/src/HOL/Library/Reflection"
    10.6    "~~/src/HOL/Decision_Procs/Dense_Linear_Order"
    10.7 -  "~~/src/HOL/Library/Efficient_Nat"
    10.8 +  "~~/src/HOL/Library/Code_Target_Numeral"
    10.9  begin
   10.10  
   10.11  declare powr_numeral[simp]
   10.12 @@ -3329,8 +3329,11 @@
   10.13    fun term_of_bool true = @{term True}
   10.14      | term_of_bool false = @{term False};
   10.15  
   10.16 +  val mk_int = HOLogic.mk_number @{typ int} o @{code integer_of_int};
   10.17 +  val dest_int = @{code int_of_integer} o snd o HOLogic.dest_number;
   10.18 +
   10.19    fun term_of_float (@{code Float} (k, l)) =
   10.20 -    @{term Float} $ HOLogic.mk_number @{typ int} k $ HOLogic.mk_number @{typ int} l;
   10.21 +    @{term Float} $ mk_int k $ mk_int l;
   10.22  
   10.23    fun term_of_float_float_option NONE = @{term "None :: (float \<times> float) option"}
   10.24      | term_of_float_float_option (SOME ff) = @{term "Some :: float \<times> float \<Rightarrow> _"}
   10.25 @@ -3339,10 +3342,11 @@
   10.26    val term_of_float_float_option_list =
   10.27      HOLogic.mk_list @{typ "(float \<times> float) option"} o map term_of_float_float_option;
   10.28  
   10.29 -  fun nat_of_term t = HOLogic.dest_nat t handle TERM _ => snd (HOLogic.dest_number t);
   10.30 +  fun nat_of_term t = @{code nat_of_integer}
   10.31 +    (HOLogic.dest_nat t handle TERM _ => snd (HOLogic.dest_number t));
   10.32  
   10.33    fun float_of_term (@{term Float} $ k $ l) =
   10.34 -        @{code Float} (snd (HOLogic.dest_number k), snd (HOLogic.dest_number l))
   10.35 +        @{code Float} (dest_int k, dest_int l)
   10.36      | float_of_term t = bad t;
   10.37  
   10.38    fun floatarith_of_term (@{term Add} $ a $ b) = @{code Add} (floatarith_of_term a, floatarith_of_term b)
    11.1 --- a/src/HOL/Decision_Procs/Cooper.thy	Fri Feb 15 08:31:30 2013 +0100
    11.2 +++ b/src/HOL/Decision_Procs/Cooper.thy	Fri Feb 15 08:31:31 2013 +0100
    11.3 @@ -3,7 +3,7 @@
    11.4  *)
    11.5  
    11.6  theory Cooper
    11.7 -imports Complex_Main "~~/src/HOL/Library/Efficient_Nat" "~~/src/HOL/Library/Old_Recdef"
    11.8 +imports Complex_Main "~~/src/HOL/Library/Code_Target_Numeral" "~~/src/HOL/Library/Old_Recdef"
    11.9  begin
   11.10  
   11.11  (* Periodicity of dvd *)
   11.12 @@ -1996,21 +1996,23 @@
   11.13  
   11.14  ML {* @{code cooper_test} () *}
   11.15  
   11.16 -(* code_reflect Cooper_Procedure
   11.17 +(*code_reflect Cooper_Procedure
   11.18    functions pa
   11.19 -  file "~~/src/HOL/Tools/Qelim/cooper_procedure.ML" *)
   11.20 +  file "~~/src/HOL/Tools/Qelim/cooper_procedure.ML"*)
   11.21  
   11.22  oracle linzqe_oracle = {*
   11.23  let
   11.24  
   11.25  fun num_of_term vs (t as Free (xn, xT)) = (case AList.lookup (op =) vs t
   11.26       of NONE => error "Variable not found in the list!"
   11.27 -      | SOME n => @{code Bound} n)
   11.28 -  | num_of_term vs @{term "0::int"} = @{code C} 0
   11.29 -  | num_of_term vs @{term "1::int"} = @{code C} 1
   11.30 -  | num_of_term vs (@{term "numeral :: _ \<Rightarrow> int"} $ t) = @{code C} (HOLogic.dest_num t)
   11.31 -  | num_of_term vs (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t) = @{code C} (~(HOLogic.dest_num t))
   11.32 -  | num_of_term vs (Bound i) = @{code Bound} i
   11.33 +      | SOME n => @{code Bound} (@{code nat_of_integer} n))
   11.34 +  | num_of_term vs @{term "0::int"} = @{code C} (@{code int_of_integer} 0)
   11.35 +  | num_of_term vs @{term "1::int"} = @{code C} (@{code int_of_integer} 1)
   11.36 +  | num_of_term vs (@{term "numeral :: _ \<Rightarrow> int"} $ t) =
   11.37 +      @{code C} (@{code int_of_integer} (HOLogic.dest_num t))
   11.38 +  | num_of_term vs (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t) =
   11.39 +      @{code C} (@{code int_of_integer} (~(HOLogic.dest_num t)))
   11.40 +  | num_of_term vs (Bound i) = @{code Bound} (@{code nat_of_integer} i)
   11.41    | num_of_term vs (@{term "uminus :: int \<Rightarrow> int"} $ t') = @{code Neg} (num_of_term vs t')
   11.42    | num_of_term vs (@{term "op + :: int \<Rightarrow> int \<Rightarrow> int"} $ t1 $ t2) =
   11.43        @{code Add} (num_of_term vs t1, num_of_term vs t2)
   11.44 @@ -2018,9 +2020,9 @@
   11.45        @{code Sub} (num_of_term vs t1, num_of_term vs t2)
   11.46    | num_of_term vs (@{term "op * :: int \<Rightarrow> int \<Rightarrow> int"} $ t1 $ t2) =
   11.47        (case try HOLogic.dest_number t1
   11.48 -       of SOME (_, i) => @{code Mul} (i, num_of_term vs t2)
   11.49 +       of SOME (_, i) => @{code Mul} (@{code int_of_integer} i, num_of_term vs t2)
   11.50          | NONE => (case try HOLogic.dest_number t2
   11.51 -                of SOME (_, i) => @{code Mul} (i, num_of_term vs t1)
   11.52 +                of SOME (_, i) => @{code Mul} (@{code int_of_integer} i, num_of_term vs t1)
   11.53                   | NONE => error "num_of_term: unsupported multiplication"))
   11.54    | num_of_term vs t = error ("num_of_term: unknown term " ^ Syntax.string_of_term @{context} t);
   11.55  
   11.56 @@ -2034,7 +2036,7 @@
   11.57        @{code Eq} (@{code Sub} (num_of_term vs t1, num_of_term vs t2))
   11.58    | fm_of_term ps vs (@{term "op dvd :: int \<Rightarrow> int \<Rightarrow> bool"} $ t1 $ t2) =
   11.59        (case try HOLogic.dest_number t1
   11.60 -       of SOME (_, i) => @{code Dvd} (i, num_of_term vs t2)
   11.61 +       of SOME (_, i) => @{code Dvd} (@{code int_of_integer} i, num_of_term vs t2)
   11.62          | NONE => error "num_of_term: unsupported dvd")
   11.63    | fm_of_term ps vs (@{term "op = :: bool \<Rightarrow> bool \<Rightarrow> bool"} $ t1 $ t2) =
   11.64        @{code Iff} (fm_of_term ps vs t1, fm_of_term ps vs t2)
   11.65 @@ -2058,8 +2060,11 @@
   11.66        in @{code A} (fm_of_term ps vs' p) end
   11.67    | fm_of_term ps vs t = error ("fm_of_term : unknown term " ^ Syntax.string_of_term @{context} t);
   11.68  
   11.69 -fun term_of_num vs (@{code C} i) = HOLogic.mk_number HOLogic.intT i
   11.70 -  | term_of_num vs (@{code Bound} n) = fst (the (find_first (fn (_, m) => n = m) vs))
   11.71 +fun term_of_num vs (@{code C} i) = HOLogic.mk_number HOLogic.intT (@{code integer_of_int} i)
   11.72 +  | term_of_num vs (@{code Bound} n) =
   11.73 +      let
   11.74 +        val q = @{code integer_of_nat} n
   11.75 +      in fst (the (find_first (fn (_, m) => q = m) vs)) end
   11.76    | term_of_num vs (@{code Neg} t') = @{term "uminus :: int \<Rightarrow> int"} $ term_of_num vs t'
   11.77    | term_of_num vs (@{code Add} (t1, t2)) = @{term "op + :: int \<Rightarrow> int \<Rightarrow> int"} $
   11.78        term_of_num vs t1 $ term_of_num vs t2
   11.79 @@ -2097,7 +2102,10 @@
   11.80        HOLogic.imp $ term_of_fm ps vs t1 $ term_of_fm ps vs t2
   11.81    | term_of_fm ps vs (@{code Iff} (t1, t2)) =
   11.82        @{term "op = :: bool \<Rightarrow> bool \<Rightarrow> bool"} $ term_of_fm ps vs t1 $ term_of_fm ps vs t2
   11.83 -  | term_of_fm ps vs (@{code Closed} n) = (fst o the) (find_first (fn (_, m) => m = n) ps)
   11.84 +  | term_of_fm ps vs (@{code Closed} n) =
   11.85 +      let
   11.86 +        val q = @{code integer_of_nat} n
   11.87 +      in (fst o the) (find_first (fn (_, m) => m = q) ps) end
   11.88    | term_of_fm ps vs (@{code NClosed} n) = term_of_fm ps vs (@{code NOT} (@{code Closed} n));
   11.89  
   11.90  fun term_bools acc t =
    12.1 --- a/src/HOL/Decision_Procs/Ferrack.thy	Fri Feb 15 08:31:30 2013 +0100
    12.2 +++ b/src/HOL/Decision_Procs/Ferrack.thy	Fri Feb 15 08:31:31 2013 +0100
    12.3 @@ -4,7 +4,7 @@
    12.4  
    12.5  theory Ferrack
    12.6  imports Complex_Main Dense_Linear_Order DP_Library
    12.7 -  "~~/src/HOL/Library/Efficient_Nat" "~~/src/HOL/Library/Old_Recdef"
    12.8 +  "~~/src/HOL/Library/Code_Target_Numeral" "~~/src/HOL/Library/Old_Recdef"
    12.9  begin
   12.10  
   12.11  section {* Quantifier elimination for @{text "\<real> (0, 1, +, <)"} *}
   12.12 @@ -1818,7 +1818,7 @@
   12.13    with usubst_I[OF lp mnp stnb, where x="x" and bs="bs"] tnU smU show ?lhs by blast
   12.14  qed
   12.15  
   12.16 -lemma ferrack: 
   12.17 +lemma ferrack:
   12.18    assumes qf: "qfree p"
   12.19    shows "qfree (ferrack p) \<and> ((Ifm bs (ferrack p)) = (\<exists> x. Ifm (x#bs) p))"
   12.20    (is "_ \<and> (?rhs = ?lhs)")
   12.21 @@ -1922,12 +1922,15 @@
   12.22  oracle linr_oracle = {*
   12.23  let
   12.24  
   12.25 -fun num_of_term vs (Free vT) = @{code Bound} (find_index (fn vT' => vT = vT') vs)
   12.26 -  | num_of_term vs @{term "real (0::int)"} = @{code C} 0
   12.27 -  | num_of_term vs @{term "real (1::int)"} = @{code C} 1
   12.28 -  | num_of_term vs @{term "0::real"} = @{code C} 0
   12.29 -  | num_of_term vs @{term "1::real"} = @{code C} 1
   12.30 -  | num_of_term vs (Bound i) = @{code Bound} i
   12.31 +val mk_C = @{code C} o @{code int_of_integer};
   12.32 +val mk_Bound = @{code Bound} o @{code nat_of_integer};
   12.33 +
   12.34 +fun num_of_term vs (Free vT) = mk_Bound (find_index (fn vT' => vT = vT') vs)
   12.35 +  | num_of_term vs @{term "real (0::int)"} = mk_C 0
   12.36 +  | num_of_term vs @{term "real (1::int)"} = mk_C 1
   12.37 +  | num_of_term vs @{term "0::real"} = mk_C 0
   12.38 +  | num_of_term vs @{term "1::real"} = mk_C 1
   12.39 +  | num_of_term vs (Bound i) = mk_Bound i
   12.40    | num_of_term vs (@{term "uminus :: real \<Rightarrow> real"} $ t') = @{code Neg} (num_of_term vs t')
   12.41    | num_of_term vs (@{term "op + :: real \<Rightarrow> real \<Rightarrow> real"} $ t1 $ t2) =
   12.42       @{code Add} (num_of_term vs t1, num_of_term vs t2)
   12.43 @@ -1937,10 +1940,10 @@
   12.44       of @{code C} i => @{code Mul} (i, num_of_term vs t2)
   12.45        | _ => error "num_of_term: unsupported multiplication")
   12.46    | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ t') =
   12.47 -     (@{code C} (snd (HOLogic.dest_number t'))
   12.48 +     (mk_C (snd (HOLogic.dest_number t'))
   12.49         handle TERM _ => error ("num_of_term: unknown term"))
   12.50    | num_of_term vs t' =
   12.51 -     (@{code C} (snd (HOLogic.dest_number t'))
   12.52 +     (mk_C (snd (HOLogic.dest_number t'))
   12.53         handle TERM _ => error ("num_of_term: unknown term"));
   12.54  
   12.55  fun fm_of_term vs @{term True} = @{code T}
   12.56 @@ -1963,8 +1966,9 @@
   12.57        @{code A} (fm_of_term (("", dummyT) ::  vs) p)
   12.58    | fm_of_term vs t = error ("fm_of_term : unknown term " ^ Syntax.string_of_term @{context} t);
   12.59  
   12.60 -fun term_of_num vs (@{code C} i) = @{term "real :: int \<Rightarrow> real"} $ HOLogic.mk_number HOLogic.intT i
   12.61 -  | term_of_num vs (@{code Bound} n) = Free (nth vs n)
   12.62 +fun term_of_num vs (@{code C} i) = @{term "real :: int \<Rightarrow> real"} $
   12.63 +      HOLogic.mk_number HOLogic.intT (@{code integer_of_int} i)
   12.64 +  | term_of_num vs (@{code Bound} n) = Free (nth vs (@{code integer_of_nat} n))
   12.65    | term_of_num vs (@{code Neg} t') = @{term "uminus :: real \<Rightarrow> real"} $ term_of_num vs t'
   12.66    | term_of_num vs (@{code Add} (t1, t2)) = @{term "op + :: real \<Rightarrow> real \<Rightarrow> real"} $
   12.67        term_of_num vs t1 $ term_of_num vs t2
   12.68 @@ -2026,3 +2030,4 @@
   12.69    by rferrack
   12.70  
   12.71  end
   12.72 +
    13.1 --- a/src/HOL/Decision_Procs/MIR.thy	Fri Feb 15 08:31:30 2013 +0100
    13.2 +++ b/src/HOL/Decision_Procs/MIR.thy	Fri Feb 15 08:31:31 2013 +0100
    13.3 @@ -4,7 +4,7 @@
    13.4  
    13.5  theory MIR
    13.6  imports Complex_Main Dense_Linear_Order DP_Library
    13.7 -  "~~/src/HOL/Library/Efficient_Nat" "~~/src/HOL/Library/Old_Recdef"
    13.8 +  "~~/src/HOL/Library/Code_Target_Numeral" "~~/src/HOL/Library/Old_Recdef"
    13.9  begin
   13.10  
   13.11  section {* Quantifier elimination for @{text "\<real> (0, 1, +, floor, <)"} *}
   13.12 @@ -5521,14 +5521,18 @@
   13.13  oracle mirfr_oracle = {* fn (proofs, ct) =>
   13.14  let
   13.15  
   13.16 +val mk_C = @{code C} o @{code int_of_integer};
   13.17 +val mk_Dvd = @{code Dvd} o apfst @{code int_of_integer};
   13.18 +val mk_Bound = @{code Bound} o @{code nat_of_integer};
   13.19 +
   13.20  fun num_of_term vs (t as Free (xn, xT)) = (case AList.lookup (op =) vs t
   13.21       of NONE => error "Variable not found in the list!"
   13.22 -      | SOME n => @{code Bound} n)
   13.23 -  | num_of_term vs @{term "real (0::int)"} = @{code C} 0
   13.24 -  | num_of_term vs @{term "real (1::int)"} = @{code C} 1
   13.25 -  | num_of_term vs @{term "0::real"} = @{code C} 0
   13.26 -  | num_of_term vs @{term "1::real"} = @{code C} 1
   13.27 -  | num_of_term vs (Bound i) = @{code Bound} i
   13.28 +      | SOME n => mk_Bound n)
   13.29 +  | num_of_term vs @{term "real (0::int)"} = mk_C 0
   13.30 +  | num_of_term vs @{term "real (1::int)"} = mk_C 1
   13.31 +  | num_of_term vs @{term "0::real"} = mk_C 0
   13.32 +  | num_of_term vs @{term "1::real"} = mk_C 1
   13.33 +  | num_of_term vs (Bound i) = mk_Bound i
   13.34    | num_of_term vs (@{term "uminus :: real \<Rightarrow> real"} $ t') = @{code Neg} (num_of_term vs t')
   13.35    | num_of_term vs (@{term "op + :: real \<Rightarrow> real \<Rightarrow> real"} $ t1 $ t2) =
   13.36        @{code Add} (num_of_term vs t1, num_of_term vs t2)
   13.37 @@ -5539,17 +5543,17 @@
   13.38         of @{code C} i => @{code Mul} (i, num_of_term vs t2)
   13.39          | _ => error "num_of_term: unsupported Multiplication")
   13.40    | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "numeral :: _ \<Rightarrow> int"} $ t')) =
   13.41 -      @{code C} (HOLogic.dest_num t')
   13.42 +      mk_C (HOLogic.dest_num t')
   13.43    | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t')) =
   13.44 -      @{code C} (~ (HOLogic.dest_num t'))
   13.45 +      mk_C (~ (HOLogic.dest_num t'))
   13.46    | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "floor :: real \<Rightarrow> int"} $ t')) =
   13.47        @{code Floor} (num_of_term vs t')
   13.48    | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "ceiling :: real \<Rightarrow> int"} $ t')) =
   13.49        @{code Neg} (@{code Floor} (@{code Neg} (num_of_term vs t')))
   13.50    | num_of_term vs (@{term "numeral :: _ \<Rightarrow> real"} $ t') =
   13.51 -      @{code C} (HOLogic.dest_num t')
   13.52 +      mk_C (HOLogic.dest_num t')
   13.53    | num_of_term vs (@{term "neg_numeral :: _ \<Rightarrow> real"} $ t') =
   13.54 -      @{code C} (~ (HOLogic.dest_num t'))
   13.55 +      mk_C (~ (HOLogic.dest_num t'))
   13.56    | num_of_term vs t = error ("num_of_term: unknown term " ^ Syntax.string_of_term @{context} t);
   13.57  
   13.58  fun fm_of_term vs @{term True} = @{code T}
   13.59 @@ -5561,9 +5565,9 @@
   13.60    | fm_of_term vs (@{term "op = :: real \<Rightarrow> real \<Rightarrow> bool"} $ t1 $ t2) =
   13.61        @{code Eq} (@{code Sub} (num_of_term vs t1, num_of_term vs t2)) 
   13.62    | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "numeral :: _ \<Rightarrow> int"} $ t1)) $ t2) =
   13.63 -      @{code Dvd} (HOLogic.dest_num t1, num_of_term vs t2)
   13.64 +      mk_Dvd (HOLogic.dest_num t1, num_of_term vs t2)
   13.65    | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t1)) $ t2) =
   13.66 -      @{code Dvd} (~ (HOLogic.dest_num t1), num_of_term vs t2)
   13.67 +      mk_Dvd (~ (HOLogic.dest_num t1), num_of_term vs t2)
   13.68    | fm_of_term vs (@{term "op = :: bool \<Rightarrow> bool \<Rightarrow> bool"} $ t1 $ t2) =
   13.69        @{code Iff} (fm_of_term vs t1, fm_of_term vs t2)
   13.70    | fm_of_term vs (@{term HOL.conj} $ t1 $ t2) =
   13.71 @@ -5580,8 +5584,12 @@
   13.72        @{code A} (fm_of_term (map (fn (v, n) => (v, n + 1)) vs) p)
   13.73    | fm_of_term vs t = error ("fm_of_term : unknown term " ^ Syntax.string_of_term @{context} t);
   13.74  
   13.75 -fun term_of_num vs (@{code C} i) = @{term "real :: int \<Rightarrow> real"} $ HOLogic.mk_number HOLogic.intT i
   13.76 -  | term_of_num vs (@{code Bound} n) = fst (the (find_first (fn (_, m) => n = m) vs))
   13.77 +fun term_of_num vs (@{code C} i) = @{term "real :: int \<Rightarrow> real"} $
   13.78 +      HOLogic.mk_number HOLogic.intT (@{code integer_of_int} i)
   13.79 +  | term_of_num vs (@{code Bound} n) =
   13.80 +      let
   13.81 +        val m = @{code integer_of_nat} n;
   13.82 +      in fst (the (find_first (fn (_, q) => m = q) vs)) end
   13.83    | term_of_num vs (@{code Neg} (@{code Floor} (@{code Neg} t'))) =
   13.84        @{term "real :: int \<Rightarrow> real"} $ (@{term "ceiling :: real \<Rightarrow> int"} $ term_of_num vs t')
   13.85    | term_of_num vs (@{code Neg} t') = @{term "uminus :: real \<Rightarrow> real"} $ term_of_num vs t'
   13.86 @@ -5660,3 +5668,4 @@
   13.87    by mir
   13.88  
   13.89  end
   13.90 +
    14.1 --- a/src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy	Fri Feb 15 08:31:30 2013 +0100
    14.2 +++ b/src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy	Fri Feb 15 08:31:31 2013 +0100
    14.3 @@ -6,7 +6,7 @@
    14.4  
    14.5  theory Parametric_Ferrante_Rackoff
    14.6  imports Reflected_Multivariate_Polynomial Dense_Linear_Order DP_Library
    14.7 -  "~~/src/HOL/Library/Efficient_Nat" "~~/src/HOL/Library/Old_Recdef"
    14.8 +  "~~/src/HOL/Library/Code_Target_Numeral" "~~/src/HOL/Library/Old_Recdef"
    14.9  begin
   14.10  
   14.11  subsection {* Terms *}
   14.12 @@ -2795,6 +2795,10 @@
   14.13  fun binopT T = T --> T --> T;
   14.14  fun relT T = T --> T --> @{typ bool};
   14.15  
   14.16 +val mk_C = @{code C} o pairself @{code int_of_integer};
   14.17 +val mk_poly_Bound = @{code poly.Bound} o @{code nat_of_integer};
   14.18 +val mk_Bound = @{code Bound} o @{code nat_of_integer};
   14.19 +
   14.20  val dest_num = snd o HOLogic.dest_number;
   14.21  
   14.22  fun try_dest_num t = SOME ((snd o HOLogic.dest_number) t)
   14.23 @@ -2812,19 +2816,19 @@
   14.24    | num_of_term ps (Const (@{const_name Groups.plus}, _) $ a $ b) = @{code poly.Add} (num_of_term ps a, num_of_term ps b)
   14.25    | num_of_term ps (Const (@{const_name Groups.minus}, _) $ a $ b) = @{code poly.Sub} (num_of_term ps a, num_of_term ps b)
   14.26    | num_of_term ps (Const (@{const_name Groups.times}, _) $ a $ b) = @{code poly.Mul} (num_of_term ps a, num_of_term ps b)
   14.27 -  | num_of_term ps (Const (@{const_name Power.power}, _) $ a $ n) = @{code poly.Pw} (num_of_term ps a, dest_nat n)
   14.28 -  | num_of_term ps (Const (@{const_name Fields.divide}, _) $ a $ b) = @{code poly.C} (dest_num a, dest_num b)
   14.29 +  | num_of_term ps (Const (@{const_name Power.power}, _) $ a $ n) = @{code poly.Pw} (num_of_term ps a, @{code nat_of_integer} (dest_nat n))
   14.30 +  | num_of_term ps (Const (@{const_name Fields.divide}, _) $ a $ b) = mk_C (dest_num a, dest_num b)
   14.31    | num_of_term ps t = (case try_dest_num t
   14.32 -     of SOME k => @{code poly.C} (k, 1)
   14.33 -      | NONE => @{code poly.Bound} (the_index ps t));
   14.34 +     of SOME k => mk_C (k, 1)
   14.35 +      | NONE => mk_poly_Bound (the_index ps t));
   14.36  
   14.37  fun tm_of_term fs ps (Const(@{const_name Groups.uminus}, _) $ t) = @{code Neg} (tm_of_term fs ps t)
   14.38    | tm_of_term fs ps (Const(@{const_name Groups.plus}, _) $ a $ b) = @{code Add} (tm_of_term fs ps a, tm_of_term fs ps b)
   14.39    | tm_of_term fs ps (Const(@{const_name Groups.minus}, _) $ a $ b) = @{code Sub} (tm_of_term fs ps a, tm_of_term fs ps b)
   14.40    | tm_of_term fs ps (Const(@{const_name Groups.times}, _) $ a $ b) = @{code Mul} (num_of_term ps a, tm_of_term fs ps b)
   14.41    | tm_of_term fs ps t = (@{code CP} (num_of_term ps t) 
   14.42 -      handle TERM _ => @{code Bound} (the_index fs t)
   14.43 -           | General.Subscript => @{code Bound} (the_index fs t));
   14.44 +      handle TERM _ => mk_Bound (the_index fs t)
   14.45 +           | General.Subscript => mk_Bound (the_index fs t));
   14.46  
   14.47  fun fm_of_term fs ps @{term True} = @{code T}
   14.48    | fm_of_term fs ps @{term False} = @{code F}
   14.49 @@ -2850,21 +2854,25 @@
   14.50    | fm_of_term fs ps _ = error "fm_of_term";
   14.51  
   14.52  fun term_of_num T ps (@{code poly.C} (a, b)) = 
   14.53 -    (if b = 1 then HOLogic.mk_number T a
   14.54 -     else if b = 0 then Const (@{const_name Groups.zero}, T)
   14.55 -     else Const (@{const_name Fields.divide}, binopT T) $ HOLogic.mk_number T a $ HOLogic.mk_number T b)
   14.56 -  | term_of_num T ps (@{code poly.Bound} i) = nth ps i
   14.57 +      let
   14.58 +        val (c, d) = pairself (@{code integer_of_int}) (a, b)
   14.59 +      in
   14.60 +        (if d = 1 then HOLogic.mk_number T c
   14.61 +        else if d = 0 then Const (@{const_name Groups.zero}, T)
   14.62 +        else Const (@{const_name Fields.divide}, binopT T) $ HOLogic.mk_number T c $ HOLogic.mk_number T d)
   14.63 +      end
   14.64 +  | term_of_num T ps (@{code poly.Bound} i) = nth ps (@{code integer_of_nat} i)
   14.65    | term_of_num T ps (@{code poly.Add} (a, b)) = Const (@{const_name Groups.plus}, binopT T) $ term_of_num T ps a $ term_of_num T ps b
   14.66    | term_of_num T ps (@{code poly.Mul} (a, b)) = Const (@{const_name Groups.times}, binopT T) $ term_of_num T ps a $ term_of_num T ps b
   14.67    | term_of_num T ps (@{code poly.Sub} (a, b)) = Const (@{const_name Groups.minus}, binopT T) $ term_of_num T ps a $ term_of_num T ps b
   14.68    | term_of_num T ps (@{code poly.Neg} a) = Const (@{const_name Groups.uminus}, T --> T) $ term_of_num T ps a
   14.69 -  | term_of_num T ps (@{code poly.Pw} (a, n)) =
   14.70 -      Const (@{const_name Power.power}, T --> @{typ nat} --> T) $ term_of_num T ps a $ HOLogic.mk_number HOLogic.natT n
   14.71 +  | term_of_num T ps (@{code poly.Pw} (a, n)) = Const (@{const_name Power.power},
   14.72 +      T --> @{typ nat} --> T) $ term_of_num T ps a $ HOLogic.mk_number HOLogic.natT (@{code integer_of_nat} n)
   14.73    | term_of_num T ps (@{code poly.CN} (c, n, p)) =
   14.74        term_of_num T ps (@{code poly.Add} (c, @{code poly.Mul} (@{code poly.Bound} n, p)));
   14.75  
   14.76  fun term_of_tm T fs ps (@{code CP} p) = term_of_num T ps p
   14.77 -  | term_of_tm T fs ps (@{code Bound} i) = nth fs i
   14.78 +  | term_of_tm T fs ps (@{code Bound} i) = nth fs (@{code integer_of_nat} i)
   14.79    | term_of_tm T fs ps (@{code Add} (a, b)) = Const (@{const_name Groups.plus}, binopT T) $ term_of_tm T fs ps a $ term_of_tm T fs ps b
   14.80    | term_of_tm T fs ps (@{code Mul} (a, b)) = Const (@{const_name Groups.times}, binopT T) $ term_of_num T ps a $ term_of_tm T fs ps b
   14.81    | term_of_tm T fs ps (@{code Sub} (a, b)) = Const (@{const_name Groups.minus}, binopT T) $ term_of_tm T fs ps a $ term_of_tm T fs ps b
   14.82 @@ -2993,3 +3001,4 @@
   14.83  *)
   14.84  end
   14.85  
   14.86 +
    15.1 --- a/src/HOL/Imperative_HOL/Array.thy	Fri Feb 15 08:31:30 2013 +0100
    15.2 +++ b/src/HOL/Imperative_HOL/Array.thy	Fri Feb 15 08:31:31 2013 +0100
    15.3 @@ -361,38 +361,38 @@
    15.4  subsubsection {* Logical intermediate layer *}
    15.5  
    15.6  definition new' where
    15.7 -  [code del]: "new' = Array.new o Code_Numeral.nat_of"
    15.8 +  [code del]: "new' = Array.new o nat_of_integer"
    15.9  
   15.10  lemma [code]:
   15.11 -  "Array.new = new' o Code_Numeral.of_nat"
   15.12 +  "Array.new = new' o of_nat"
   15.13    by (simp add: new'_def o_def)
   15.14  
   15.15  definition make' where
   15.16 -  [code del]: "make' i f = Array.make (Code_Numeral.nat_of i) (f o Code_Numeral.of_nat)"
   15.17 +  [code del]: "make' i f = Array.make (nat_of_integer i) (f o of_nat)"
   15.18  
   15.19  lemma [code]:
   15.20 -  "Array.make n f = make' (Code_Numeral.of_nat n) (f o Code_Numeral.nat_of)"
   15.21 +  "Array.make n f = make' (of_nat n) (f o nat_of_integer)"
   15.22    by (simp add: make'_def o_def)
   15.23  
   15.24  definition len' where
   15.25 -  [code del]: "len' a = Array.len a \<guillemotright>= (\<lambda>n. return (Code_Numeral.of_nat n))"
   15.26 +  [code del]: "len' a = Array.len a \<guillemotright>= (\<lambda>n. return (of_nat n))"
   15.27  
   15.28  lemma [code]:
   15.29 -  "Array.len a = len' a \<guillemotright>= (\<lambda>i. return (Code_Numeral.nat_of i))"
   15.30 +  "Array.len a = len' a \<guillemotright>= (\<lambda>i. return (nat_of_integer i))"
   15.31    by (simp add: len'_def)
   15.32  
   15.33  definition nth' where
   15.34 -  [code del]: "nth' a = Array.nth a o Code_Numeral.nat_of"
   15.35 +  [code del]: "nth' a = Array.nth a o nat_of_integer"
   15.36  
   15.37  lemma [code]:
   15.38 -  "Array.nth a n = nth' a (Code_Numeral.of_nat n)"
   15.39 +  "Array.nth a n = nth' a (of_nat n)"
   15.40    by (simp add: nth'_def)
   15.41  
   15.42  definition upd' where
   15.43 -  [code del]: "upd' a i x = Array.upd (Code_Numeral.nat_of i) x a \<guillemotright> return ()"
   15.44 +  [code del]: "upd' a i x = Array.upd (nat_of_integer i) x a \<guillemotright> return ()"
   15.45  
   15.46  lemma [code]:
   15.47 -  "Array.upd i x a = upd' a (Code_Numeral.of_nat i) x \<guillemotright> return a"
   15.48 +  "Array.upd i x a = upd' a (of_nat i) x \<guillemotright> return a"
   15.49    by (simp add: upd'_def upd_return)
   15.50  
   15.51  lemma [code]:
   15.52 @@ -501,3 +501,4 @@
   15.53  code_const "HOL.equal :: 'a array \<Rightarrow> 'a array \<Rightarrow> bool" (Scala infixl 5 "==")
   15.54  
   15.55  end
   15.56 +
    16.1 --- a/src/HOL/Imperative_HOL/Heap_Monad.thy	Fri Feb 15 08:31:30 2013 +0100
    16.2 +++ b/src/HOL/Imperative_HOL/Heap_Monad.thy	Fri Feb 15 08:31:31 2013 +0100
    16.3 @@ -8,7 +8,6 @@
    16.4  imports
    16.5    Heap
    16.6    "~~/src/HOL/Library/Monad_Syntax"
    16.7 -  "~~/src/HOL/Library/Code_Natural"
    16.8  begin
    16.9  
   16.10  subsection {* The monad *}
   16.11 @@ -529,33 +528,31 @@
   16.12  import qualified Data.STRef;
   16.13  import qualified Data.Array.ST;
   16.14  
   16.15 -import Natural;
   16.16 -
   16.17  type RealWorld = Control.Monad.ST.RealWorld;
   16.18  type ST s a = Control.Monad.ST.ST s a;
   16.19  type STRef s a = Data.STRef.STRef s a;
   16.20 -type STArray s a = Data.Array.ST.STArray s Natural a;
   16.21 +type STArray s a = Data.Array.ST.STArray s Integer a;
   16.22  
   16.23  newSTRef = Data.STRef.newSTRef;
   16.24  readSTRef = Data.STRef.readSTRef;
   16.25  writeSTRef = Data.STRef.writeSTRef;
   16.26  
   16.27 -newArray :: Natural -> a -> ST s (STArray s a);
   16.28 +newArray :: Integer -> a -> ST s (STArray s a);
   16.29  newArray k = Data.Array.ST.newArray (0, k);
   16.30  
   16.31  newListArray :: [a] -> ST s (STArray s a);
   16.32  newListArray xs = Data.Array.ST.newListArray (0, (fromInteger . toInteger . length) xs) xs;
   16.33  
   16.34 -newFunArray :: Natural -> (Natural -> a) -> ST s (STArray s a);
   16.35 +newFunArray :: Integer -> (Integer -> a) -> ST s (STArray s a);
   16.36  newFunArray k f = Data.Array.ST.newListArray (0, k) (map f [0..k-1]);
   16.37  
   16.38 -lengthArray :: STArray s a -> ST s Natural;
   16.39 +lengthArray :: STArray s a -> ST s Integer;
   16.40  lengthArray a = Control.Monad.liftM snd (Data.Array.ST.getBounds a);
   16.41  
   16.42 -readArray :: STArray s a -> Natural -> ST s a;
   16.43 +readArray :: STArray s a -> Integer -> ST s a;
   16.44  readArray = Data.Array.ST.readArray;
   16.45  
   16.46 -writeArray :: STArray s a -> Natural -> a -> ST s ();
   16.47 +writeArray :: STArray s a -> Integer -> a -> ST s ();
   16.48  writeArray = Data.Array.ST.writeArray;*}
   16.49  
   16.50  code_reserved Haskell Heap
   16.51 @@ -590,16 +587,16 @@
   16.52  
   16.53  object Array {
   16.54    import collection.mutable.ArraySeq
   16.55 -  def alloc[A](n: Natural)(x: A): ArraySeq[A] =
   16.56 -    ArraySeq.fill(n.as_Int)(x)
   16.57 -  def make[A](n: Natural)(f: Natural => A): ArraySeq[A] =
   16.58 -    ArraySeq.tabulate(n.as_Int)((k: Int) => f(Natural(k)))
   16.59 -  def len[A](a: ArraySeq[A]): Natural =
   16.60 -    Natural(a.length)
   16.61 -  def nth[A](a: ArraySeq[A], n: Natural): A =
   16.62 -    a(n.as_Int)
   16.63 -  def upd[A](a: ArraySeq[A], n: Natural, x: A): Unit =
   16.64 -    a.update(n.as_Int, x)
   16.65 +  def alloc[A](n: BigInt)(x: A): ArraySeq[A] =
   16.66 +    ArraySeq.fill(n.toInt)(x)
   16.67 +  def make[A](n: BigInt)(f: BigInt => A): ArraySeq[A] =
   16.68 +    ArraySeq.tabulate(n.toInt)((k: Int) => f(BigInt(k)))
   16.69 +  def len[A](a: ArraySeq[A]): BigInt =
   16.70 +    BigInt(a.length)
   16.71 +  def nth[A](a: ArraySeq[A], n: BigInt): A =
   16.72 +    a(n.toInt)
   16.73 +  def upd[A](a: ArraySeq[A], n: BigInt, x: A): Unit =
   16.74 +    a.update(n.toInt, x)
   16.75    def freeze[A](a: ArraySeq[A]): List[A] =
   16.76      a.toList
   16.77  }
    17.1 --- a/src/HOL/Imperative_HOL/ex/Imperative_Quicksort.thy	Fri Feb 15 08:31:30 2013 +0100
    17.2 +++ b/src/HOL/Imperative_HOL/ex/Imperative_Quicksort.thy	Fri Feb 15 08:31:31 2013 +0100
    17.3 @@ -9,7 +9,7 @@
    17.4    "~~/src/HOL/Imperative_HOL/Imperative_HOL"
    17.5    Subarray
    17.6    "~~/src/HOL/Library/Multiset"
    17.7 -  "~~/src/HOL/Library/Efficient_Nat"
    17.8 +  "~~/src/HOL/Library/Code_Target_Numeral"
    17.9  begin
   17.10  
   17.11  text {* We prove QuickSort correct in the Relational Calculus. *}
   17.12 @@ -657,7 +657,12 @@
   17.13  
   17.14  code_reserved SML upto
   17.15  
   17.16 -ML {* @{code qsort} (Array.fromList [42, 2, 3, 5, 0, 1705, 8, 3, 15]) () *}
   17.17 +definition "example = do {
   17.18 +    a \<leftarrow> Array.of_list [42, 2, 3, 5, 0, 1705, 8, 3, 15];
   17.19 +    qsort a
   17.20 +  }"
   17.21 +
   17.22 +ML {* @{code example} () *}
   17.23  
   17.24  export_code qsort checking SML SML_imp OCaml? OCaml_imp? Haskell? Scala Scala_imp
   17.25  
    18.1 --- a/src/HOL/Imperative_HOL/ex/Linked_Lists.thy	Fri Feb 15 08:31:30 2013 +0100
    18.2 +++ b/src/HOL/Imperative_HOL/ex/Linked_Lists.thy	Fri Feb 15 08:31:31 2013 +0100
    18.3 @@ -5,7 +5,7 @@
    18.4  header {* Linked Lists by ML references *}
    18.5  
    18.6  theory Linked_Lists
    18.7 -imports "../Imperative_HOL" "~~/src/HOL/Library/Code_Integer"
    18.8 +imports "../Imperative_HOL" "~~/src/HOL/Library/Code_Target_Int"
    18.9  begin
   18.10  
   18.11  section {* Definition of Linked Lists *}
    19.1 --- a/src/HOL/Int.thy	Fri Feb 15 08:31:30 2013 +0100
    19.2 +++ b/src/HOL/Int.thy	Fri Feb 15 08:31:31 2013 +0100
    19.3 @@ -853,7 +853,7 @@
    19.4  apply (rule nat_mono, simp_all)
    19.5  done
    19.6  
    19.7 -lemma nat_numeral [simp, code_abbrev]:
    19.8 +lemma nat_numeral [simp]:
    19.9    "nat (numeral k) = numeral k"
   19.10    by (simp add: nat_eq_iff)
   19.11  
    20.1 --- a/src/HOL/Lazy_Sequence.thy	Fri Feb 15 08:31:30 2013 +0100
    20.2 +++ b/src/HOL/Lazy_Sequence.thy	Fri Feb 15 08:31:31 2013 +0100
    20.3 @@ -169,13 +169,14 @@
    20.4  where
    20.5    "those xq = Option.map lazy_sequence_of_list (List.those (list_of_lazy_sequence xq))"
    20.6    
    20.7 -function iterate_upto :: "(code_numeral \<Rightarrow> 'a) \<Rightarrow> code_numeral \<Rightarrow> code_numeral \<Rightarrow> 'a lazy_sequence"
    20.8 +function iterate_upto :: "(natural \<Rightarrow> 'a) \<Rightarrow> natural \<Rightarrow> natural \<Rightarrow> 'a lazy_sequence"
    20.9  where
   20.10    "iterate_upto f n m =
   20.11      Lazy_Sequence (\<lambda>_. if n > m then None else Some (f n, iterate_upto f (n + 1) m))"
   20.12    by pat_completeness auto
   20.13  
   20.14 -termination by (relation "measure (%(f, n, m). Code_Numeral.nat_of (m + 1 - n))") auto
   20.15 +termination by (relation "measure (\<lambda>(f, n, m). nat_of_natural (m + 1 - n))")
   20.16 +  (auto simp add: less_natural_def)
   20.17  
   20.18  definition not_seq :: "unit lazy_sequence \<Rightarrow> unit lazy_sequence"
   20.19  where
   20.20 @@ -225,7 +226,7 @@
   20.21  subsubsection {* Small lazy typeclasses *}
   20.22  
   20.23  class small_lazy =
   20.24 -  fixes small_lazy :: "code_numeral \<Rightarrow> 'a lazy_sequence"
   20.25 +  fixes small_lazy :: "natural \<Rightarrow> 'a lazy_sequence"
   20.26  
   20.27  instantiation unit :: small_lazy
   20.28  begin
   20.29 @@ -252,7 +253,7 @@
   20.30    by (relation "measure (%(d, i). nat (d + 1 - i))") auto
   20.31  
   20.32  definition
   20.33 -  "small_lazy d = small_lazy' (Code_Numeral.int_of d) (- (Code_Numeral.int_of d))"
   20.34 +  "small_lazy d = small_lazy' (int (nat_of_natural d)) (- (int (nat_of_natural d)))"
   20.35  
   20.36  instance ..
   20.37  
   20.38 @@ -271,7 +272,7 @@
   20.39  instantiation list :: (small_lazy) small_lazy
   20.40  begin
   20.41  
   20.42 -fun small_lazy_list :: "code_numeral \<Rightarrow> 'a list lazy_sequence"
   20.43 +fun small_lazy_list :: "natural \<Rightarrow> 'a list lazy_sequence"
   20.44  where
   20.45    "small_lazy_list d = append (single [])
   20.46      (if d > 0 then bind (product (small_lazy (d - 1))
    21.1 --- a/src/HOL/Library/Cardinality.thy	Fri Feb 15 08:31:30 2013 +0100
    21.2 +++ b/src/HOL/Library/Cardinality.thy	Fri Feb 15 08:31:31 2013 +0100
    21.3 @@ -225,11 +225,24 @@
    21.4  instance by intro_classes (simp_all add: card_UNIV_int_def finite_UNIV_int_def infinite_UNIV_int)
    21.5  end
    21.6  
    21.7 -instantiation code_numeral :: card_UNIV begin
    21.8 -definition "finite_UNIV = Phantom(code_numeral) False"
    21.9 -definition "card_UNIV = Phantom(code_numeral) 0"
   21.10 -instance
   21.11 -  by(intro_classes)(auto simp add: card_UNIV_code_numeral_def finite_UNIV_code_numeral_def type_definition.univ[OF type_definition_code_numeral] card_eq_0_iff dest!: finite_imageD intro: inj_onI)
   21.12 +instantiation natural :: card_UNIV begin
   21.13 +definition "finite_UNIV = Phantom(natural) False"
   21.14 +definition "card_UNIV = Phantom(natural) 0"
   21.15 +instance proof
   21.16 +qed (auto simp add: finite_UNIV_natural_def card_UNIV_natural_def card_eq_0_iff
   21.17 +  type_definition.univ [OF type_definition_natural] natural_eq_iff
   21.18 +  dest!: finite_imageD intro: inj_onI)
   21.19 +end
   21.20 +
   21.21 +declare [[show_consts]]
   21.22 +
   21.23 +instantiation integer :: card_UNIV begin
   21.24 +definition "finite_UNIV = Phantom(integer) False"
   21.25 +definition "card_UNIV = Phantom(integer) 0"
   21.26 +instance proof
   21.27 +qed (auto simp add: finite_UNIV_integer_def card_UNIV_integer_def card_eq_0_iff
   21.28 +  type_definition.univ [OF type_definition_integer] infinite_UNIV_int
   21.29 +  dest!: finite_imageD intro: inj_onI)
   21.30  end
   21.31  
   21.32  instantiation list :: (type) card_UNIV begin
    22.1 --- a/src/HOL/Library/Code_Binary_Nat.thy	Fri Feb 15 08:31:30 2013 +0100
    22.2 +++ b/src/HOL/Library/Code_Binary_Nat.thy	Fri Feb 15 08:31:31 2013 +0100
    22.3 @@ -21,10 +21,6 @@
    22.4  
    22.5  code_datatype "0::nat" nat_of_num
    22.6  
    22.7 -lemma [code_abbrev]:
    22.8 -  "nat_of_num = numeral"
    22.9 -  by (fact nat_of_num_numeral)
   22.10 -
   22.11  lemma [code]:
   22.12    "num_of_nat 0 = Num.One"
   22.13    "num_of_nat (nat_of_num k) = k"
    23.1 --- a/src/HOL/Library/Code_Char_chr.thy	Fri Feb 15 08:31:30 2013 +0100
    23.2 +++ b/src/HOL/Library/Code_Char_chr.thy	Fri Feb 15 08:31:31 2013 +0100
    23.3 @@ -5,7 +5,7 @@
    23.4  header {* Code generation of pretty characters with character codes *}
    23.5  
    23.6  theory Code_Char_chr
    23.7 -imports Char_nat Code_Char Code_Integer Main
    23.8 +imports Char_nat Code_Char Code_Target_Int Main
    23.9  begin
   23.10  
   23.11  definition
    24.1 --- a/src/HOL/Library/Code_Integer.thy	Fri Feb 15 08:31:30 2013 +0100
    24.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    24.3 @@ -1,161 +0,0 @@
    24.4 -(*  Title:      HOL/Library/Code_Integer.thy
    24.5 -    Author:     Florian Haftmann, TU Muenchen
    24.6 -*)
    24.7 -
    24.8 -header {* Pretty integer literals for code generation *}
    24.9 -
   24.10 -theory Code_Integer
   24.11 -imports Main Code_Natural
   24.12 -begin
   24.13 -
   24.14 -text {*
   24.15 -  Representation-ignorant code equations for conversions.
   24.16 -*}
   24.17 -
   24.18 -lemma nat_code [code]:
   24.19 -  "nat k = (if k \<le> 0 then 0 else
   24.20 -     let
   24.21 -       (l, j) = divmod_int k 2;
   24.22 -       n = nat l;
   24.23 -       l' = n + n
   24.24 -     in if j = 0 then l' else Suc l')"
   24.25 -proof -
   24.26 -  have "2 = nat 2" by simp
   24.27 -  show ?thesis
   24.28 -    apply (subst mult_2 [symmetric])
   24.29 -    apply (auto simp add: Let_def divmod_int_mod_div not_le
   24.30 -     nat_div_distrib nat_mult_distrib mult_div_cancel mod_2_not_eq_zero_eq_one_int)
   24.31 -    apply (unfold `2 = nat 2`)
   24.32 -    apply (subst nat_mod_distrib [symmetric])
   24.33 -    apply simp_all
   24.34 -  done
   24.35 -qed
   24.36 -
   24.37 -lemma (in ring_1) of_int_code:
   24.38 -  "of_int k = (if k = 0 then 0
   24.39 -     else if k < 0 then - of_int (- k)
   24.40 -     else let
   24.41 -       (l, j) = divmod_int k 2;
   24.42 -       l' = 2 * of_int l
   24.43 -     in if j = 0 then l' else l' + 1)"
   24.44 -proof -
   24.45 -  from mod_div_equality have *: "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp
   24.46 -  show ?thesis
   24.47 -    by (simp add: Let_def divmod_int_mod_div mod_2_not_eq_zero_eq_one_int
   24.48 -      of_int_add [symmetric]) (simp add: * mult_commute)
   24.49 -qed
   24.50 -
   24.51 -declare of_int_code [code]
   24.52 -
   24.53 -text {*
   24.54 -  HOL numeral expressions are mapped to integer literals
   24.55 -  in target languages, using predefined target language
   24.56 -  operations for abstract integer operations.
   24.57 -*}
   24.58 -
   24.59 -code_type int
   24.60 -  (SML "IntInf.int")
   24.61 -  (OCaml "Big'_int.big'_int")
   24.62 -  (Haskell "Integer")
   24.63 -  (Scala "BigInt")
   24.64 -  (Eval "int")
   24.65 -
   24.66 -code_instance int :: equal
   24.67 -  (Haskell -)
   24.68 -
   24.69 -code_const "0::int"
   24.70 -  (SML "0")
   24.71 -  (OCaml "Big'_int.zero'_big'_int")
   24.72 -  (Haskell "0")
   24.73 -  (Scala "BigInt(0)")
   24.74 -
   24.75 -setup {*
   24.76 -  fold (Numeral.add_code @{const_name Int.Pos}
   24.77 -    false Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
   24.78 -*}
   24.79 -
   24.80 -setup {*
   24.81 -  fold (Numeral.add_code @{const_name Int.Neg}
   24.82 -    true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
   24.83 -*}
   24.84 -
   24.85 -code_const "op + \<Colon> int \<Rightarrow> int \<Rightarrow> int"
   24.86 -  (SML "IntInf.+ ((_), (_))")
   24.87 -  (OCaml "Big'_int.add'_big'_int")
   24.88 -  (Haskell infixl 6 "+")
   24.89 -  (Scala infixl 7 "+")
   24.90 -  (Eval infixl 8 "+")
   24.91 -
   24.92 -code_const "uminus \<Colon> int \<Rightarrow> int"
   24.93 -  (SML "IntInf.~")
   24.94 -  (OCaml "Big'_int.minus'_big'_int")
   24.95 -  (Haskell "negate")
   24.96 -  (Scala "!(- _)")
   24.97 -  (Eval "~/ _")
   24.98 -
   24.99 -code_const "op - \<Colon> int \<Rightarrow> int \<Rightarrow> int"
  24.100 -  (SML "IntInf.- ((_), (_))")
  24.101 -  (OCaml "Big'_int.sub'_big'_int")
  24.102 -  (Haskell infixl 6 "-")
  24.103 -  (Scala infixl 7 "-")
  24.104 -  (Eval infixl 8 "-")
  24.105 -
  24.106 -code_const Int.dup
  24.107 -  (SML "IntInf.*/ (2,/ (_))")
  24.108 -  (OCaml "Big'_int.mult'_big'_int/ 2")
  24.109 -  (Haskell "!(2 * _)")
  24.110 -  (Scala "!(2 * _)")
  24.111 -  (Eval "!(2 * _)")
  24.112 -
  24.113 -code_const Int.sub
  24.114 -  (SML "!(raise/ Fail/ \"sub\")")
  24.115 -  (OCaml "failwith/ \"sub\"")
  24.116 -  (Haskell "error/ \"sub\"")
  24.117 -  (Scala "!sys.error(\"sub\")")
  24.118 -
  24.119 -code_const "op * \<Colon> int \<Rightarrow> int \<Rightarrow> int"
  24.120 -  (SML "IntInf.* ((_), (_))")
  24.121 -  (OCaml "Big'_int.mult'_big'_int")
  24.122 -  (Haskell infixl 7 "*")
  24.123 -  (Scala infixl 8 "*")
  24.124 -  (Eval infixl 9 "*")
  24.125 -
  24.126 -code_const pdivmod
  24.127 -  (SML "IntInf.divMod/ (IntInf.abs _,/ IntInf.abs _)")
  24.128 -  (OCaml "Big'_int.quomod'_big'_int/ (Big'_int.abs'_big'_int _)/ (Big'_int.abs'_big'_int _)")
  24.129 -  (Haskell "divMod/ (abs _)/ (abs _)")
  24.130 -  (Scala "!((k: BigInt) => (l: BigInt) =>/ if (l == 0)/ (BigInt(0), k) else/ (k.abs '/% l.abs))")
  24.131 -  (Eval "Integer.div'_mod/ (abs _)/ (abs _)")
  24.132 -
  24.133 -code_const "HOL.equal \<Colon> int \<Rightarrow> int \<Rightarrow> bool"
  24.134 -  (SML "!((_ : IntInf.int) = _)")
  24.135 -  (OCaml "Big'_int.eq'_big'_int")
  24.136 -  (Haskell infix 4 "==")
  24.137 -  (Scala infixl 5 "==")
  24.138 -  (Eval infixl 6 "=")
  24.139 -
  24.140 -code_const "op \<le> \<Colon> int \<Rightarrow> int \<Rightarrow> bool"
  24.141 -  (SML "IntInf.<= ((_), (_))")
  24.142 -  (OCaml "Big'_int.le'_big'_int")
  24.143 -  (Haskell infix 4 "<=")
  24.144 -  (Scala infixl 4 "<=")
  24.145 -  (Eval infixl 6 "<=")
  24.146 -
  24.147 -code_const "op < \<Colon> int \<Rightarrow> int \<Rightarrow> bool"
  24.148 -  (SML "IntInf.< ((_), (_))")
  24.149 -  (OCaml "Big'_int.lt'_big'_int")
  24.150 -  (Haskell infix 4 "<")
  24.151 -  (Scala infixl 4 "<")
  24.152 -  (Eval infixl 6 "<")
  24.153 -
  24.154 -code_const Code_Numeral.int_of
  24.155 -  (SML "IntInf.fromInt")
  24.156 -  (OCaml "_")
  24.157 -  (Haskell "Prelude.toInteger")
  24.158 -  (Scala "!_.as'_BigInt")
  24.159 -  (Eval "_")
  24.160 -
  24.161 -code_const "Code_Evaluation.term_of \<Colon> int \<Rightarrow> term"
  24.162 -  (Eval "HOLogic.mk'_number/ HOLogic.intT")
  24.163 -
  24.164 -end
    25.1 --- a/src/HOL/Library/Code_Natural.thy	Fri Feb 15 08:31:30 2013 +0100
    25.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    25.3 @@ -1,148 +0,0 @@
    25.4 -(*  Title:      HOL/Library/Code_Natural.thy
    25.5 -    Author:     Florian Haftmann, TU Muenchen
    25.6 -*)
    25.7 -
    25.8 -theory Code_Natural
    25.9 -imports "../Main"
   25.10 -begin
   25.11 -
   25.12 -section {* Alternative representation of @{typ code_numeral} for @{text Haskell} and @{text Scala} *}
   25.13 -
   25.14 -code_include Haskell "Natural"
   25.15 -{*import Data.Array.ST;
   25.16 -
   25.17 -newtype Natural = Natural Integer deriving (Eq, Show, Read);
   25.18 -
   25.19 -instance Num Natural where {
   25.20 -  fromInteger k = Natural (if k >= 0 then k else 0);
   25.21 -  Natural n + Natural m = Natural (n + m);
   25.22 -  Natural n - Natural m = fromInteger (n - m);
   25.23 -  Natural n * Natural m = Natural (n * m);
   25.24 -  abs n = n;
   25.25 -  signum _ = 1;
   25.26 -  negate n = error "negate Natural";
   25.27 -};
   25.28 -
   25.29 -instance Ord Natural where {
   25.30 -  Natural n <= Natural m = n <= m;
   25.31 -  Natural n < Natural m = n < m;
   25.32 -};
   25.33 -
   25.34 -instance Ix Natural where {
   25.35 -  range (Natural n, Natural m) = map Natural (range (n, m));
   25.36 -  index (Natural n, Natural m) (Natural q) = index (n, m) q;
   25.37 -  inRange (Natural n, Natural m) (Natural q) = inRange (n, m) q;
   25.38 -  rangeSize (Natural n, Natural m) = rangeSize (n, m);
   25.39 -};
   25.40 -
   25.41 -instance Real Natural where {
   25.42 -  toRational (Natural n) = toRational n;
   25.43 -};
   25.44 -
   25.45 -instance Enum Natural where {
   25.46 -  toEnum k = fromInteger (toEnum k);
   25.47 -  fromEnum (Natural n) = fromEnum n;
   25.48 -};
   25.49 -
   25.50 -instance Integral Natural where {
   25.51 -  toInteger (Natural n) = n;
   25.52 -  divMod n m = quotRem n m;
   25.53 -  quotRem (Natural n) (Natural m)
   25.54 -    | (m == 0) = (0, Natural n)
   25.55 -    | otherwise = (Natural k, Natural l) where (k, l) = quotRem n m;
   25.56 -};*}
   25.57 -
   25.58 -
   25.59 -code_reserved Haskell Natural
   25.60 -
   25.61 -code_include Scala "Natural"
   25.62 -{*object Natural {
   25.63 -
   25.64 -  def apply(numeral: BigInt): Natural = new Natural(numeral max 0)
   25.65 -  def apply(numeral: Int): Natural = Natural(BigInt(numeral))
   25.66 -  def apply(numeral: String): Natural = Natural(BigInt(numeral))
   25.67 -
   25.68 -}
   25.69 -
   25.70 -class Natural private(private val value: BigInt) {
   25.71 -
   25.72 -  override def hashCode(): Int = this.value.hashCode()
   25.73 -
   25.74 -  override def equals(that: Any): Boolean = that match {
   25.75 -    case that: Natural => this equals that
   25.76 -    case _ => false
   25.77 -  }
   25.78 -
   25.79 -  override def toString(): String = this.value.toString
   25.80 -
   25.81 -  def equals(that: Natural): Boolean = this.value == that.value
   25.82 -
   25.83 -  def as_BigInt: BigInt = this.value
   25.84 -  def as_Int: Int = if (this.value >= scala.Int.MinValue && this.value <= scala.Int.MaxValue)
   25.85 -      this.value.intValue
   25.86 -    else error("Int value out of range: " + this.value.toString)
   25.87 -
   25.88 -  def +(that: Natural): Natural = new Natural(this.value + that.value)
   25.89 -  def -(that: Natural): Natural = Natural(this.value - that.value)
   25.90 -  def *(that: Natural): Natural = new Natural(this.value * that.value)
   25.91 -
   25.92 -  def /%(that: Natural): (Natural, Natural) = if (that.value == 0) (new Natural(0), this)
   25.93 -    else {
   25.94 -      val (k, l) = this.value /% that.value
   25.95 -      (new Natural(k), new Natural(l))
   25.96 -    }
   25.97 -
   25.98 -  def <=(that: Natural): Boolean = this.value <= that.value
   25.99 -
  25.100 -  def <(that: Natural): Boolean = this.value < that.value
  25.101 -
  25.102 -}
  25.103 -*}
  25.104 -
  25.105 -code_reserved Scala Natural
  25.106 -
  25.107 -code_type code_numeral
  25.108 -  (Haskell "Natural.Natural")
  25.109 -  (Scala "Natural")
  25.110 -
  25.111 -setup {*
  25.112 -  fold (Numeral.add_code @{const_name Code_Numeral.Num}
  25.113 -    false Code_Printer.literal_alternative_numeral) ["Haskell", "Scala"]
  25.114 -*}
  25.115 -
  25.116 -code_instance code_numeral :: equal
  25.117 -  (Haskell -)
  25.118 -
  25.119 -code_const "0::code_numeral"
  25.120 -  (Haskell "0")
  25.121 -  (Scala "Natural(0)")
  25.122 -
  25.123 -code_const "plus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
  25.124 -  (Haskell infixl 6 "+")
  25.125 -  (Scala infixl 7 "+")
  25.126 -
  25.127 -code_const "minus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
  25.128 -  (Haskell infixl 6 "-")
  25.129 -  (Scala infixl 7 "-")
  25.130 -
  25.131 -code_const "times \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
  25.132 -  (Haskell infixl 7 "*")
  25.133 -  (Scala infixl 8 "*")
  25.134 -
  25.135 -code_const Code_Numeral.div_mod
  25.136 -  (Haskell "divMod")
  25.137 -  (Scala infixl 8 "/%")
  25.138 -
  25.139 -code_const "HOL.equal \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
  25.140 -  (Haskell infix 4 "==")
  25.141 -  (Scala infixl 5 "==")
  25.142 -
  25.143 -code_const "less_eq \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
  25.144 -  (Haskell infix 4 "<=")
  25.145 -  (Scala infixl 4 "<=")
  25.146 -
  25.147 -code_const "less \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
  25.148 -  (Haskell infix 4 "<")
  25.149 -  (Scala infixl 4 "<")
  25.150 -
  25.151 -end
    26.1 --- a/src/HOL/Library/Code_Numeral_Types.thy	Fri Feb 15 08:31:30 2013 +0100
    26.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    26.3 @@ -1,942 +0,0 @@
    26.4 -(*  Title:      HOL/Library/Code_Numeral_Types.thy
    26.5 -    Author:     Florian Haftmann, TU Muenchen
    26.6 -*)
    26.7 -
    26.8 -header {* Numeric types for code generation onto target language numerals only *}
    26.9 -
   26.10 -theory Code_Numeral_Types
   26.11 -imports Main Nat_Transfer Divides Lifting
   26.12 -begin
   26.13 -
   26.14 -subsection {* Type of target language integers *}
   26.15 -
   26.16 -typedef integer = "UNIV \<Colon> int set"
   26.17 -  morphisms int_of_integer integer_of_int ..
   26.18 -
   26.19 -setup_lifting (no_code) type_definition_integer
   26.20 -
   26.21 -lemma integer_eq_iff:
   26.22 -  "k = l \<longleftrightarrow> int_of_integer k = int_of_integer l"
   26.23 -  by transfer rule
   26.24 -
   26.25 -lemma integer_eqI:
   26.26 -  "int_of_integer k = int_of_integer l \<Longrightarrow> k = l"
   26.27 -  using integer_eq_iff [of k l] by simp
   26.28 -
   26.29 -lemma int_of_integer_integer_of_int [simp]:
   26.30 -  "int_of_integer (integer_of_int k) = k"
   26.31 -  by transfer rule
   26.32 -
   26.33 -lemma integer_of_int_int_of_integer [simp]:
   26.34 -  "integer_of_int (int_of_integer k) = k"
   26.35 -  by transfer rule
   26.36 -
   26.37 -instantiation integer :: ring_1
   26.38 -begin
   26.39 -
   26.40 -lift_definition zero_integer :: integer
   26.41 -  is "0 :: int"
   26.42 -  .
   26.43 -
   26.44 -declare zero_integer.rep_eq [simp]
   26.45 -
   26.46 -lift_definition one_integer :: integer
   26.47 -  is "1 :: int"
   26.48 -  .
   26.49 -
   26.50 -declare one_integer.rep_eq [simp]
   26.51 -
   26.52 -lift_definition plus_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
   26.53 -  is "plus :: int \<Rightarrow> int \<Rightarrow> int"
   26.54 -  .
   26.55 -
   26.56 -declare plus_integer.rep_eq [simp]
   26.57 -
   26.58 -lift_definition uminus_integer :: "integer \<Rightarrow> integer"
   26.59 -  is "uminus :: int \<Rightarrow> int"
   26.60 -  .
   26.61 -
   26.62 -declare uminus_integer.rep_eq [simp]
   26.63 -
   26.64 -lift_definition minus_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
   26.65 -  is "minus :: int \<Rightarrow> int \<Rightarrow> int"
   26.66 -  .
   26.67 -
   26.68 -declare minus_integer.rep_eq [simp]
   26.69 -
   26.70 -lift_definition times_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
   26.71 -  is "times :: int \<Rightarrow> int \<Rightarrow> int"
   26.72 -  .
   26.73 -
   26.74 -declare times_integer.rep_eq [simp]
   26.75 -
   26.76 -instance proof
   26.77 -qed (transfer, simp add: algebra_simps)+
   26.78 -
   26.79 -end
   26.80 -
   26.81 -lemma [transfer_rule]:
   26.82 -  "fun_rel HOL.eq cr_integer (of_nat :: nat \<Rightarrow> int) (of_nat :: nat \<Rightarrow> integer)"
   26.83 -  by (unfold of_nat_def [abs_def])  transfer_prover
   26.84 -
   26.85 -lemma [transfer_rule]:
   26.86 -  "fun_rel HOL.eq cr_integer (\<lambda>k :: int. k :: int) (of_int :: int \<Rightarrow> integer)"
   26.87 -proof -
   26.88 -  have "fun_rel HOL.eq cr_integer (of_int :: int \<Rightarrow> int) (of_int :: int \<Rightarrow> integer)"
   26.89 -    by (unfold of_int_of_nat [abs_def]) transfer_prover
   26.90 -  then show ?thesis by (simp add: id_def)
   26.91 -qed
   26.92 -
   26.93 -lemma [transfer_rule]:
   26.94 -  "fun_rel HOL.eq cr_integer (numeral :: num \<Rightarrow> int) (numeral :: num \<Rightarrow> integer)"
   26.95 -proof -
   26.96 -  have "fun_rel HOL.eq cr_integer (numeral :: num \<Rightarrow> int) (\<lambda>n. of_int (numeral n))"
   26.97 -    by transfer_prover
   26.98 -  then show ?thesis by simp
   26.99 -qed
  26.100 -
  26.101 -lemma [transfer_rule]:
  26.102 -  "fun_rel HOL.eq cr_integer (neg_numeral :: num \<Rightarrow> int) (neg_numeral :: num \<Rightarrow> integer)"
  26.103 -  by (unfold neg_numeral_def [abs_def]) transfer_prover
  26.104 -
  26.105 -lemma [transfer_rule]:
  26.106 -  "fun_rel HOL.eq (fun_rel HOL.eq cr_integer) (Num.sub :: _ \<Rightarrow> _ \<Rightarrow> int) (Num.sub :: _ \<Rightarrow> _ \<Rightarrow> integer)"
  26.107 -  by (unfold Num.sub_def [abs_def]) transfer_prover
  26.108 -
  26.109 -lemma int_of_integer_of_nat [simp]:
  26.110 -  "int_of_integer (of_nat n) = of_nat n"
  26.111 -  by transfer rule
  26.112 -
  26.113 -lift_definition integer_of_nat :: "nat \<Rightarrow> integer"
  26.114 -  is "of_nat :: nat \<Rightarrow> int"
  26.115 -  .
  26.116 -
  26.117 -lemma integer_of_nat_eq_of_nat [code]:
  26.118 -  "integer_of_nat = of_nat"
  26.119 -  by transfer rule
  26.120 -
  26.121 -lemma int_of_integer_integer_of_nat [simp]:
  26.122 -  "int_of_integer (integer_of_nat n) = of_nat n"
  26.123 -  by transfer rule
  26.124 -
  26.125 -lift_definition nat_of_integer :: "integer \<Rightarrow> nat"
  26.126 -  is Int.nat
  26.127 -  .
  26.128 -
  26.129 -lemma nat_of_integer_of_nat [simp]:
  26.130 -  "nat_of_integer (of_nat n) = n"
  26.131 -  by transfer simp
  26.132 -
  26.133 -lemma int_of_integer_of_int [simp]:
  26.134 -  "int_of_integer (of_int k) = k"
  26.135 -  by transfer simp
  26.136 -
  26.137 -lemma nat_of_integer_integer_of_nat [simp]:
  26.138 -  "nat_of_integer (integer_of_nat n) = n"
  26.139 -  by transfer simp
  26.140 -
  26.141 -lemma integer_of_int_eq_of_int [simp, code_abbrev]:
  26.142 -  "integer_of_int = of_int"
  26.143 -  by transfer (simp add: fun_eq_iff)
  26.144 -
  26.145 -lemma of_int_integer_of [simp]:
  26.146 -  "of_int (int_of_integer k) = (k :: integer)"
  26.147 -  by transfer rule
  26.148 -
  26.149 -lemma int_of_integer_numeral [simp]:
  26.150 -  "int_of_integer (numeral k) = numeral k"
  26.151 -  by transfer rule
  26.152 -
  26.153 -lemma int_of_integer_neg_numeral [simp]:
  26.154 -  "int_of_integer (neg_numeral k) = neg_numeral k"
  26.155 -  by transfer rule
  26.156 -
  26.157 -lemma int_of_integer_sub [simp]:
  26.158 -  "int_of_integer (Num.sub k l) = Num.sub k l"
  26.159 -  by transfer rule
  26.160 -
  26.161 -instantiation integer :: "{ring_div, equal, linordered_idom}"
  26.162 -begin
  26.163 -
  26.164 -lift_definition div_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
  26.165 -  is "Divides.div :: int \<Rightarrow> int \<Rightarrow> int"
  26.166 -  .
  26.167 -
  26.168 -declare div_integer.rep_eq [simp]
  26.169 -
  26.170 -lift_definition mod_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer"
  26.171 -  is "Divides.mod :: int \<Rightarrow> int \<Rightarrow> int"
  26.172 -  .
  26.173 -
  26.174 -declare mod_integer.rep_eq [simp]
  26.175 -
  26.176 -lift_definition abs_integer :: "integer \<Rightarrow> integer"
  26.177 -  is "abs :: int \<Rightarrow> int"
  26.178 -  .
  26.179 -
  26.180 -declare abs_integer.rep_eq [simp]
  26.181 -
  26.182 -lift_definition sgn_integer :: "integer \<Rightarrow> integer"
  26.183 -  is "sgn :: int \<Rightarrow> int"
  26.184 -  .
  26.185 -
  26.186 -declare sgn_integer.rep_eq [simp]
  26.187 -
  26.188 -lift_definition less_eq_integer :: "integer \<Rightarrow> integer \<Rightarrow> bool"
  26.189 -  is "less_eq :: int \<Rightarrow> int \<Rightarrow> bool"
  26.190 -  .
  26.191 -
  26.192 -lift_definition less_integer :: "integer \<Rightarrow> integer \<Rightarrow> bool"
  26.193 -  is "less :: int \<Rightarrow> int \<Rightarrow> bool"
  26.194 -  .
  26.195 -
  26.196 -lift_definition equal_integer :: "integer \<Rightarrow> integer \<Rightarrow> bool"
  26.197 -  is "HOL.equal :: int \<Rightarrow> int \<Rightarrow> bool"
  26.198 -  .
  26.199 -
  26.200 -instance proof
  26.201 -qed (transfer, simp add: algebra_simps equal less_le_not_le [symmetric] mult_strict_right_mono linear)+
  26.202 -
  26.203 -end
  26.204 -
  26.205 -lemma [transfer_rule]:
  26.206 -  "fun_rel cr_integer (fun_rel cr_integer cr_integer) (min :: _ \<Rightarrow> _ \<Rightarrow> int) (min :: _ \<Rightarrow> _ \<Rightarrow> integer)"
  26.207 -  by (unfold min_def [abs_def]) transfer_prover
  26.208 -
  26.209 -lemma [transfer_rule]:
  26.210 -  "fun_rel cr_integer (fun_rel cr_integer cr_integer) (max :: _ \<Rightarrow> _ \<Rightarrow> int) (max :: _ \<Rightarrow> _ \<Rightarrow> integer)"
  26.211 -  by (unfold max_def [abs_def]) transfer_prover
  26.212 -
  26.213 -lemma int_of_integer_min [simp]:
  26.214 -  "int_of_integer (min k l) = min (int_of_integer k) (int_of_integer l)"
  26.215 -  by transfer rule
  26.216 -
  26.217 -lemma int_of_integer_max [simp]:
  26.218 -  "int_of_integer (max k l) = max (int_of_integer k) (int_of_integer l)"
  26.219 -  by transfer rule
  26.220 -
  26.221 -lemma nat_of_integer_non_positive [simp]:
  26.222 -  "k \<le> 0 \<Longrightarrow> nat_of_integer k = 0"
  26.223 -  by transfer simp
  26.224 -
  26.225 -lemma of_nat_of_integer [simp]:
  26.226 -  "of_nat (nat_of_integer k) = max 0 k"
  26.227 -  by transfer auto
  26.228 -
  26.229 -
  26.230 -subsection {* Code theorems for target language integers *}
  26.231 -
  26.232 -text {* Constructors *}
  26.233 -
  26.234 -definition Pos :: "num \<Rightarrow> integer"
  26.235 -where
  26.236 -  [simp, code_abbrev]: "Pos = numeral"
  26.237 -
  26.238 -lemma [transfer_rule]:
  26.239 -  "fun_rel HOL.eq cr_integer numeral Pos"
  26.240 -  by simp transfer_prover
  26.241 -
  26.242 -definition Neg :: "num \<Rightarrow> integer"
  26.243 -where
  26.244 -  [simp, code_abbrev]: "Neg = neg_numeral"
  26.245 -
  26.246 -lemma [transfer_rule]:
  26.247 -  "fun_rel HOL.eq cr_integer neg_numeral Neg"
  26.248 -  by simp transfer_prover
  26.249 -
  26.250 -code_datatype "0::integer" Pos Neg
  26.251 -
  26.252 -
  26.253 -text {* Auxiliary operations *}
  26.254 -
  26.255 -lift_definition dup :: "integer \<Rightarrow> integer"
  26.256 -  is "\<lambda>k::int. k + k"
  26.257 -  .
  26.258 -
  26.259 -lemma dup_code [code]:
  26.260 -  "dup 0 = 0"
  26.261 -  "dup (Pos n) = Pos (Num.Bit0 n)"
  26.262 -  "dup (Neg n) = Neg (Num.Bit0 n)"
  26.263 -  by (transfer, simp only: neg_numeral_def numeral_Bit0 minus_add_distrib)+
  26.264 -
  26.265 -lift_definition sub :: "num \<Rightarrow> num \<Rightarrow> integer"
  26.266 -  is "\<lambda>m n. numeral m - numeral n :: int"
  26.267 -  .
  26.268 -
  26.269 -lemma sub_code [code]:
  26.270 -  "sub Num.One Num.One = 0"
  26.271 -  "sub (Num.Bit0 m) Num.One = Pos (Num.BitM m)"
  26.272 -  "sub (Num.Bit1 m) Num.One = Pos (Num.Bit0 m)"
  26.273 -  "sub Num.One (Num.Bit0 n) = Neg (Num.BitM n)"
  26.274 -  "sub Num.One (Num.Bit1 n) = Neg (Num.Bit0 n)"
  26.275 -  "sub (Num.Bit0 m) (Num.Bit0 n) = dup (sub m n)"
  26.276 -  "sub (Num.Bit1 m) (Num.Bit1 n) = dup (sub m n)"
  26.277 -  "sub (Num.Bit1 m) (Num.Bit0 n) = dup (sub m n) + 1"
  26.278 -  "sub (Num.Bit0 m) (Num.Bit1 n) = dup (sub m n) - 1"
  26.279 -  by (transfer, simp add: dbl_def dbl_inc_def dbl_dec_def)+
  26.280 -
  26.281 -
  26.282 -text {* Implementations *}
  26.283 -
  26.284 -lemma one_integer_code [code, code_unfold]:
  26.285 -  "1 = Pos Num.One"
  26.286 -  by simp
  26.287 -
  26.288 -lemma plus_integer_code [code]:
  26.289 -  "k + 0 = (k::integer)"
  26.290 -  "0 + l = (l::integer)"
  26.291 -  "Pos m + Pos n = Pos (m + n)"
  26.292 -  "Pos m + Neg n = sub m n"
  26.293 -  "Neg m + Pos n = sub n m"
  26.294 -  "Neg m + Neg n = Neg (m + n)"
  26.295 -  by (transfer, simp)+
  26.296 -
  26.297 -lemma uminus_integer_code [code]:
  26.298 -  "uminus 0 = (0::integer)"
  26.299 -  "uminus (Pos m) = Neg m"
  26.300 -  "uminus (Neg m) = Pos m"
  26.301 -  by simp_all
  26.302 -
  26.303 -lemma minus_integer_code [code]:
  26.304 -  "k - 0 = (k::integer)"
  26.305 -  "0 - l = uminus (l::integer)"
  26.306 -  "Pos m - Pos n = sub m n"
  26.307 -  "Pos m - Neg n = Pos (m + n)"
  26.308 -  "Neg m - Pos n = Neg (m + n)"
  26.309 -  "Neg m - Neg n = sub n m"
  26.310 -  by (transfer, simp)+
  26.311 -
  26.312 -lemma abs_integer_code [code]:
  26.313 -  "\<bar>k\<bar> = (if (k::integer) < 0 then - k else k)"
  26.314 -  by simp
  26.315 -
  26.316 -lemma sgn_integer_code [code]:
  26.317 -  "sgn k = (if k = 0 then 0 else if (k::integer) < 0 then - 1 else 1)"
  26.318 -  by simp
  26.319 -
  26.320 -lemma times_integer_code [code]:
  26.321 -  "k * 0 = (0::integer)"
  26.322 -  "0 * l = (0::integer)"
  26.323 -  "Pos m * Pos n = Pos (m * n)"
  26.324 -  "Pos m * Neg n = Neg (m * n)"
  26.325 -  "Neg m * Pos n = Neg (m * n)"
  26.326 -  "Neg m * Neg n = Pos (m * n)"
  26.327 -  by simp_all
  26.328 -
  26.329 -definition divmod_integer :: "integer \<Rightarrow> integer \<Rightarrow> integer \<times> integer"
  26.330 -where
  26.331 -  "divmod_integer k l = (k div l, k mod l)"
  26.332 -
  26.333 -lemma fst_divmod [simp]:
  26.334 -  "fst (divmod_integer k l) = k div l"
  26.335 -  by (simp add: divmod_integer_def)
  26.336 -
  26.337 -lemma snd_divmod [simp]:
  26.338 -  "snd (divmod_integer k l) = k mod l"
  26.339 -  by (simp add: divmod_integer_def)
  26.340 -
  26.341 -definition divmod_abs :: "integer \<Rightarrow> integer \<Rightarrow> integer \<times> integer"
  26.342 -where
  26.343 -  "divmod_abs k l = (\<bar>k\<bar> div \<bar>l\<bar>, \<bar>k\<bar> mod \<bar>l\<bar>)"
  26.344 -
  26.345 -lemma fst_divmod_abs [simp]:
  26.346 -  "fst (divmod_abs k l) = \<bar>k\<bar> div \<bar>l\<bar>"
  26.347 -  by (simp add: divmod_abs_def)
  26.348 -
  26.349 -lemma snd_divmod_abs [simp]:
  26.350 -  "snd (divmod_abs k l) = \<bar>k\<bar> mod \<bar>l\<bar>"
  26.351 -  by (simp add: divmod_abs_def)
  26.352 -
  26.353 -lemma divmod_abs_terminate_code [code]:
  26.354 -  "divmod_abs (Neg k) (Neg l) = divmod_abs (Pos k) (Pos l)"
  26.355 -  "divmod_abs (Neg k) (Pos l) = divmod_abs (Pos k) (Pos l)"
  26.356 -  "divmod_abs (Pos k) (Neg l) = divmod_abs (Pos k) (Pos l)"
  26.357 -  "divmod_abs j 0 = (0, \<bar>j\<bar>)"
  26.358 -  "divmod_abs 0 j = (0, 0)"
  26.359 -  by (simp_all add: prod_eq_iff)
  26.360 -
  26.361 -lemma divmod_abs_rec_code [code]:
  26.362 -  "divmod_abs (Pos k) (Pos l) =
  26.363 -    (let j = sub k l in
  26.364 -       if j < 0 then (0, Pos k)
  26.365 -       else let (q, r) = divmod_abs j (Pos l) in (q + 1, r))"
  26.366 -  apply (simp add: prod_eq_iff Let_def prod_case_beta)
  26.367 -  apply transfer
  26.368 -  apply (simp add: sub_non_negative sub_negative div_pos_pos_trivial mod_pos_pos_trivial div_pos_geq mod_pos_geq)
  26.369 -  done
  26.370 -
  26.371 -lemma divmod_integer_code [code]:
  26.372 -  "divmod_integer k l =
  26.373 -    (if k = 0 then (0, 0) else if l = 0 then (0, k) else
  26.374 -    (apsnd \<circ> times \<circ> sgn) l (if sgn k = sgn l
  26.375 -      then divmod_abs k l
  26.376 -      else (let (r, s) = divmod_abs k l in
  26.377 -        if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
  26.378 -proof -
  26.379 -  have aux1: "\<And>k l::int. sgn k = sgn l \<longleftrightarrow> k = 0 \<and> l = 0 \<or> 0 < l \<and> 0 < k \<or> l < 0 \<and> k < 0"
  26.380 -    by (auto simp add: sgn_if)
  26.381 -  have aux2: "\<And>q::int. - int_of_integer k = int_of_integer l * q \<longleftrightarrow> int_of_integer k = int_of_integer l * - q" by auto
  26.382 -  show ?thesis
  26.383 -    by (simp add: prod_eq_iff integer_eq_iff prod_case_beta aux1)
  26.384 -      (auto simp add: zdiv_zminus1_eq_if zmod_zminus1_eq_if div_minus_right mod_minus_right aux2)
  26.385 -qed
  26.386 -
  26.387 -lemma div_integer_code [code]:
  26.388 -  "k div l = fst (divmod_integer k l)"
  26.389 -  by simp
  26.390 -
  26.391 -lemma mod_integer_code [code]:
  26.392 -  "k mod l = snd (divmod_integer k l)"
  26.393 -  by simp
  26.394 -
  26.395 -lemma equal_integer_code [code]:
  26.396 -  "HOL.equal 0 (0::integer) \<longleftrightarrow> True"
  26.397 -  "HOL.equal 0 (Pos l) \<longleftrightarrow> False"
  26.398 -  "HOL.equal 0 (Neg l) \<longleftrightarrow> False"
  26.399 -  "HOL.equal (Pos k) 0 \<longleftrightarrow> False"
  26.400 -  "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l"
  26.401 -  "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False"
  26.402 -  "HOL.equal (Neg k) 0 \<longleftrightarrow> False"
  26.403 -  "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False"
  26.404 -  "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l"
  26.405 -  by (simp_all add: equal)
  26.406 -
  26.407 -lemma equal_integer_refl [code nbe]:
  26.408 -  "HOL.equal (k::integer) k \<longleftrightarrow> True"
  26.409 -  by (fact equal_refl)
  26.410 -
  26.411 -lemma less_eq_integer_code [code]:
  26.412 -  "0 \<le> (0::integer) \<longleftrightarrow> True"
  26.413 -  "0 \<le> Pos l \<longleftrightarrow> True"
  26.414 -  "0 \<le> Neg l \<longleftrightarrow> False"
  26.415 -  "Pos k \<le> 0 \<longleftrightarrow> False"
  26.416 -  "Pos k \<le> Pos l \<longleftrightarrow> k \<le> l"
  26.417 -  "Pos k \<le> Neg l \<longleftrightarrow> False"
  26.418 -  "Neg k \<le> 0 \<longleftrightarrow> True"
  26.419 -  "Neg k \<le> Pos l \<longleftrightarrow> True"
  26.420 -  "Neg k \<le> Neg l \<longleftrightarrow> l \<le> k"
  26.421 -  by simp_all
  26.422 -
  26.423 -lemma less_integer_code [code]:
  26.424 -  "0 < (0::integer) \<longleftrightarrow> False"
  26.425 -  "0 < Pos l \<longleftrightarrow> True"
  26.426 -  "0 < Neg l \<longleftrightarrow> False"
  26.427 -  "Pos k < 0 \<longleftrightarrow> False"
  26.428 -  "Pos k < Pos l \<longleftrightarrow> k < l"
  26.429 -  "Pos k < Neg l \<longleftrightarrow> False"
  26.430 -  "Neg k < 0 \<longleftrightarrow> True"
  26.431 -  "Neg k < Pos l \<longleftrightarrow> True"
  26.432 -  "Neg k < Neg l \<longleftrightarrow> l < k"
  26.433 -  by simp_all
  26.434 -
  26.435 -lift_definition integer_of_num :: "num \<Rightarrow> integer"
  26.436 -  is "numeral :: num \<Rightarrow> int"
  26.437 -  .
  26.438 -
  26.439 -lemma integer_of_num [code]:
  26.440 -  "integer_of_num num.One = 1"
  26.441 -  "integer_of_num (num.Bit0 n) = (let k = integer_of_num n in k + k)"
  26.442 -  "integer_of_num (num.Bit1 n) = (let k = integer_of_num n in k + k + 1)"
  26.443 -  by (transfer, simp only: numeral.simps Let_def)+
  26.444 -
  26.445 -lift_definition num_of_integer :: "integer \<Rightarrow> num"
  26.446 -  is "num_of_nat \<circ> nat"
  26.447 -  .
  26.448 -
  26.449 -lemma num_of_integer_code [code]:
  26.450 -  "num_of_integer k = (if k \<le> 1 then Num.One
  26.451 -     else let
  26.452 -       (l, j) = divmod_integer k 2;
  26.453 -       l' = num_of_integer l;
  26.454 -       l'' = l' + l'
  26.455 -     in if j = 0 then l'' else l'' + Num.One)"
  26.456 -proof -
  26.457 -  {
  26.458 -    assume "int_of_integer k mod 2 = 1"
  26.459 -    then have "nat (int_of_integer k mod 2) = nat 1" by simp
  26.460 -    moreover assume *: "1 < int_of_integer k"
  26.461 -    ultimately have **: "nat (int_of_integer k) mod 2 = 1" by (simp add: nat_mod_distrib)
  26.462 -    have "num_of_nat (nat (int_of_integer k)) =
  26.463 -      num_of_nat (2 * (nat (int_of_integer k) div 2) + nat (int_of_integer k) mod 2)"
  26.464 -      by simp
  26.465 -    then have "num_of_nat (nat (int_of_integer k)) =
  26.466 -      num_of_nat (nat (int_of_integer k) div 2 + nat (int_of_integer k) div 2 + nat (int_of_integer k) mod 2)"
  26.467 -      by (simp add: mult_2)
  26.468 -    with ** have "num_of_nat (nat (int_of_integer k)) =
  26.469 -      num_of_nat (nat (int_of_integer k) div 2 + nat (int_of_integer k) div 2 + 1)"
  26.470 -      by simp
  26.471 -  }
  26.472 -  note aux = this
  26.473 -  show ?thesis
  26.474 -    by (auto simp add: num_of_integer_def nat_of_integer_def Let_def prod_case_beta
  26.475 -      not_le integer_eq_iff less_eq_integer_def
  26.476 -      nat_mult_distrib nat_div_distrib num_of_nat_One num_of_nat_plus_distrib
  26.477 -       mult_2 [where 'a=nat] aux add_One)
  26.478 -qed
  26.479 -
  26.480 -lemma nat_of_integer_code [code]:
  26.481 -  "nat_of_integer k = (if k \<le> 0 then 0
  26.482 -     else let
  26.483 -       (l, j) = divmod_integer k 2;
  26.484 -       l' = nat_of_integer l;
  26.485 -       l'' = l' + l'
  26.486 -     in if j = 0 then l'' else l'' + 1)"
  26.487 -proof -
  26.488 -  obtain j where "k = integer_of_int j"
  26.489 -  proof
  26.490 -    show "k = integer_of_int (int_of_integer k)" by simp
  26.491 -  qed
  26.492 -  moreover have "2 * (j div 2) = j - j mod 2"
  26.493 -    by (simp add: zmult_div_cancel mult_commute)
  26.494 -  ultimately show ?thesis
  26.495 -    by (auto simp add: split_def Let_def mod_integer_def nat_of_integer_def not_le
  26.496 -      nat_add_distrib [symmetric] Suc_nat_eq_nat_zadd1)
  26.497 -qed
  26.498 -
  26.499 -lemma int_of_integer_code [code]:
  26.500 -  "int_of_integer k = (if k < 0 then - (int_of_integer (- k))
  26.501 -     else if k = 0 then 0
  26.502 -     else let
  26.503 -       (l, j) = divmod_integer k 2;
  26.504 -       l' = 2 * int_of_integer l
  26.505 -     in if j = 0 then l' else l' + 1)"
  26.506 -  by (auto simp add: split_def Let_def integer_eq_iff zmult_div_cancel)
  26.507 -
  26.508 -lemma integer_of_int_code [code]:
  26.509 -  "integer_of_int k = (if k < 0 then - (integer_of_int (- k))
  26.510 -     else if k = 0 then 0
  26.511 -     else let
  26.512 -       (l, j) = divmod_int k 2;
  26.513 -       l' = 2 * integer_of_int l
  26.514 -     in if j = 0 then l' else l' + 1)"
  26.515 -  by (auto simp add: split_def Let_def integer_eq_iff zmult_div_cancel)
  26.516 -
  26.517 -hide_const (open) Pos Neg sub dup divmod_abs
  26.518 -
  26.519 -
  26.520 -subsection {* Serializer setup for target language integers *}
  26.521 -
  26.522 -code_reserved Eval abs
  26.523 -
  26.524 -code_type integer
  26.525 -  (SML "IntInf.int")
  26.526 -  (OCaml "Big'_int.big'_int")
  26.527 -  (Haskell "Integer")
  26.528 -  (Scala "BigInt")
  26.529 -  (Eval "int")
  26.530 -
  26.531 -code_instance integer :: equal
  26.532 -  (Haskell -)
  26.533 -
  26.534 -code_const "0::integer"
  26.535 -  (SML "0")
  26.536 -  (OCaml "Big'_int.zero'_big'_int")
  26.537 -  (Haskell "0")
  26.538 -  (Scala "BigInt(0)")
  26.539 -
  26.540 -setup {*
  26.541 -  fold (Numeral.add_code @{const_name Code_Numeral_Types.Pos}
  26.542 -    false Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
  26.543 -*}
  26.544 -
  26.545 -setup {*
  26.546 -  fold (Numeral.add_code @{const_name Code_Numeral_Types.Neg}
  26.547 -    true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
  26.548 -*}
  26.549 -
  26.550 -code_const "plus :: integer \<Rightarrow> _ \<Rightarrow> _"
  26.551 -  (SML "IntInf.+ ((_), (_))")
  26.552 -  (OCaml "Big'_int.add'_big'_int")
  26.553 -  (Haskell infixl 6 "+")
  26.554 -  (Scala infixl 7 "+")
  26.555 -  (Eval infixl 8 "+")
  26.556 -
  26.557 -code_const "uminus :: integer \<Rightarrow> _"
  26.558 -  (SML "IntInf.~")
  26.559 -  (OCaml "Big'_int.minus'_big'_int")
  26.560 -  (Haskell "negate")
  26.561 -  (Scala "!(- _)")
  26.562 -  (Eval "~/ _")
  26.563 -
  26.564 -code_const "minus :: integer \<Rightarrow> _"
  26.565 -  (SML "IntInf.- ((_), (_))")
  26.566 -  (OCaml "Big'_int.sub'_big'_int")
  26.567 -  (Haskell infixl 6 "-")
  26.568 -  (Scala infixl 7 "-")
  26.569 -  (Eval infixl 8 "-")
  26.570 -
  26.571 -code_const Code_Numeral_Types.dup
  26.572 -  (SML "IntInf.*/ (2,/ (_))")
  26.573 -  (OCaml "Big'_int.mult'_big'_int/ (Big'_int.big'_int'_of'_int/ 2)")
  26.574 -  (Haskell "!(2 * _)")
  26.575 -  (Scala "!(2 * _)")
  26.576 -  (Eval "!(2 * _)")
  26.577 -
  26.578 -code_const Code_Numeral_Types.sub
  26.579 -  (SML "!(raise/ Fail/ \"sub\")")
  26.580 -  (OCaml "failwith/ \"sub\"")
  26.581 -  (Haskell "error/ \"sub\"")
  26.582 -  (Scala "!sys.error(\"sub\")")
  26.583 -
  26.584 -code_const "times :: integer \<Rightarrow> _ \<Rightarrow> _"
  26.585 -  (SML "IntInf.* ((_), (_))")
  26.586 -  (OCaml "Big'_int.mult'_big'_int")
  26.587 -  (Haskell infixl 7 "*")
  26.588 -  (Scala infixl 8 "*")
  26.589 -  (Eval infixl 9 "*")
  26.590 -
  26.591 -code_const Code_Numeral_Types.divmod_abs
  26.592 -  (SML "IntInf.divMod/ (IntInf.abs _,/ IntInf.abs _)")
  26.593 -  (OCaml "Big'_int.quomod'_big'_int/ (Big'_int.abs'_big'_int _)/ (Big'_int.abs'_big'_int _)")
  26.594 -  (Haskell "divMod/ (abs _)/ (abs _)")
  26.595 -  (Scala "!((k: BigInt) => (l: BigInt) =>/ if (l == 0)/ (BigInt(0), k) else/ (k.abs '/% l.abs))")
  26.596 -  (Eval "Integer.div'_mod/ (abs _)/ (abs _)")
  26.597 -
  26.598 -code_const "HOL.equal :: integer \<Rightarrow> _ \<Rightarrow> bool"
  26.599 -  (SML "!((_ : IntInf.int) = _)")
  26.600 -  (OCaml "Big'_int.eq'_big'_int")
  26.601 -  (Haskell infix 4 "==")
  26.602 -  (Scala infixl 5 "==")
  26.603 -  (Eval infixl 6 "=")
  26.604 -
  26.605 -code_const "less_eq :: integer \<Rightarrow> _ \<Rightarrow> bool"
  26.606 -  (SML "IntInf.<= ((_), (_))")
  26.607 -  (OCaml "Big'_int.le'_big'_int")
  26.608 -  (Haskell infix 4 "<=")
  26.609 -  (Scala infixl 4 "<=")
  26.610 -  (Eval infixl 6 "<=")
  26.611 -
  26.612 -code_const "less :: integer \<Rightarrow> _ \<Rightarrow> bool"
  26.613 -  (SML "IntInf.< ((_), (_))")
  26.614 -  (OCaml "Big'_int.lt'_big'_int")
  26.615 -  (Haskell infix 4 "<")
  26.616 -  (Scala infixl 4 "<")
  26.617 -  (Eval infixl 6 "<")
  26.618 -
  26.619 -code_modulename SML
  26.620 -  Code_Numeral_Types Arith
  26.621 -
  26.622 -code_modulename OCaml
  26.623 -  Code_Numeral_Types Arith
  26.624 -
  26.625 -code_modulename Haskell
  26.626 -  Code_Numeral_Types Arith
  26.627 -
  26.628 -
  26.629 -subsection {* Type of target language naturals *}
  26.630 -
  26.631 -typedef natural = "UNIV \<Colon> nat set"
  26.632 -  morphisms nat_of_natural natural_of_nat ..
  26.633 -
  26.634 -setup_lifting (no_code) type_definition_natural
  26.635 -
  26.636 -lemma natural_eq_iff [termination_simp]:
  26.637 -  "m = n \<longleftrightarrow> nat_of_natural m = nat_of_natural n"
  26.638 -  by transfer rule
  26.639 -
  26.640 -lemma natural_eqI:
  26.641 -  "nat_of_natural m = nat_of_natural n \<Longrightarrow> m = n"
  26.642 -  using natural_eq_iff [of m n] by simp
  26.643 -
  26.644 -lemma nat_of_natural_of_nat_inverse [simp]:
  26.645 -  "nat_of_natural (natural_of_nat n) = n"
  26.646 -  by transfer rule
  26.647 -
  26.648 -lemma natural_of_nat_of_natural_inverse [simp]:
  26.649 -  "natural_of_nat (nat_of_natural n) = n"
  26.650 -  by transfer rule
  26.651 -
  26.652 -instantiation natural :: "{comm_monoid_diff, semiring_1}"
  26.653 -begin
  26.654 -
  26.655 -lift_definition zero_natural :: natural
  26.656 -  is "0 :: nat"
  26.657 -  .
  26.658 -
  26.659 -declare zero_natural.rep_eq [simp]
  26.660 -
  26.661 -lift_definition one_natural :: natural
  26.662 -  is "1 :: nat"
  26.663 -  .
  26.664 -
  26.665 -declare one_natural.rep_eq [simp]
  26.666 -
  26.667 -lift_definition plus_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
  26.668 -  is "plus :: nat \<Rightarrow> nat \<Rightarrow> nat"
  26.669 -  .
  26.670 -
  26.671 -declare plus_natural.rep_eq [simp]
  26.672 -
  26.673 -lift_definition minus_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
  26.674 -  is "minus :: nat \<Rightarrow> nat \<Rightarrow> nat"
  26.675 -  .
  26.676 -
  26.677 -declare minus_natural.rep_eq [simp]
  26.678 -
  26.679 -lift_definition times_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
  26.680 -  is "times :: nat \<Rightarrow> nat \<Rightarrow> nat"
  26.681 -  .
  26.682 -
  26.683 -declare times_natural.rep_eq [simp]
  26.684 -
  26.685 -instance proof
  26.686 -qed (transfer, simp add: algebra_simps)+
  26.687 -
  26.688 -end
  26.689 -
  26.690 -lemma [transfer_rule]:
  26.691 -  "fun_rel HOL.eq cr_natural (\<lambda>n::nat. n) (of_nat :: nat \<Rightarrow> natural)"
  26.692 -proof -
  26.693 -  have "fun_rel HOL.eq cr_natural (of_nat :: nat \<Rightarrow> nat) (of_nat :: nat \<Rightarrow> natural)"
  26.694 -    by (unfold of_nat_def [abs_def]) transfer_prover
  26.695 -  then show ?thesis by (simp add: id_def)
  26.696 -qed
  26.697 -
  26.698 -lemma [transfer_rule]:
  26.699 -  "fun_rel HOL.eq cr_natural (numeral :: num \<Rightarrow> nat) (numeral :: num \<Rightarrow> natural)"
  26.700 -proof -
  26.701 -  have "fun_rel HOL.eq cr_natural (numeral :: num \<Rightarrow> nat) (\<lambda>n. of_nat (numeral n))"
  26.702 -    by transfer_prover
  26.703 -  then show ?thesis by simp
  26.704 -qed
  26.705 -
  26.706 -lemma nat_of_natural_of_nat [simp]:
  26.707 -  "nat_of_natural (of_nat n) = n"
  26.708 -  by transfer rule
  26.709 -
  26.710 -lemma natural_of_nat_of_nat [simp, code_abbrev]:
  26.711 -  "natural_of_nat = of_nat"
  26.712 -  by transfer rule
  26.713 -
  26.714 -lemma of_nat_of_natural [simp]:
  26.715 -  "of_nat (nat_of_natural n) = n"
  26.716 -  by transfer rule
  26.717 -
  26.718 -lemma nat_of_natural_numeral [simp]:
  26.719 -  "nat_of_natural (numeral k) = numeral k"
  26.720 -  by transfer rule
  26.721 -
  26.722 -instantiation natural :: "{semiring_div, equal, linordered_semiring}"
  26.723 -begin
  26.724 -
  26.725 -lift_definition div_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
  26.726 -  is "Divides.div :: nat \<Rightarrow> nat \<Rightarrow> nat"
  26.727 -  .
  26.728 -
  26.729 -declare div_natural.rep_eq [simp]
  26.730 -
  26.731 -lift_definition mod_natural :: "natural \<Rightarrow> natural \<Rightarrow> natural"
  26.732 -  is "Divides.mod :: nat \<Rightarrow> nat \<Rightarrow> nat"
  26.733 -  .
  26.734 -
  26.735 -declare mod_natural.rep_eq [simp]
  26.736 -
  26.737 -lift_definition less_eq_natural :: "natural \<Rightarrow> natural \<Rightarrow> bool"
  26.738 -  is "less_eq :: nat \<Rightarrow> nat \<Rightarrow> bool"
  26.739 -  .
  26.740 -
  26.741 -declare less_eq_natural.rep_eq [termination_simp]
  26.742 -
  26.743 -lift_definition less_natural :: "natural \<Rightarrow> natural \<Rightarrow> bool"
  26.744 -  is "less :: nat \<Rightarrow> nat \<Rightarrow> bool"
  26.745 -  .
  26.746 -
  26.747 -declare less_natural.rep_eq [termination_simp]
  26.748 -
  26.749 -lift_definition equal_natural :: "natural \<Rightarrow> natural \<Rightarrow> bool"
  26.750 -  is "HOL.equal :: nat \<Rightarrow> nat \<Rightarrow> bool"
  26.751 -  .
  26.752 -
  26.753 -instance proof
  26.754 -qed (transfer, simp add: algebra_simps equal less_le_not_le [symmetric] linear)+
  26.755 -
  26.756 -end
  26.757 -
  26.758 -lemma [transfer_rule]:
  26.759 -  "fun_rel cr_natural (fun_rel cr_natural cr_natural) (min :: _ \<Rightarrow> _ \<Rightarrow> nat) (min :: _ \<Rightarrow> _ \<Rightarrow> natural)"
  26.760 -  by (unfold min_def [abs_def]) transfer_prover
  26.761 -
  26.762 -lemma [transfer_rule]:
  26.763 -  "fun_rel cr_natural (fun_rel cr_natural cr_natural) (max :: _ \<Rightarrow> _ \<Rightarrow> nat) (max :: _ \<Rightarrow> _ \<Rightarrow> natural)"
  26.764 -  by (unfold max_def [abs_def]) transfer_prover
  26.765 -
  26.766 -lemma nat_of_natural_min [simp]:
  26.767 -  "nat_of_natural (min k l) = min (nat_of_natural k) (nat_of_natural l)"
  26.768 -  by transfer rule
  26.769 -
  26.770 -lemma nat_of_natural_max [simp]:
  26.771 -  "nat_of_natural (max k l) = max (nat_of_natural k) (nat_of_natural l)"
  26.772 -  by transfer rule
  26.773 -
  26.774 -lift_definition natural_of_integer :: "integer \<Rightarrow> natural"
  26.775 -  is "nat :: int \<Rightarrow> nat"
  26.776 -  .
  26.777 -
  26.778 -lift_definition integer_of_natural :: "natural \<Rightarrow> integer"
  26.779 -  is "of_nat :: nat \<Rightarrow> int"
  26.780 -  .
  26.781 -
  26.782 -lemma natural_of_integer_of_natural [simp]:
  26.783 -  "natural_of_integer (integer_of_natural n) = n"
  26.784 -  by transfer simp
  26.785 -
  26.786 -lemma integer_of_natural_of_integer [simp]:
  26.787 -  "integer_of_natural (natural_of_integer k) = max 0 k"
  26.788 -  by transfer auto
  26.789 -
  26.790 -lemma int_of_integer_of_natural [simp]:
  26.791 -  "int_of_integer (integer_of_natural n) = of_nat (nat_of_natural n)"
  26.792 -  by transfer rule
  26.793 -
  26.794 -lemma integer_of_natural_of_nat [simp]:
  26.795 -  "integer_of_natural (of_nat n) = of_nat n"
  26.796 -  by transfer rule
  26.797 -
  26.798 -lemma [measure_function]:
  26.799 -  "is_measure nat_of_natural"
  26.800 -  by (rule is_measure_trivial)
  26.801 -
  26.802 -
  26.803 -subsection {* Inductive represenation of target language naturals *}
  26.804 -
  26.805 -lift_definition Suc :: "natural \<Rightarrow> natural"
  26.806 -  is Nat.Suc
  26.807 -  .
  26.808 -
  26.809 -declare Suc.rep_eq [simp]
  26.810 -
  26.811 -rep_datatype "0::natural" Suc
  26.812 -  by (transfer, fact nat.induct nat.inject nat.distinct)+
  26.813 -
  26.814 -lemma natural_case [case_names nat, cases type: natural]:
  26.815 -  fixes m :: natural
  26.816 -  assumes "\<And>n. m = of_nat n \<Longrightarrow> P"
  26.817 -  shows P
  26.818 -  using assms by transfer blast
  26.819 -
  26.820 -lemma [simp, code]:
  26.821 -  "natural_size = nat_of_natural"
  26.822 -proof (rule ext)
  26.823 -  fix n
  26.824 -  show "natural_size n = nat_of_natural n"
  26.825 -    by (induct n) simp_all
  26.826 -qed
  26.827 -
  26.828 -lemma [simp, code]:
  26.829 -  "size = nat_of_natural"
  26.830 -proof (rule ext)
  26.831 -  fix n
  26.832 -  show "size n = nat_of_natural n"
  26.833 -    by (induct n) simp_all
  26.834 -qed
  26.835 -
  26.836 -lemma natural_decr [termination_simp]:
  26.837 -  "n \<noteq> 0 \<Longrightarrow> nat_of_natural n - Nat.Suc 0 < nat_of_natural n"
  26.838 -  by transfer simp
  26.839 -
  26.840 -lemma natural_zero_minus_one:
  26.841 -  "(0::natural) - 1 = 0"
  26.842 -  by simp
  26.843 -
  26.844 -lemma Suc_natural_minus_one:
  26.845 -  "Suc n - 1 = n"
  26.846 -  by transfer simp
  26.847 -
  26.848 -hide_const (open) Suc
  26.849 -
  26.850 -
  26.851 -subsection {* Code refinement for target language naturals *}
  26.852 -
  26.853 -lift_definition Nat :: "integer \<Rightarrow> natural"
  26.854 -  is nat
  26.855 -  .
  26.856 -
  26.857 -lemma [code_post]:
  26.858 -  "Nat 0 = 0"
  26.859 -  "Nat 1 = 1"
  26.860 -  "Nat (numeral k) = numeral k"
  26.861 -  by (transfer, simp)+
  26.862 -
  26.863 -lemma [code abstype]:
  26.864 -  "Nat (integer_of_natural n) = n"
  26.865 -  by transfer simp
  26.866 -
  26.867 -lemma [code abstract]:
  26.868 -  "integer_of_natural (natural_of_nat n) = of_nat n"
  26.869 -  by simp
  26.870 -
  26.871 -lemma [code abstract]:
  26.872 -  "integer_of_natural (natural_of_integer k) = max 0 k"
  26.873 -  by simp
  26.874 -
  26.875 -lemma [code_abbrev]:
  26.876 -  "natural_of_integer (Code_Numeral_Types.Pos k) = numeral k"
  26.877 -  by transfer simp
  26.878 -
  26.879 -lemma [code abstract]:
  26.880 -  "integer_of_natural 0 = 0"
  26.881 -  by transfer simp
  26.882 -
  26.883 -lemma [code abstract]:
  26.884 -  "integer_of_natural 1 = 1"
  26.885 -  by transfer simp
  26.886 -
  26.887 -lemma [code abstract]:
  26.888 -  "integer_of_natural (Code_Numeral_Types.Suc n) = integer_of_natural n + 1"
  26.889 -  by transfer simp
  26.890 -
  26.891 -lemma [code]:
  26.892 -  "nat_of_natural = nat_of_integer \<circ> integer_of_natural"
  26.893 -  by transfer (simp add: fun_eq_iff)
  26.894 -
  26.895 -lemma [code, code_unfold]:
  26.896 -  "natural_case f g n = (if n = 0 then f else g (n - 1))"
  26.897 -  by (cases n rule: natural.exhaust) (simp_all, simp add: Suc_def)
  26.898 -
  26.899 -declare natural.recs [code del]
  26.900 -
  26.901 -lemma [code abstract]:
  26.902 -  "integer_of_natural (m + n) = integer_of_natural m + integer_of_natural n"
  26.903 -  by transfer simp
  26.904 -
  26.905 -lemma [code abstract]:
  26.906 -  "integer_of_natural (m - n) = max 0 (integer_of_natural m - integer_of_natural n)"
  26.907 -  by transfer simp
  26.908 -
  26.909 -lemma [code abstract]:
  26.910 -  "integer_of_natural (m * n) = integer_of_natural m * integer_of_natural n"
  26.911 -  by transfer (simp add: of_nat_mult)
  26.912 -
  26.913 -lemma [code abstract]:
  26.914 -  "integer_of_natural (m div n) = integer_of_natural m div integer_of_natural n"
  26.915 -  by transfer (simp add: zdiv_int)
  26.916 -
  26.917 -lemma [code abstract]:
  26.918 -  "integer_of_natural (m mod n) = integer_of_natural m mod integer_of_natural n"
  26.919 -  by transfer (simp add: zmod_int)
  26.920 -
  26.921 -lemma [code]:
  26.922 -  "HOL.equal m n \<longleftrightarrow> HOL.equal (integer_of_natural m) (integer_of_natural n)"
  26.923 -  by transfer (simp add: equal)
  26.924 -
  26.925 -lemma [code nbe]:
  26.926 -  "HOL.equal n (n::natural) \<longleftrightarrow> True"
  26.927 -  by (simp add: equal)
  26.928 -
  26.929 -lemma [code]:
  26.930 -  "m \<le> n \<longleftrightarrow> integer_of_natural m \<le> integer_of_natural n"
  26.931 -  by transfer simp
  26.932 -
  26.933 -lemma [code]:
  26.934 -  "m < n \<longleftrightarrow> integer_of_natural m < integer_of_natural n"
  26.935 -  by transfer simp
  26.936 -
  26.937 -hide_const (open) Nat
  26.938 -
  26.939 -
  26.940 -code_reflect Code_Numeral_Types
  26.941 -  datatypes natural = _
  26.942 -  functions integer_of_natural natural_of_integer
  26.943 -
  26.944 -end
  26.945 -
    27.1 --- a/src/HOL/Library/Code_Real_Approx_By_Float.thy	Fri Feb 15 08:31:30 2013 +0100
    27.2 +++ b/src/HOL/Library/Code_Real_Approx_By_Float.thy	Fri Feb 15 08:31:31 2013 +0100
    27.3 @@ -1,7 +1,7 @@
    27.4  (* Authors: Florian Haftmann, Johannes Hölzl, Tobias Nipkow *)
    27.5  
    27.6  theory Code_Real_Approx_By_Float
    27.7 -imports Complex_Main "~~/src/HOL/Library/Code_Integer"
    27.8 +imports Complex_Main "~~/src/HOL/Library/Code_Target_Int"
    27.9  begin
   27.10  
   27.11  text{* \textbf{WARNING} This theory implements mathematical reals by machine
   27.12 @@ -119,15 +119,19 @@
   27.13    (OCaml "Pervasives.asin")
   27.14  declare arcsin_def[code del]
   27.15  
   27.16 -definition real_of_int :: "int \<Rightarrow> real" where
   27.17 -  "real_of_int \<equiv> of_int"
   27.18 +definition real_of_integer :: "integer \<Rightarrow> real" where
   27.19 +  "real_of_integer = of_int \<circ> int_of_integer"
   27.20  
   27.21 -code_const real_of_int
   27.22 +code_const real_of_integer
   27.23    (SML "Real.fromInt")
   27.24    (OCaml "Pervasives.float (Big'_int.int'_of'_big'_int (_))")
   27.25  
   27.26 -lemma of_int_eq_real_of_int[code_unfold]: "of_int = real_of_int"
   27.27 -  unfolding real_of_int_def ..
   27.28 +definition real_of_int :: "int \<Rightarrow> real" where
   27.29 +  [code_abbrev]: "real_of_int = of_int"
   27.30 +
   27.31 +lemma [code]:
   27.32 +  "real_of_int = real_of_integer \<circ> integer_of_int"
   27.33 +  by (simp add: fun_eq_iff real_of_integer_def real_of_int_def)
   27.34  
   27.35  lemma [code_unfold del]:
   27.36    "0 \<equiv> (of_rat 0 :: real)"
   27.37 @@ -155,3 +159,4 @@
   27.38  end
   27.39  
   27.40  end
   27.41 +
    28.1 --- a/src/HOL/Library/Code_Target_Int.thy	Fri Feb 15 08:31:30 2013 +0100
    28.2 +++ b/src/HOL/Library/Code_Target_Int.thy	Fri Feb 15 08:31:31 2013 +0100
    28.3 @@ -5,7 +5,7 @@
    28.4  header {* Implementation of integer numbers by target-language integers *}
    28.5  
    28.6  theory Code_Target_Int
    28.7 -imports Main "~~/src/HOL/Library/Code_Numeral_Types"
    28.8 +imports Main
    28.9  begin
   28.10  
   28.11  code_datatype int_of_integer
   28.12 @@ -54,7 +54,7 @@
   28.13    by transfer simp
   28.14  
   28.15  lemma [code]:
   28.16 -  "Int.dup k = int_of_integer (Code_Numeral_Types.dup (of_int k))"
   28.17 +  "Int.dup k = int_of_integer (Code_Numeral.dup (of_int k))"
   28.18    by transfer simp
   28.19  
   28.20  lemma [code, code del]:
   28.21 @@ -66,7 +66,7 @@
   28.22  
   28.23  lemma [code]:
   28.24    "pdivmod k l = map_pair int_of_integer int_of_integer
   28.25 -    (Code_Numeral_Types.divmod_abs (of_int k) (of_int l))"
   28.26 +    (Code_Numeral.divmod_abs (of_int k) (of_int l))"
   28.27    by (simp add: prod_eq_iff pdivmod_def)
   28.28  
   28.29  lemma [code]:
    29.1 --- a/src/HOL/Library/Code_Target_Nat.thy	Fri Feb 15 08:31:30 2013 +0100
    29.2 +++ b/src/HOL/Library/Code_Target_Nat.thy	Fri Feb 15 08:31:31 2013 +0100
    29.3 @@ -5,7 +5,7 @@
    29.4  header {* Implementation of natural numbers by target-language integers *}
    29.5  
    29.6  theory Code_Target_Nat
    29.7 -imports Code_Abstract_Nat Code_Numeral_Types
    29.8 +imports Code_Abstract_Nat
    29.9  begin
   29.10  
   29.11  subsection {* Implementation for @{typ nat} *}
    30.1 --- a/src/HOL/Library/DAList.thy	Fri Feb 15 08:31:30 2013 +0100
    30.2 +++ b/src/HOL/Library/DAList.thy	Fri Feb 15 08:31:31 2013 +0100
    30.3 @@ -136,7 +136,7 @@
    30.4  instantiation alist :: (exhaustive, exhaustive) exhaustive
    30.5  begin
    30.6  
    30.7 -fun exhaustive_alist :: "(('a, 'b) alist => (bool * term list) option) => code_numeral => (bool * term list) option"
    30.8 +fun exhaustive_alist :: "(('a, 'b) alist => (bool * term list) option) => natural => (bool * term list) option"
    30.9  where
   30.10    "exhaustive_alist f i = (if i = 0 then None else case f empty of Some ts => Some ts | None =>
   30.11       exhaustive_alist (%a. Quickcheck_Exhaustive.exhaustive (%k. Quickcheck_Exhaustive.exhaustive (%v. f (update k v a)) (i - 1)) (i - 1)) (i - 1))"
   30.12 @@ -148,7 +148,7 @@
   30.13  instantiation alist :: (full_exhaustive, full_exhaustive) full_exhaustive
   30.14  begin
   30.15  
   30.16 -fun full_exhaustive_alist :: "(('a, 'b) alist * (unit => term) => (bool * term list) option) => code_numeral => (bool * term list) option"
   30.17 +fun full_exhaustive_alist :: "(('a, 'b) alist * (unit => term) => (bool * term list) option) => natural => (bool * term list) option"
   30.18  where
   30.19    "full_exhaustive_alist f i = (if i = 0 then None else case f valterm_empty of Some ts => Some ts | None =>
   30.20       full_exhaustive_alist (%a. Quickcheck_Exhaustive.full_exhaustive (%k. Quickcheck_Exhaustive.full_exhaustive (%v. f (valterm_update k v a)) (i - 1)) (i - 1)) (i - 1))"
    31.1 --- a/src/HOL/Library/Efficient_Nat.thy	Fri Feb 15 08:31:30 2013 +0100
    31.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    31.3 @@ -1,305 +0,0 @@
    31.4 -(*  Title:      HOL/Library/Efficient_Nat.thy
    31.5 -    Author:     Stefan Berghofer, Florian Haftmann, TU Muenchen
    31.6 -*)
    31.7 -
    31.8 -header {* Implementation of natural numbers by target-language integers *}
    31.9 -
   31.10 -theory Efficient_Nat
   31.11 -imports Code_Binary_Nat Code_Integer Main
   31.12 -begin
   31.13 -
   31.14 -text {*
   31.15 -  The efficiency of the generated code for natural numbers can be improved
   31.16 -  drastically by implementing natural numbers by target-language
   31.17 -  integers.  To do this, just include this theory.
   31.18 -*}
   31.19 -
   31.20 -subsection {* Target language fundamentals *}
   31.21 -
   31.22 -text {*
   31.23 -  For ML, we map @{typ nat} to target language integers, where we
   31.24 -  ensure that values are always non-negative.
   31.25 -*}
   31.26 -
   31.27 -code_type nat
   31.28 -  (SML "IntInf.int")
   31.29 -  (OCaml "Big'_int.big'_int")
   31.30 -  (Eval "int")
   31.31 -
   31.32 -text {*
   31.33 -  For Haskell and Scala we define our own @{typ nat} type.  The reason
   31.34 -  is that we have to distinguish type class instances for @{typ nat}
   31.35 -  and @{typ int}.
   31.36 -*}
   31.37 -
   31.38 -code_include Haskell "Nat"
   31.39 -{*newtype Nat = Nat Integer deriving (Eq, Show, Read);
   31.40 -
   31.41 -instance Num Nat where {
   31.42 -  fromInteger k = Nat (if k >= 0 then k else 0);
   31.43 -  Nat n + Nat m = Nat (n + m);
   31.44 -  Nat n - Nat m = fromInteger (n - m);
   31.45 -  Nat n * Nat m = Nat (n * m);
   31.46 -  abs n = n;
   31.47 -  signum _ = 1;
   31.48 -  negate n = error "negate Nat";
   31.49 -};
   31.50 -
   31.51 -instance Ord Nat where {
   31.52 -  Nat n <= Nat m = n <= m;
   31.53 -  Nat n < Nat m = n < m;
   31.54 -};
   31.55 -
   31.56 -instance Real Nat where {
   31.57 -  toRational (Nat n) = toRational n;
   31.58 -};
   31.59 -
   31.60 -instance Enum Nat where {
   31.61 -  toEnum k = fromInteger (toEnum k);
   31.62 -  fromEnum (Nat n) = fromEnum n;
   31.63 -};
   31.64 -
   31.65 -instance Integral Nat where {
   31.66 -  toInteger (Nat n) = n;
   31.67 -  divMod n m = quotRem n m;
   31.68 -  quotRem (Nat n) (Nat m)
   31.69 -    | (m == 0) = (0, Nat n)
   31.70 -    | otherwise = (Nat k, Nat l) where (k, l) = quotRem n m;
   31.71 -};
   31.72 -*}
   31.73 -
   31.74 -code_reserved Haskell Nat
   31.75 -
   31.76 -code_include Scala "Nat"
   31.77 -{*object Nat {
   31.78 -
   31.79 -  def apply(numeral: BigInt): Nat = new Nat(numeral max 0)
   31.80 -  def apply(numeral: Int): Nat = Nat(BigInt(numeral))
   31.81 -  def apply(numeral: String): Nat = Nat(BigInt(numeral))
   31.82 -
   31.83 -}
   31.84 -
   31.85 -class Nat private(private val value: BigInt) {
   31.86 -
   31.87 -  override def hashCode(): Int = this.value.hashCode()
   31.88 -
   31.89 -  override def equals(that: Any): Boolean = that match {
   31.90 -    case that: Nat => this equals that
   31.91 -    case _ => false
   31.92 -  }
   31.93 -
   31.94 -  override def toString(): String = this.value.toString
   31.95 -
   31.96 -  def equals(that: Nat): Boolean = this.value == that.value
   31.97 -
   31.98 -  def as_BigInt: BigInt = this.value
   31.99 -  def as_Int: Int = if (this.value >= scala.Int.MinValue && this.value <= scala.Int.MaxValue)
  31.100 -      this.value.intValue
  31.101 -    else error("Int value out of range: " + this.value.toString)
  31.102 -
  31.103 -  def +(that: Nat): Nat = new Nat(this.value + that.value)
  31.104 -  def -(that: Nat): Nat = Nat(this.value - that.value)
  31.105 -  def *(that: Nat): Nat = new Nat(this.value * that.value)
  31.106 -
  31.107 -  def /%(that: Nat): (Nat, Nat) = if (that.value == 0) (new Nat(0), this)
  31.108 -    else {
  31.109 -      val (k, l) = this.value /% that.value
  31.110 -      (new Nat(k), new Nat(l))
  31.111 -    }
  31.112 -
  31.113 -  def <=(that: Nat): Boolean = this.value <= that.value
  31.114 -
  31.115 -  def <(that: Nat): Boolean = this.value < that.value
  31.116 -
  31.117 -}
  31.118 -*}
  31.119 -
  31.120 -code_reserved Scala Nat
  31.121 -
  31.122 -code_type nat
  31.123 -  (Haskell "Nat.Nat")
  31.124 -  (Scala "Nat")
  31.125 -
  31.126 -code_instance nat :: equal
  31.127 -  (Haskell -)
  31.128 -
  31.129 -setup {*
  31.130 -  fold (Numeral.add_code @{const_name nat_of_num}
  31.131 -    false Code_Printer.literal_positive_numeral) ["SML", "OCaml", "Haskell", "Scala"]
  31.132 -*}
  31.133 -
  31.134 -code_const "0::nat"
  31.135 -  (SML "0")
  31.136 -  (OCaml "Big'_int.zero'_big'_int")
  31.137 -  (Haskell "0")
  31.138 -  (Scala "Nat(0)")
  31.139 -
  31.140 -
  31.141 -subsection {* Conversions *}
  31.142 -
  31.143 -text {*
  31.144 -  Since natural numbers are implemented
  31.145 -  using integers in ML, the coercion function @{term "int"} of type
  31.146 -  @{typ "nat \<Rightarrow> int"} is simply implemented by the identity function.
  31.147 -  For the @{const nat} function for converting an integer to a natural
  31.148 -  number, we give a specific implementation using an ML expression that
  31.149 -  returns its input value, provided that it is non-negative, and otherwise
  31.150 -  returns @{text "0"}.
  31.151 -*}
  31.152 -
  31.153 -definition int :: "nat \<Rightarrow> int" where
  31.154 -  [code_abbrev]: "int = of_nat"
  31.155 -
  31.156 -code_const int
  31.157 -  (SML "_")
  31.158 -  (OCaml "_")
  31.159 -
  31.160 -code_const nat
  31.161 -  (SML "IntInf.max/ (0,/ _)")
  31.162 -  (OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int")
  31.163 -  (Eval "Integer.max/ 0")
  31.164 -
  31.165 -text {* For Haskell and Scala, things are slightly different again. *}
  31.166 -
  31.167 -code_const int and nat
  31.168 -  (Haskell "Prelude.toInteger" and "Prelude.fromInteger")
  31.169 -  (Scala "!_.as'_BigInt" and "Nat")
  31.170 -
  31.171 -text {* Alternativ implementation for @{const of_nat} *}
  31.172 -
  31.173 -lemma [code]:
  31.174 -  "of_nat n = (if n = 0 then 0 else
  31.175 -     let
  31.176 -       (q, m) = divmod_nat n 2;
  31.177 -       q' = 2 * of_nat q
  31.178 -     in if m = 0 then q' else q' + 1)"
  31.179 -proof -
  31.180 -  from mod_div_equality have *: "of_nat n = of_nat (n div 2 * 2 + n mod 2)" by simp
  31.181 -  show ?thesis
  31.182 -    apply (simp add: Let_def divmod_nat_div_mod mod_2_not_eq_zero_eq_one_nat
  31.183 -      of_nat_mult
  31.184 -      of_nat_add [symmetric])
  31.185 -    apply (auto simp add: of_nat_mult)
  31.186 -    apply (simp add: * of_nat_mult add_commute mult_commute)
  31.187 -    done
  31.188 -qed
  31.189 -
  31.190 -text {* Conversion from and to code numerals *}
  31.191 -
  31.192 -code_const Code_Numeral.of_nat
  31.193 -  (SML "IntInf.toInt")
  31.194 -  (OCaml "_")
  31.195 -  (Haskell "!(Prelude.fromInteger/ ./ Prelude.toInteger)")
  31.196 -  (Scala "!Natural(_.as'_BigInt)")
  31.197 -  (Eval "_")
  31.198 -
  31.199 -code_const Code_Numeral.nat_of
  31.200 -  (SML "IntInf.fromInt")
  31.201 -  (OCaml "_")
  31.202 -  (Haskell "!(Prelude.fromInteger/ ./ Prelude.toInteger)")
  31.203 -  (Scala "!Nat(_.as'_BigInt)")
  31.204 -  (Eval "_")
  31.205 -
  31.206 -
  31.207 -subsection {* Target language arithmetic *}
  31.208 -
  31.209 -code_const "plus \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  31.210 -  (SML "IntInf.+/ ((_),/ (_))")
  31.211 -  (OCaml "Big'_int.add'_big'_int")
  31.212 -  (Haskell infixl 6 "+")
  31.213 -  (Scala infixl 7 "+")
  31.214 -  (Eval infixl 8 "+")
  31.215 -
  31.216 -code_const "minus \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  31.217 -  (SML "IntInf.max/ (0, IntInf.-/ ((_),/ (_)))")
  31.218 -  (OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int/ (Big'_int.sub'_big'_int/ _/ _)")
  31.219 -  (Haskell infixl 6 "-")
  31.220 -  (Scala infixl 7 "-")
  31.221 -  (Eval "Integer.max/ 0/ (_ -/ _)")
  31.222 -
  31.223 -code_const Code_Binary_Nat.dup
  31.224 -  (SML "IntInf.*/ (2,/ (_))")
  31.225 -  (OCaml "Big'_int.mult'_big'_int/ 2")
  31.226 -  (Haskell "!(2 * _)")
  31.227 -  (Scala "!(2 * _)")
  31.228 -  (Eval "!(2 * _)")
  31.229 -
  31.230 -code_const Code_Binary_Nat.sub
  31.231 -  (SML "!(raise/ Fail/ \"sub\")")
  31.232 -  (OCaml "failwith/ \"sub\"")
  31.233 -  (Haskell "error/ \"sub\"")
  31.234 -  (Scala "!sys.error(\"sub\")")
  31.235 -
  31.236 -code_const "times \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
  31.237 -  (SML "IntInf.*/ ((_),/ (_))")
  31.238 -  (OCaml "Big'_int.mult'_big'_int")
  31.239 -  (Haskell infixl 7 "*")
  31.240 -  (Scala infixl 8 "*")
  31.241 -  (Eval infixl 9 "*")
  31.242 -
  31.243 -code_const divmod_nat
  31.244 -  (SML "IntInf.divMod/ ((_),/ (_))")
  31.245 -  (OCaml "Big'_int.quomod'_big'_int")
  31.246 -  (Haskell "divMod")
  31.247 -  (Scala infixl 8 "/%")
  31.248 -  (Eval "Integer.div'_mod")
  31.249 -
  31.250 -code_const "HOL.equal \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
  31.251 -  (SML "!((_ : IntInf.int) = _)")
  31.252 -  (OCaml "Big'_int.eq'_big'_int")
  31.253 -  (Haskell infix 4 "==")
  31.254 -  (Scala infixl 5 "==")
  31.255 -  (Eval infixl 6 "=")
  31.256 -
  31.257 -code_const "less_eq \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
  31.258 -  (SML "IntInf.<=/ ((_),/ (_))")
  31.259 -  (OCaml "Big'_int.le'_big'_int")
  31.260 -  (Haskell infix 4 "<=")
  31.261 -  (Scala infixl 4 "<=")
  31.262 -  (Eval infixl 6 "<=")
  31.263 -
  31.264 -code_const "less \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
  31.265 -  (SML "IntInf.</ ((_),/ (_))")
  31.266 -  (OCaml "Big'_int.lt'_big'_int")
  31.267 -  (Haskell infix 4 "<")
  31.268 -  (Scala infixl 4 "<")
  31.269 -  (Eval infixl 6 "<")
  31.270 -
  31.271 -code_const Num.num_of_nat
  31.272 -  (SML "!(raise/ Fail/ \"num'_of'_nat\")")
  31.273 -  (OCaml "failwith/ \"num'_of'_nat\"")
  31.274 -  (Haskell "error/ \"num'_of'_nat\"")
  31.275 -  (Scala "!sys.error(\"num'_of'_nat\")")
  31.276 -
  31.277 -
  31.278 -subsection {* Evaluation *}
  31.279 -
  31.280 -lemma [code, code del]:
  31.281 -  "(Code_Evaluation.term_of \<Colon> nat \<Rightarrow> term) = Code_Evaluation.term_of" ..
  31.282 -
  31.283 -code_const "Code_Evaluation.term_of \<Colon> nat \<Rightarrow> term"
  31.284 -  (SML "HOLogic.mk'_number/ HOLogic.natT")
  31.285 -
  31.286 -text {*
  31.287 -  Evaluation with @{text "Quickcheck_Narrowing"} does not work yet,
  31.288 -  since a couple of questions how to perform evaluations in Haskell are not that
  31.289 -  clear yet.  Therefore, we simply deactivate the narrowing-based quickcheck
  31.290 -  from here on.
  31.291 -*}
  31.292 -
  31.293 -declare [[quickcheck_narrowing_active = false]] 
  31.294 -
  31.295 -
  31.296 -code_modulename SML
  31.297 -  Efficient_Nat Arith
  31.298 -
  31.299 -code_modulename OCaml
  31.300 -  Efficient_Nat Arith
  31.301 -
  31.302 -code_modulename Haskell
  31.303 -  Efficient_Nat Arith
  31.304 -
  31.305 -hide_const (open) int
  31.306 -
  31.307 -end
  31.308 -
    32.1 --- a/src/HOL/Library/IArray.thy	Fri Feb 15 08:31:30 2013 +0100
    32.2 +++ b/src/HOL/Library/IArray.thy	Fri Feb 15 08:31:31 2013 +0100
    32.3 @@ -46,34 +46,34 @@
    32.4  code_const IArray
    32.5    (SML "Vector.fromList")
    32.6  
    32.7 -primrec tabulate :: "code_numeral \<times> (code_numeral \<Rightarrow> 'a) \<Rightarrow> 'a iarray" where
    32.8 -"tabulate (n, f) = IArray (map (f \<circ> Code_Numeral.of_nat) [0..<Code_Numeral.nat_of n])"
    32.9 +primrec tabulate :: "integer \<times> (integer \<Rightarrow> 'a) \<Rightarrow> 'a iarray" where
   32.10 +"tabulate (n, f) = IArray (map (f \<circ> integer_of_nat) [0..<nat_of_integer n])"
   32.11  hide_const (open) tabulate
   32.12  
   32.13  lemma [code]:
   32.14 -"IArray.of_fun f n = IArray.tabulate (Code_Numeral.of_nat n, f \<circ> Code_Numeral.nat_of)"
   32.15 +"IArray.of_fun f n = IArray.tabulate (integer_of_nat n, f \<circ> nat_of_integer)"
   32.16  by simp 
   32.17  
   32.18  code_const IArray.tabulate
   32.19    (SML "Vector.tabulate")
   32.20  
   32.21 -primrec sub' :: "'a iarray \<times> code_numeral \<Rightarrow> 'a" where
   32.22 -"sub' (as, n) = IArray.list_of as ! Code_Numeral.nat_of n"
   32.23 +primrec sub' :: "'a iarray \<times> integer \<Rightarrow> 'a" where
   32.24 +"sub' (as, n) = IArray.list_of as ! nat_of_integer n"
   32.25  hide_const (open) sub'
   32.26  
   32.27  lemma [code]:
   32.28 -"as !! n = IArray.sub' (as, Code_Numeral.of_nat n)"
   32.29 +"as !! n = IArray.sub' (as, integer_of_nat n)"
   32.30  by simp
   32.31  
   32.32  code_const IArray.sub'
   32.33    (SML "Vector.sub")
   32.34  
   32.35 -definition length' :: "'a iarray \<Rightarrow> code_numeral" where
   32.36 -[simp]: "length' as = Code_Numeral.of_nat (List.length (IArray.list_of as))"
   32.37 +definition length' :: "'a iarray \<Rightarrow> integer" where
   32.38 +[simp]: "length' as = integer_of_nat (List.length (IArray.list_of as))"
   32.39  hide_const (open) length'
   32.40  
   32.41  lemma [code]:
   32.42 -"IArray.length as = Code_Numeral.nat_of (IArray.length' as)"
   32.43 +"IArray.length as = nat_of_integer (IArray.length' as)"
   32.44  by simp
   32.45  
   32.46  code_const IArray.length'
    33.1 --- a/src/HOL/Library/Multiset.thy	Fri Feb 15 08:31:30 2013 +0100
    33.2 +++ b/src/HOL/Library/Multiset.thy	Fri Feb 15 08:31:31 2013 +0100
    33.3 @@ -1326,7 +1326,7 @@
    33.4  instantiation multiset :: (exhaustive) exhaustive
    33.5  begin
    33.6  
    33.7 -definition exhaustive_multiset :: "('a multiset => (bool * term list) option) => code_numeral => (bool * term list) option"
    33.8 +definition exhaustive_multiset :: "('a multiset => (bool * term list) option) => natural => (bool * term list) option"
    33.9  where
   33.10    "exhaustive_multiset f i = Quickcheck_Exhaustive.exhaustive (%xs. f (Bag xs)) i"
   33.11  
   33.12 @@ -1337,7 +1337,7 @@
   33.13  instantiation multiset :: (full_exhaustive) full_exhaustive
   33.14  begin
   33.15  
   33.16 -definition full_exhaustive_multiset :: "('a multiset * (unit => term) => (bool * term list) option) => code_numeral => (bool * term list) option"
   33.17 +definition full_exhaustive_multiset :: "('a multiset * (unit => term) => (bool * term list) option) => natural => (bool * term list) option"
   33.18  where
   33.19    "full_exhaustive_multiset f i = Quickcheck_Exhaustive.full_exhaustive (%xs. f (bagify xs)) i"
   33.20  
    34.1 --- a/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy	Fri Feb 15 08:31:30 2013 +0100
    34.2 +++ b/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy	Fri Feb 15 08:31:31 2013 +0100
    34.3 @@ -99,10 +99,10 @@
    34.4      end
    34.5    fun enumerate_addups_nat compfuns (_ : typ) =
    34.6      absdummy @{typ nat} (Predicate_Compile_Aux.mk_iterate_upto compfuns @{typ "nat * nat"}
    34.7 -    (absdummy @{typ code_numeral} (@{term "Pair :: nat => nat => nat * nat"} $
    34.8 -      (@{term "Code_Numeral.nat_of"} $ Bound 0) $
    34.9 -      (@{term "op - :: nat => nat => nat"} $ Bound 1 $ (@{term "Code_Numeral.nat_of"} $ Bound 0))),
   34.10 -      @{term "0 :: code_numeral"}, @{term "Code_Numeral.of_nat"} $ Bound 0))
   34.11 +    (absdummy @{typ natural} (@{term "Pair :: nat => nat => nat * nat"} $
   34.12 +      (@{term "nat_of_natural"} $ Bound 0) $
   34.13 +      (@{term "op - :: nat => nat => nat"} $ Bound 1 $ (@{term "nat_of_natural"} $ Bound 0))),
   34.14 +      @{term "0 :: natural"}, @{term "natural_of_nat"} $ Bound 0))
   34.15    fun enumerate_nats compfuns  (_ : typ) =
   34.16      let
   34.17        val (single_const, _) = strip_comb (Predicate_Compile_Aux.mk_single compfuns @{term "0 :: nat"})
   34.18 @@ -111,8 +111,8 @@
   34.19        absdummy @{typ nat} (absdummy @{typ nat}
   34.20          (Const (@{const_name If}, @{typ bool} --> T --> T --> T) $
   34.21            (@{term "op = :: nat => nat => bool"} $ Bound 0 $ @{term "0::nat"}) $
   34.22 -          (Predicate_Compile_Aux.mk_iterate_upto compfuns @{typ nat} (@{term "Code_Numeral.nat_of"},
   34.23 -            @{term "0::code_numeral"}, @{term "Code_Numeral.of_nat"} $ Bound 1)) $
   34.24 +          (Predicate_Compile_Aux.mk_iterate_upto compfuns @{typ nat} (@{term "nat_of_natural"},
   34.25 +            @{term "0::natural"}, @{term "natural_of_nat"} $ Bound 1)) $
   34.26              (single_const $ (@{term "op + :: nat => nat => nat"} $ Bound 1 $ Bound 0))))
   34.27      end
   34.28  in
    35.1 --- a/src/HOL/Library/Predicate_Compile_Quickcheck.thy	Fri Feb 15 08:31:30 2013 +0100
    35.2 +++ b/src/HOL/Library/Predicate_Compile_Quickcheck.thy	Fri Feb 15 08:31:31 2013 +0100
    35.3 @@ -10,4 +10,4 @@
    35.4  
    35.5  setup {* Predicate_Compile_Quickcheck.setup *}
    35.6  
    35.7 -end
    35.8 \ No newline at end of file
    35.9 +end
    36.1 --- a/src/HOL/Limited_Sequence.thy	Fri Feb 15 08:31:30 2013 +0100
    36.2 +++ b/src/HOL/Limited_Sequence.thy	Fri Feb 15 08:31:31 2013 +0100
    36.3 @@ -9,7 +9,7 @@
    36.4  
    36.5  subsection {* Depth-Limited Sequence *}
    36.6  
    36.7 -type_synonym 'a dseq = "code_numeral \<Rightarrow> bool \<Rightarrow> 'a lazy_sequence option"
    36.8 +type_synonym 'a dseq = "natural \<Rightarrow> bool \<Rightarrow> 'a lazy_sequence option"
    36.9  
   36.10  definition empty :: "'a dseq"
   36.11  where
   36.12 @@ -19,11 +19,11 @@
   36.13  where
   36.14    "single x = (\<lambda>_ _. Some (Lazy_Sequence.single x))"
   36.15  
   36.16 -definition eval :: "'a dseq \<Rightarrow> code_numeral \<Rightarrow> bool \<Rightarrow> 'a lazy_sequence option"
   36.17 +definition eval :: "'a dseq \<Rightarrow> natural \<Rightarrow> bool \<Rightarrow> 'a lazy_sequence option"
   36.18  where
   36.19    [simp]: "eval f i pol = f i pol"
   36.20  
   36.21 -definition yield :: "'a dseq \<Rightarrow> code_numeral \<Rightarrow> bool \<Rightarrow> ('a \<times> 'a dseq) option" 
   36.22 +definition yield :: "'a dseq \<Rightarrow> natural \<Rightarrow> bool \<Rightarrow> ('a \<times> 'a dseq) option" 
   36.23  where
   36.24    "yield f i pol = (case eval f i pol of
   36.25      None \<Rightarrow> None
   36.26 @@ -82,7 +82,7 @@
   36.27  
   36.28  subsection {* Positive Depth-Limited Sequence *}
   36.29  
   36.30 -type_synonym 'a pos_dseq = "code_numeral \<Rightarrow> 'a Lazy_Sequence.lazy_sequence"
   36.31 +type_synonym 'a pos_dseq = "natural \<Rightarrow> 'a Lazy_Sequence.lazy_sequence"
   36.32  
   36.33  definition pos_empty :: "'a pos_dseq"
   36.34  where
   36.35 @@ -112,7 +112,7 @@
   36.36  where
   36.37    "pos_if_seq b = (if b then pos_single () else pos_empty)"
   36.38  
   36.39 -definition pos_iterate_upto :: "(code_numeral \<Rightarrow> 'a) \<Rightarrow> code_numeral \<Rightarrow> code_numeral \<Rightarrow> 'a pos_dseq"
   36.40 +definition pos_iterate_upto :: "(natural \<Rightarrow> 'a) \<Rightarrow> natural \<Rightarrow> natural \<Rightarrow> 'a pos_dseq"
   36.41  where
   36.42    "pos_iterate_upto f n m = (\<lambda>i. Lazy_Sequence.iterate_upto f n m)"
   36.43   
   36.44 @@ -123,7 +123,7 @@
   36.45  
   36.46  subsection {* Negative Depth-Limited Sequence *}
   36.47  
   36.48 -type_synonym 'a neg_dseq = "code_numeral \<Rightarrow> 'a Lazy_Sequence.hit_bound_lazy_sequence"
   36.49 +type_synonym 'a neg_dseq = "natural \<Rightarrow> 'a Lazy_Sequence.hit_bound_lazy_sequence"
   36.50  
   36.51  definition neg_empty :: "'a neg_dseq"
   36.52  where
   36.53 @@ -178,16 +178,16 @@
   36.54  ML {*
   36.55  signature LIMITED_SEQUENCE =
   36.56  sig
   36.57 -  type 'a dseq = int -> bool -> 'a Lazy_Sequence.lazy_sequence option
   36.58 +  type 'a dseq = Code_Numeral.natural -> bool -> 'a Lazy_Sequence.lazy_sequence option
   36.59    val map : ('a -> 'b) -> 'a dseq -> 'b dseq
   36.60 -  val yield : 'a dseq -> int -> bool -> ('a * 'a dseq) option
   36.61 -  val yieldn : int -> 'a dseq -> int -> bool -> 'a list * 'a dseq
   36.62 +  val yield : 'a dseq -> Code_Numeral.natural -> bool -> ('a * 'a dseq) option
   36.63 +  val yieldn : int -> 'a dseq -> Code_Numeral.natural -> bool -> 'a list * 'a dseq
   36.64  end;
   36.65  
   36.66  structure Limited_Sequence : LIMITED_SEQUENCE =
   36.67  struct
   36.68  
   36.69 -type 'a dseq = int -> bool -> 'a Lazy_Sequence.lazy_sequence option
   36.70 +type 'a dseq = Code_Numeral.natural -> bool -> 'a Lazy_Sequence.lazy_sequence option
   36.71  
   36.72  fun map f = @{code Limited_Sequence.map} f;
   36.73  
    37.1 --- a/src/HOL/Num.thy	Fri Feb 15 08:31:30 2013 +0100
    37.2 +++ b/src/HOL/Num.thy	Fri Feb 15 08:31:31 2013 +0100
    37.3 @@ -545,7 +545,8 @@
    37.4  
    37.5  end
    37.6  
    37.7 -lemma nat_of_num_numeral: "nat_of_num = numeral"
    37.8 +lemma nat_of_num_numeral [code_abbrev]:
    37.9 +  "nat_of_num = numeral"
   37.10  proof
   37.11    fix n
   37.12    have "numeral n = nat_of_num n"
   37.13 @@ -553,6 +554,12 @@
   37.14    then show "nat_of_num n = numeral n" by simp
   37.15  qed
   37.16  
   37.17 +lemma nat_of_num_code [code]:
   37.18 +  "nat_of_num One = 1"
   37.19 +  "nat_of_num (Bit0 n) = (let m = nat_of_num n in m + m)"
   37.20 +  "nat_of_num (Bit1 n) = (let m = nat_of_num n in Suc (m + m))"
   37.21 +  by (simp_all add: Let_def)
   37.22 +
   37.23  subsubsection {*
   37.24    Equality: class @{text semiring_char_0}
   37.25  *}
   37.26 @@ -1097,6 +1104,7 @@
   37.27  
   37.28  hide_const (open) One Bit0 Bit1 BitM inc pow sqr sub dbl dbl_inc dbl_dec
   37.29  
   37.30 +
   37.31  subsection {* code module namespace *}
   37.32  
   37.33  code_modulename SML
   37.34 @@ -1110,3 +1118,4 @@
   37.35  
   37.36  end
   37.37  
   37.38 +
    38.1 --- a/src/HOL/Predicate.thy	Fri Feb 15 08:31:30 2013 +0100
    38.2 +++ b/src/HOL/Predicate.thy	Fri Feb 15 08:31:31 2013 +0100
    38.3 @@ -679,14 +679,15 @@
    38.4  
    38.5  text {* Lazy Evaluation of an indexed function *}
    38.6  
    38.7 -function iterate_upto :: "(code_numeral \<Rightarrow> 'a) \<Rightarrow> code_numeral \<Rightarrow> code_numeral \<Rightarrow> 'a Predicate.pred"
    38.8 +function iterate_upto :: "(natural \<Rightarrow> 'a) \<Rightarrow> natural \<Rightarrow> natural \<Rightarrow> 'a Predicate.pred"
    38.9  where
   38.10    "iterate_upto f n m =
   38.11      Predicate.Seq (%u. if n > m then Predicate.Empty
   38.12       else Predicate.Insert (f n) (iterate_upto f (n + 1) m))"
   38.13  by pat_completeness auto
   38.14  
   38.15 -termination by (relation "measure (%(f, n, m). Code_Numeral.nat_of (m + 1 - n))") auto
   38.16 +termination by (relation "measure (%(f, n, m). nat_of_natural (m + 1 - n))")
   38.17 +  (auto simp add: less_natural_def)
   38.18  
   38.19  text {* Misc *}
   38.20  
    39.1 --- a/src/HOL/Predicate_Compile_Examples/Predicate_Compile_Tests.thy	Fri Feb 15 08:31:30 2013 +0100
    39.2 +++ b/src/HOL/Predicate_Compile_Examples/Predicate_Compile_Tests.thy	Fri Feb 15 08:31:31 2013 +0100
    39.3 @@ -29,7 +29,7 @@
    39.4  thm True'.equation
    39.5  thm True'.dseq_equation
    39.6  thm True'.random_dseq_equation
    39.7 -values [expected "{()}" ]"{x. True'}"
    39.8 +values [expected "{()}"] "{x. True'}"
    39.9  values [expected "{}" dseq 0] "{x. True'}"
   39.10  values [expected "{()}" dseq 1] "{x. True'}"
   39.11  values [expected "{()}" dseq 2] "{x. True'}"
   39.12 @@ -119,22 +119,22 @@
   39.13  
   39.14  code_pred nested_tuples .
   39.15  
   39.16 -inductive JamesBond :: "nat => int => code_numeral => bool"
   39.17 +inductive JamesBond :: "nat => int => natural => bool"
   39.18  where
   39.19    "JamesBond 0 0 7"
   39.20  
   39.21  code_pred JamesBond .
   39.22  
   39.23 -values [expected "{(0::nat, 0::int , 7::code_numeral)}"] "{(a, b, c). JamesBond a b c}"
   39.24 -values [expected "{(0::nat, 7::code_numeral, 0:: int)}"] "{(a, c, b). JamesBond a b c}"
   39.25 -values [expected "{(0::int, 0::nat, 7::code_numeral)}"] "{(b, a, c). JamesBond a b c}"
   39.26 -values [expected "{(0::int, 7::code_numeral, 0::nat)}"] "{(b, c, a). JamesBond a b c}"
   39.27 -values [expected "{(7::code_numeral, 0::nat, 0::int)}"] "{(c, a, b). JamesBond a b c}"
   39.28 -values [expected "{(7::code_numeral, 0::int, 0::nat)}"] "{(c, b, a). JamesBond a b c}"
   39.29 +values [expected "{(0::nat, 0::int , 7::natural)}"] "{(a, b, c). JamesBond a b c}"
   39.30 +values [expected "{(0::nat, 7::natural, 0:: int)}"] "{(a, c, b). JamesBond a b c}"
   39.31 +values [expected "{(0::int, 0::nat, 7::natural)}"] "{(b, a, c). JamesBond a b c}"
   39.32 +values [expected "{(0::int, 7::natural, 0::nat)}"] "{(b, c, a). JamesBond a b c}"
   39.33 +values [expected "{(7::natural, 0::nat, 0::int)}"] "{(c, a, b). JamesBond a b c}"
   39.34 +values [expected "{(7::natural, 0::int, 0::nat)}"] "{(c, b, a). JamesBond a b c}"
   39.35  
   39.36 -values [expected "{(7::code_numeral, 0::int)}"] "{(a, b). JamesBond 0 b a}"
   39.37 -values [expected "{(7::code_numeral, 0::nat)}"] "{(c, a). JamesBond a 0 c}"
   39.38 -values [expected "{(0::nat, 7::code_numeral)}"] "{(a, c). JamesBond a 0 c}"
   39.39 +values [expected "{(7::natural, 0::int)}"] "{(a, b). JamesBond 0 b a}"
   39.40 +values [expected "{(7::natural, 0::nat)}"] "{(c, a). JamesBond a 0 c}"
   39.41 +values [expected "{(0::nat, 7::natural)}"] "{(a, c). JamesBond a 0 c}"
   39.42  
   39.43  
   39.44  subsection {* Alternative Rules *}
    40.1 --- a/src/HOL/Proofs/Extraction/Euclid.thy	Fri Feb 15 08:31:30 2013 +0100
    40.2 +++ b/src/HOL/Proofs/Extraction/Euclid.thy	Fri Feb 15 08:31:31 2013 +0100
    40.3 @@ -10,7 +10,7 @@
    40.4  imports
    40.5    "~~/src/HOL/Number_Theory/UniqueFactorization"
    40.6    Util
    40.7 -  "~~/src/HOL/Library/Efficient_Nat"
    40.8 +  "~~/src/HOL/Library/Code_Target_Numeral"
    40.9  begin
   40.10  
   40.11  text {*
    41.1 --- a/src/HOL/Proofs/Extraction/Pigeonhole.thy	Fri Feb 15 08:31:30 2013 +0100
    41.2 +++ b/src/HOL/Proofs/Extraction/Pigeonhole.thy	Fri Feb 15 08:31:31 2013 +0100
    41.3 @@ -5,7 +5,7 @@
    41.4  header {* The pigeonhole principle *}
    41.5  
    41.6  theory Pigeonhole
    41.7 -imports Util "~~/src/HOL/Library/Efficient_Nat"
    41.8 +imports Util "~~/src/HOL/Library/Code_Target_Numeral"
    41.9  begin
   41.10  
   41.11  text {*
   41.12 @@ -237,11 +237,11 @@
   41.13  end
   41.14  
   41.15  definition
   41.16 -  "test n u = pigeonhole n (\<lambda>m. m - 1)"
   41.17 +  "test n u = pigeonhole (nat_of_integer n) (\<lambda>m. m - 1)"
   41.18  definition
   41.19 -  "test' n u = pigeonhole_slow n (\<lambda>m. m - 1)"
   41.20 +  "test' n u = pigeonhole_slow (nat_of_integer n) (\<lambda>m. m - 1)"
   41.21  definition
   41.22 -  "test'' u = pigeonhole 8 (op ! [0, 1, 2, 3, 4, 5, 6, 3, 7, 8])"
   41.23 +  "test'' u = pigeonhole 8 (List.nth [0, 1, 2, 3, 4, 5, 6, 3, 7, 8])"
   41.24  
   41.25  ML "timeit (@{code test} 10)" 
   41.26  ML "timeit (@{code test'} 10)"
    42.1 --- a/src/HOL/Proofs/Lambda/WeakNorm.thy	Fri Feb 15 08:31:30 2013 +0100
    42.2 +++ b/src/HOL/Proofs/Lambda/WeakNorm.thy	Fri Feb 15 08:31:31 2013 +0100
    42.3 @@ -6,7 +6,7 @@
    42.4  header {* Weak normalization for simply-typed lambda calculus *}
    42.5  
    42.6  theory WeakNorm
    42.7 -imports LambdaType NormalForm "~~/src/HOL/Library/Code_Integer"
    42.8 +imports LambdaType NormalForm "~~/src/HOL/Library/Code_Target_Int"
    42.9  begin
   42.10  
   42.11  text {*
   42.12 @@ -387,14 +387,16 @@
   42.13  *}
   42.14  
   42.15  ML {*
   42.16 +val nat_of_integer = @{code nat} o @{code int_of_integer};
   42.17 +
   42.18  fun dBtype_of_typ (Type ("fun", [T, U])) =
   42.19        @{code Fun} (dBtype_of_typ T, dBtype_of_typ U)
   42.20    | dBtype_of_typ (TFree (s, _)) = (case raw_explode s of
   42.21 -        ["'", a] => @{code Atom} (@{code nat} (ord a - 97))
   42.22 +        ["'", a] => @{code Atom} (nat_of_integer (ord a - 97))
   42.23        | _ => error "dBtype_of_typ: variable name")
   42.24    | dBtype_of_typ _ = error "dBtype_of_typ: bad type";
   42.25  
   42.26 -fun dB_of_term (Bound i) = @{code dB.Var} (@{code nat} i)
   42.27 +fun dB_of_term (Bound i) = @{code dB.Var} (nat_of_integer i)
   42.28    | dB_of_term (t $ u) = @{code dB.App} (dB_of_term t, dB_of_term u)
   42.29    | dB_of_term (Abs (_, _, t)) = @{code dB.Abs} (dB_of_term t)
   42.30    | dB_of_term _ = error "dB_of_term: bad term";
   42.31 @@ -402,23 +404,23 @@
   42.32  fun term_of_dB Ts (Type ("fun", [T, U])) (@{code dB.Abs} dBt) =
   42.33        Abs ("x", T, term_of_dB (T :: Ts) U dBt)
   42.34    | term_of_dB Ts _ dBt = term_of_dB' Ts dBt
   42.35 -and term_of_dB' Ts (@{code dB.Var} n) = Bound (@{code int_of_nat} n)
   42.36 +and term_of_dB' Ts (@{code dB.Var} n) = Bound (@{code integer_of_nat} n)
   42.37    | term_of_dB' Ts (@{code dB.App} (dBt, dBu)) =
   42.38        let val t = term_of_dB' Ts dBt
   42.39        in case fastype_of1 (Ts, t) of
   42.40 -          Type ("fun", [T, U]) => t $ term_of_dB Ts T dBu
   42.41 +          Type ("fun", [T, _]) => t $ term_of_dB Ts T dBu
   42.42          | _ => error "term_of_dB: function type expected"
   42.43        end
   42.44    | term_of_dB' _ _ = error "term_of_dB: term not in normal form";
   42.45  
   42.46  fun typing_of_term Ts e (Bound i) =
   42.47 -      @{code Var} (e, @{code nat} i, dBtype_of_typ (nth Ts i))
   42.48 +      @{code Var} (e, nat_of_integer i, dBtype_of_typ (nth Ts i))
   42.49    | typing_of_term Ts e (t $ u) = (case fastype_of1 (Ts, t) of
   42.50          Type ("fun", [T, U]) => @{code App} (e, dB_of_term t,
   42.51            dBtype_of_typ T, dBtype_of_typ U, dB_of_term u,
   42.52            typing_of_term Ts e t, typing_of_term Ts e u)
   42.53        | _ => error "typing_of_term: function type expected")
   42.54 -  | typing_of_term Ts e (Abs (s, T, t)) =
   42.55 +  | typing_of_term Ts e (Abs (_, T, t)) =
   42.56        let val dBT = dBtype_of_typ T
   42.57        in @{code Abs} (e, dBT, dB_of_term t,
   42.58          dBtype_of_typ (fastype_of1 (T :: Ts, t)),
    43.1 --- a/src/HOL/Quickcheck_Benchmark/Needham_Schroeder_Base.thy	Fri Feb 15 08:31:30 2013 +0100
    43.2 +++ b/src/HOL/Quickcheck_Benchmark/Needham_Schroeder_Base.thy	Fri Feb 15 08:31:31 2013 +0100
    43.3 @@ -125,8 +125,8 @@
    43.4    [code]: "cps_of_set (set xs) f = find_first f xs"
    43.5  sorry
    43.6  
    43.7 -consts pos_cps_of_set :: "'a set => ('a => (bool * term list) option) => code_numeral => (bool * term list) option"
    43.8 -consts neg_cps_of_set :: "'a set => ('a Quickcheck_Exhaustive.unknown => term list Quickcheck_Exhaustive.three_valued) => code_numeral => term list Quickcheck_Exhaustive.three_valued"
    43.9 +consts pos_cps_of_set :: "'a set => ('a => (bool * term list) option) => natural => (bool * term list) option"
   43.10 +consts neg_cps_of_set :: "'a set => ('a Quickcheck_Exhaustive.unknown => term list Quickcheck_Exhaustive.three_valued) => natural => term list Quickcheck_Exhaustive.three_valued"
   43.11  
   43.12  lemma
   43.13    [code]: "pos_cps_of_set (set xs) f i = find_first f xs"
    44.1 --- a/src/HOL/Quickcheck_Examples/Completeness.thy	Fri Feb 15 08:31:30 2013 +0100
    44.2 +++ b/src/HOL/Quickcheck_Examples/Completeness.thy	Fri Feb 15 08:31:31 2013 +0100
    44.3 @@ -16,6 +16,10 @@
    44.4    "is_some (Some t) = True"
    44.5  | "is_some None = False"
    44.6  
    44.7 +lemma is_some_is_not_None:
    44.8 +  "is_some x \<longleftrightarrow> x \<noteq> None"
    44.9 +  by (cases x) simp_all
   44.10 +
   44.11  setup {* Exhaustive_Generators.setup_exhaustive_datatype_interpretation *} 
   44.12  
   44.13  subsection {* Defining the size of values *}
   44.14 @@ -36,12 +40,12 @@
   44.15  
   44.16  end
   44.17  
   44.18 -instantiation code_numeral :: size
   44.19 +instantiation natural :: size
   44.20  begin
   44.21  
   44.22 -definition size_code_numeral :: "code_numeral => nat"
   44.23 +definition size_natural :: "natural => nat"
   44.24  where
   44.25 -  "size_code_numeral = Code_Numeral.nat_of"
   44.26 +  "size_natural = nat_of_natural"
   44.27  
   44.28  instance ..
   44.29  
   44.30 @@ -74,96 +78,86 @@
   44.31  
   44.32  class complete = exhaustive + size +
   44.33  assumes
   44.34 -   complete: "(\<exists> v. size v \<le> n \<and> is_some (f v)) \<longleftrightarrow> is_some (exhaustive_class.exhaustive f (Code_Numeral.of_nat n))"
   44.35 +   complete: "(\<exists> v. size v \<le> n \<and> is_some (f v)) \<longleftrightarrow> is_some (exhaustive_class.exhaustive f (natural_of_nat n))"
   44.36  
   44.37  lemma complete_imp1:
   44.38 -  "size (v :: 'a :: complete) \<le> n \<Longrightarrow> is_some (f v) \<Longrightarrow> is_some (exhaustive_class.exhaustive f (Code_Numeral.of_nat n))"
   44.39 +  "size (v :: 'a :: complete) \<le> n \<Longrightarrow> is_some (f v) \<Longrightarrow> is_some (exhaustive_class.exhaustive f (natural_of_nat n))"
   44.40  by (metis complete)
   44.41  
   44.42  lemma complete_imp2:
   44.43 -  assumes "is_some (exhaustive_class.exhaustive f (Code_Numeral.of_nat n))"
   44.44 +  assumes "is_some (exhaustive_class.exhaustive f (natural_of_nat n))"
   44.45    obtains v where "size (v :: 'a :: complete) \<le> n" "is_some (f v)"
   44.46  using assms by (metis complete)
   44.47  
   44.48  subsubsection {* Instance Proofs *}
   44.49  
   44.50 -declare exhaustive'.simps [simp del]
   44.51 +declare exhaustive_int'.simps [simp del]
   44.52  
   44.53  lemma complete_exhaustive':
   44.54 -  "(\<exists> i. j <= i & i <= k & is_some (f i)) \<longleftrightarrow> is_some (Quickcheck_Exhaustive.exhaustive' f k j)"
   44.55 -proof (induct rule: Quickcheck_Exhaustive.exhaustive'.induct[of _ f k j])
   44.56 +  "(\<exists> i. j <= i & i <= k & is_some (f i)) \<longleftrightarrow> is_some (Quickcheck_Exhaustive.exhaustive_int' f k j)"
   44.57 +proof (induct rule: Quickcheck_Exhaustive.exhaustive_int'.induct[of _ f k j])
   44.58    case (1 f d i)
   44.59    show ?case
   44.60    proof (cases "f i")
   44.61      case None
   44.62      from this 1 show ?thesis
   44.63 -    unfolding exhaustive'.simps[of _ _ i] Quickcheck_Exhaustive.orelse_def
   44.64 +    unfolding exhaustive_int'.simps[of _ _ i] Quickcheck_Exhaustive.orelse_def
   44.65 +    apply (auto simp add: add1_zle_eq dest: less_imp_le)
   44.66      apply auto
   44.67 -    apply (metis is_some.simps(2) order_le_neq_trans zless_imp_add1_zle)
   44.68 -    apply (metis add1_zle_eq less_int_def)
   44.69      done
   44.70    next
   44.71      case Some
   44.72      from this show ?thesis
   44.73 -    unfolding exhaustive'.simps[of _ _ i] Quickcheck_Exhaustive.orelse_def by auto
   44.74 +    unfolding exhaustive_int'.simps[of _ _ i] Quickcheck_Exhaustive.orelse_def by auto
   44.75    qed
   44.76  qed
   44.77  
   44.78 -lemma int_of_nat:
   44.79 -  "Code_Numeral.int_of (Code_Numeral.of_nat n) = int n"
   44.80 -unfolding int_of_def by simp
   44.81 -
   44.82  instance int :: complete
   44.83  proof
   44.84    fix n f
   44.85 -  show "(\<exists>v. size (v :: int) \<le> n \<and> is_some (f v)) = is_some (exhaustive_class.exhaustive f (Code_Numeral.of_nat n))"
   44.86 +  show "(\<exists>v. size (v :: int) \<le> n \<and> is_some (f v)) = is_some (exhaustive_class.exhaustive f (natural_of_nat n))"
   44.87      unfolding exhaustive_int_def complete_exhaustive'[symmetric]
   44.88      apply auto apply (rule_tac x="v" in exI)
   44.89 -    unfolding size_int_def by (metis int_of_nat abs_le_iff minus_le_iff nat_le_iff)+
   44.90 +    unfolding size_int_def by (metis abs_le_iff minus_le_iff nat_le_iff)+
   44.91  qed
   44.92  
   44.93 -declare exhaustive_code_numeral'.simps[simp del]
   44.94 +declare exhaustive_natural'.simps[simp del]
   44.95  
   44.96 -lemma complete_code_numeral':
   44.97 +lemma complete_natural':
   44.98    "(\<exists>n. j \<le> n \<and> n \<le> k \<and> is_some (f n)) =
   44.99 -    is_some (Quickcheck_Exhaustive.exhaustive_code_numeral' f k j)"
  44.100 -proof (induct rule: exhaustive_code_numeral'.induct[of _ f k j])
  44.101 +    is_some (Quickcheck_Exhaustive.exhaustive_natural' f k j)"
  44.102 +proof (induct rule: exhaustive_natural'.induct[of _ f k j])
  44.103    case (1 f k j)
  44.104 -  show "(\<exists>n\<ge>j. n \<le> k \<and> is_some (f n)) = is_some (Quickcheck_Exhaustive.exhaustive_code_numeral' f k j)"
  44.105 -  unfolding exhaustive_code_numeral'.simps[of f k j] Quickcheck_Exhaustive.orelse_def
  44.106 -  apply auto
  44.107 +  show "(\<exists>n\<ge>j. n \<le> k \<and> is_some (f n)) = is_some (Quickcheck_Exhaustive.exhaustive_natural' f k j)"
  44.108 +  unfolding exhaustive_natural'.simps [of f k j] Quickcheck_Exhaustive.orelse_def
  44.109    apply (auto split: option.split)
  44.110 -  apply (insert 1[symmetric])
  44.111 -  apply simp
  44.112 -  apply (metis is_some.simps(2) less_eq_code_numeral_def not_less_eq_eq order_antisym)
  44.113 -  apply simp
  44.114 -  apply (split option.split_asm)
  44.115 -  defer apply fastforce
  44.116 -  apply simp by (metis Suc_leD)
  44.117 +  apply (auto simp add: less_eq_natural_def less_natural_def 1 [symmetric] dest: Suc_leD)
  44.118 +  apply (metis is_some.simps(2) natural_eqI not_less_eq_eq order_antisym)
  44.119 +  done
  44.120  qed
  44.121  
  44.122 -instance code_numeral :: complete
  44.123 +instance natural :: complete
  44.124  proof
  44.125    fix n f
  44.126 -  show "(\<exists>v. size (v :: code_numeral) \<le> n \<and> is_some (f v)) \<longleftrightarrow> is_some (exhaustive_class.exhaustive f (Code_Numeral.of_nat n))"
  44.127 -  unfolding exhaustive_code_numeral_def complete_code_numeral'[symmetric]
  44.128 -  by (auto simp add: size_code_numeral_def)
  44.129 +  show "(\<exists>v. size (v :: natural) \<le> n \<and> is_some (f v)) \<longleftrightarrow> is_some (exhaustive_class.exhaustive f (natural_of_nat n))"
  44.130 +  unfolding exhaustive_natural_def complete_natural' [symmetric]
  44.131 +    by (auto simp add: size_natural_def less_eq_natural_def)
  44.132  qed  
  44.133  
  44.134  instance nat :: complete
  44.135  proof
  44.136    fix n f
  44.137 -  show "(\<exists>v. size (v :: nat) \<le> n \<and> is_some (f v)) \<longleftrightarrow> is_some (exhaustive_class.exhaustive f (Code_Numeral.of_nat n))"
  44.138 -    unfolding exhaustive_nat_def complete[of n "%x. f (Code_Numeral.nat_of x)", symmetric]
  44.139 +  show "(\<exists>v. size (v :: nat) \<le> n \<and> is_some (f v)) \<longleftrightarrow> is_some (exhaustive_class.exhaustive f (natural_of_nat n))"
  44.140 +    unfolding exhaustive_nat_def complete[of n "%x. f (nat_of_natural x)", symmetric]
  44.141      apply auto
  44.142 -    apply (rule_tac x="Code_Numeral.of_nat v" in exI)
  44.143 -    apply (auto simp add: size_code_numeral_def size_nat_def) done
  44.144 +    apply (rule_tac x="natural_of_nat v" in exI)
  44.145 +    apply (auto simp add: size_natural_def size_nat_def) done
  44.146  qed
  44.147  
  44.148  instance list :: (complete) complete
  44.149  proof
  44.150    fix n f
  44.151 -  show "(\<exists> v. size (v :: 'a list) \<le> n \<and> is_some (f (v :: 'a list))) \<longleftrightarrow> is_some (exhaustive_class.exhaustive f (Code_Numeral.of_nat n))"
  44.152 +  show "(\<exists> v. size (v :: 'a list) \<le> n \<and> is_some (f (v :: 'a list))) \<longleftrightarrow> is_some (exhaustive_class.exhaustive f (natural_of_nat n))"
  44.153    proof (induct n arbitrary: f)
  44.154      case 0
  44.155      { fix v have "size (v :: 'a list) > 0" by (induct v) auto }
  44.156 @@ -174,25 +168,25 @@
  44.157      proof
  44.158        assume "\<exists>v. Completeness.size_class.size v \<le> Suc n \<and> is_some (f v)"
  44.159        then obtain v where v: "size v \<le> Suc n" "is_some (f v)" by blast
  44.160 -      show "is_some (exhaustive_class.exhaustive f (Code_Numeral.of_nat (Suc n)))"
  44.161 +      show "is_some (exhaustive_class.exhaustive f (natural_of_nat (Suc n)))"
  44.162        proof (cases "v")
  44.163        case Nil
  44.164          from this v show ?thesis
  44.165 -          unfolding list.exhaustive_list.simps[of _ "Code_Numeral.of_nat (Suc n)"] Quickcheck_Exhaustive.orelse_def
  44.166 -          by (auto split: option.split)
  44.167 +          unfolding list.exhaustive_list.simps[of _ "natural_of_nat (Suc n)"] Quickcheck_Exhaustive.orelse_def
  44.168 +          by (auto split: option.split simp add: less_natural_def)
  44.169        next 
  44.170        case (Cons v' vs')
  44.171          from Cons v have size_v': "Completeness.size_class.size v' \<le> n"
  44.172            and "Completeness.size_class.size vs' \<le> n" by auto
  44.173 -        from Suc v Cons this have "is_some (exhaustive_class.exhaustive (\<lambda>xs. f (v' # xs)) (Code_Numeral.of_nat n))"
  44.174 +        from Suc v Cons this have "is_some (exhaustive_class.exhaustive (\<lambda>xs. f (v' # xs)) (natural_of_nat n))"
  44.175            by metis
  44.176 -        from complete_imp1[OF size_v', of "%x. (exhaustive_class.exhaustive (\<lambda>xs. f (x # xs)) (Code_Numeral.of_nat n))", OF this]
  44.177 +        from complete_imp1[OF size_v', of "%x. (exhaustive_class.exhaustive (\<lambda>xs. f (x # xs)) (natural_of_nat n))", OF this]
  44.178          show ?thesis
  44.179 -          unfolding list.exhaustive_list.simps[of _ "Code_Numeral.of_nat (Suc n)"] Quickcheck_Exhaustive.orelse_def
  44.180 -          by (auto split: option.split)
  44.181 +          unfolding list.exhaustive_list.simps[of _ "natural_of_nat (Suc n)"] Quickcheck_Exhaustive.orelse_def
  44.182 +          by (auto split: option.split simp add: less_natural_def)
  44.183        qed
  44.184      next
  44.185 -      assume is_some: "is_some (exhaustive_class.exhaustive f (Code_Numeral.of_nat (Suc n)))"
  44.186 +      assume is_some: "is_some (exhaustive_class.exhaustive f (natural_of_nat (Suc n)))"
  44.187        show "\<exists>v. size v \<le> Suc n \<and> is_some (f v)"
  44.188        proof (cases "f []")
  44.189          case Some
  44.190 @@ -201,12 +195,12 @@
  44.191        next
  44.192          case None
  44.193          with is_some have
  44.194 -          "is_some (exhaustive_class.exhaustive (\<lambda>x. exhaustive_class.exhaustive (\<lambda>xs. f (x # xs)) (Code_Numeral.of_nat n)) (Code_Numeral.of_nat n))"
  44.195 -          unfolding list.exhaustive_list.simps[of _ "Code_Numeral.of_nat (Suc n)"] Quickcheck_Exhaustive.orelse_def
  44.196 -          by simp
  44.197 +          "is_some (exhaustive_class.exhaustive (\<lambda>x. exhaustive_class.exhaustive (\<lambda>xs. f (x # xs)) (natural_of_nat n)) (natural_of_nat n))"
  44.198 +          unfolding list.exhaustive_list.simps[of _ "natural_of_nat (Suc n)"] Quickcheck_Exhaustive.orelse_def
  44.199 +          by (simp add: less_natural_def)
  44.200          then obtain v' where
  44.201              v: "size v' \<le> n"
  44.202 -              "is_some (exhaustive_class.exhaustive (\<lambda>xs. f (v' # xs)) (Code_Numeral.of_nat n))"
  44.203 +              "is_some (exhaustive_class.exhaustive (\<lambda>xs. f (v' # xs)) (natural_of_nat n))"
  44.204            by (rule complete_imp2)
  44.205          with Suc[of "%xs. f (v' # xs)"]
  44.206          obtain vs' where vs': "size vs' \<le> n" "is_some (f (v' # vs'))"
  44.207 @@ -219,3 +213,4 @@
  44.208  qed
  44.209  
  44.210  end
  44.211 +
    45.1 --- a/src/HOL/Quickcheck_Examples/Hotel_Example.thy	Fri Feb 15 08:31:30 2013 +0100
    45.2 +++ b/src/HOL/Quickcheck_Examples/Hotel_Example.thy	Fri Feb 15 08:31:31 2013 +0100
    45.3 @@ -105,8 +105,8 @@
    45.4    [code]: "cps_of_set (set xs) f = find_first f xs"
    45.5  sorry
    45.6  
    45.7 -consts pos_cps_of_set :: "'a set => ('a => (bool * term list) option) => code_numeral => (bool * term list) option"
    45.8 -consts neg_cps_of_set :: "'a set => ('a Quickcheck_Exhaustive.unknown => term list Quickcheck_Exhaustive.three_valued) => code_numeral => term list Quickcheck_Exhaustive.three_valued"
    45.9 +consts pos_cps_of_set :: "'a set => ('a => (bool * term list) option) => natural => (bool * term list) option"
   45.10 +consts neg_cps_of_set :: "'a set => ('a Quickcheck_Exhaustive.unknown => term list Quickcheck_Exhaustive.three_valued) => natural => term list Quickcheck_Exhaustive.three_valued"
   45.11  
   45.12  lemma
   45.13    [code]: "pos_cps_of_set (set xs) f i = find_first f xs"
    46.1 --- a/src/HOL/Quickcheck_Exhaustive.thy	Fri Feb 15 08:31:30 2013 +0100
    46.2 +++ b/src/HOL/Quickcheck_Exhaustive.thy	Fri Feb 15 08:31:31 2013 +0100
    46.3 @@ -16,42 +16,78 @@
    46.4  subsection {* exhaustive generator type classes *}
    46.5  
    46.6  class exhaustive = term_of +
    46.7 -  fixes exhaustive :: "('a \<Rightarrow> (bool * term list) option) \<Rightarrow> code_numeral \<Rightarrow> (bool * term list) option"
    46.8 +  fixes exhaustive :: "('a \<Rightarrow> (bool * term list) option) \<Rightarrow> natural \<Rightarrow> (bool * term list) option"
    46.9    
   46.10  class full_exhaustive = term_of +
   46.11 -  fixes full_exhaustive :: "('a * (unit => term) \<Rightarrow> (bool * term list) option) \<Rightarrow> code_numeral \<Rightarrow> (bool * term list) option"
   46.12 +  fixes full_exhaustive :: "('a * (unit => term) \<Rightarrow> (bool * term list) option) \<Rightarrow> natural \<Rightarrow> (bool * term list) option"
   46.13  
   46.14 -instantiation code_numeral :: full_exhaustive
   46.15 +instantiation natural :: full_exhaustive
   46.16  begin
   46.17  
   46.18 -function full_exhaustive_code_numeral' :: "(code_numeral * (unit => term) => (bool * term list) option) => code_numeral => code_numeral => (bool * term list) option"
   46.19 -  where "full_exhaustive_code_numeral' f d i =
   46.20 +function full_exhaustive_natural' :: "(natural * (unit => term) => (bool * term list) option) => natural => natural => (bool * term list) option"
   46.21 +  where "full_exhaustive_natural' f d i =
   46.22      (if d < i then None
   46.23 -    else (f (i, %_. Code_Evaluation.term_of i)) orelse (full_exhaustive_code_numeral' f d (i + 1)))"
   46.24 +    else (f (i, %_. Code_Evaluation.term_of i)) orelse (full_exhaustive_natural' f d (i + 1)))"
   46.25  by pat_completeness auto
   46.26  
   46.27  termination
   46.28 -  by (relation "measure (%(_, d, i). Code_Numeral.nat_of (d + 1 - i))") auto
   46.29 +  by (relation "measure (%(_, d, i). nat_of_natural (d + 1 - i))")
   46.30 +    (auto simp add: less_natural_def)
   46.31  
   46.32 -definition "full_exhaustive f d = full_exhaustive_code_numeral' f d 0"
   46.33 +definition "full_exhaustive f d = full_exhaustive_natural' f d 0"
   46.34  
   46.35  instance ..
   46.36  
   46.37  end
   46.38  
   46.39 -instantiation code_numeral :: exhaustive
   46.40 +instantiation natural :: exhaustive
   46.41  begin
   46.42  
   46.43 -function exhaustive_code_numeral' :: "(code_numeral => (bool * term list) option) => code_numeral => code_numeral => (bool * term list) option"
   46.44 -  where "exhaustive_code_numeral' f d i =
   46.45 +function exhaustive_natural' :: "(natural => (bool * term list) option) => natural => natural => (bool * term list) option"
   46.46 +  where "exhaustive_natural' f d i =
   46.47      (if d < i then None
   46.48 -    else (f i orelse exhaustive_code_numeral' f d (i + 1)))"
   46.49 +    else (f i orelse exhaustive_natural' f d (i + 1)))"
   46.50  by pat_completeness auto
   46.51  
   46.52  termination
   46.53 -  by (relation "measure (%(_, d, i). Code_Numeral.nat_of (d + 1 - i))") auto
   46.54 +  by (relation "measure (%(_, d, i). nat_of_natural (d + 1 - i))")
   46.55 +    (auto simp add: less_natural_def)
   46.56 +
   46.57 +definition "exhaustive f d = exhaustive_natural' f d 0"
   46.58 +
   46.59 +instance ..
   46.60 +
   46.61 +end
   46.62 +
   46.63 +instantiation integer :: exhaustive
   46.64 +begin
   46.65 +
   46.66 +function exhaustive_integer' :: "(integer => (bool * term list) option) => integer => integer => (bool * term list) option"
   46.67 +  where "exhaustive_integer' f d i = (if d < i then None else (f i orelse exhaustive_integer' f d (i + 1)))"
   46.68 +by pat_completeness auto
   46.69  
   46.70 -definition "exhaustive f d = exhaustive_code_numeral' f d 0"
   46.71 +termination 
   46.72 +  by (relation "measure (%(_, d, i). nat_of_integer (d + 1 - i))")
   46.73 +    (auto simp add: less_integer_def nat_of_integer_def)
   46.74 +
   46.75 +definition "exhaustive f d = exhaustive_integer' f (integer_of_natural d) (- (integer_of_natural d))"
   46.76 +
   46.77 +instance ..
   46.78 +
   46.79 +end
   46.80 +
   46.81 +instantiation integer :: full_exhaustive
   46.82 +begin
   46.83 +
   46.84 +function full_exhaustive_integer' :: "(integer * (unit => term) => (bool * term list) option) => integer => integer => (bool * term list) option"
   46.85 +  where "full_exhaustive_integer' f d i = (if d < i then None else (case f (i, %_. Code_Evaluation.term_of i) of Some t => Some t | None => full_exhaustive_integer' f d (i + 1)))"
   46.86 +by pat_completeness auto
   46.87 +
   46.88 +termination 
   46.89 +  by (relation "measure (%(_, d, i). nat_of_integer (d + 1 - i))")
   46.90 +    (auto simp add: less_integer_def nat_of_integer_def)
   46.91 +
   46.92 +definition "full_exhaustive f d = full_exhaustive_integer' f (integer_of_natural d) (- (integer_of_natural d))"
   46.93  
   46.94  instance ..
   46.95  
   46.96 @@ -60,7 +96,7 @@
   46.97  instantiation nat :: exhaustive
   46.98  begin
   46.99  
  46.100 -definition "exhaustive f d = exhaustive (%x. f (Code_Numeral.nat_of x)) d"
  46.101 +definition "exhaustive f d = exhaustive (%x. f (nat_of_natural x)) d"
  46.102  
  46.103  instance ..
  46.104  
  46.105 @@ -69,7 +105,7 @@
  46.106  instantiation nat :: full_exhaustive
  46.107  begin
  46.108  
  46.109 -definition "full_exhaustive f d = full_exhaustive (%(x, xt). f (Code_Numeral.nat_of x, %_. Code_Evaluation.term_of (Code_Numeral.nat_of x))) d"
  46.110 +definition "full_exhaustive f d = full_exhaustive (%(x, xt). f (nat_of_natural x, %_. Code_Evaluation.term_of (nat_of_natural x))) d"
  46.111  
  46.112  instance ..
  46.113  
  46.114 @@ -78,14 +114,15 @@
  46.115  instantiation int :: exhaustive
  46.116  begin
  46.117  
  46.118 -function exhaustive' :: "(int => (bool * term list) option) => int => int => (bool * term list) option"
  46.119 -  where "exhaustive' f d i = (if d < i then None else (f i orelse exhaustive' f d (i + 1)))"
  46.120 +function exhaustive_int' :: "(int => (bool * term list) option) => int => int => (bool * term list) option"
  46.121 +  where "exhaustive_int' f d i = (if d < i then None else (f i orelse exhaustive_int' f d (i + 1)))"
  46.122  by pat_completeness auto
  46.123  
  46.124  termination 
  46.125    by (relation "measure (%(_, d, i). nat (d + 1 - i))") auto
  46.126  
  46.127 -definition "exhaustive f d = exhaustive' f (Code_Numeral.int_of d) (- (Code_Numeral.int_of d))"
  46.128 +definition "exhaustive f d = exhaustive_int' f (int_of_integer (integer_of_natural d))
  46.129 +  (- (int_of_integer (integer_of_natural d)))"
  46.130  
  46.131  instance ..
  46.132  
  46.133 @@ -94,14 +131,15 @@
  46.134  instantiation int :: full_exhaustive
  46.135  begin
  46.136  
  46.137 -function full_exhaustive' :: "(int * (unit => term) => (bool * term list) option) => int => int => (bool * term list) option"
  46.138 -  where "full_exhaustive' f d i = (if d < i then None else (case f (i, %_. Code_Evaluation.term_of i) of Some t => Some t | None => full_exhaustive' f d (i + 1)))"
  46.139 +function full_exhaustive_int' :: "(int * (unit => term) => (bool * term list) option) => int => int => (bool * term list) option"
  46.140 +  where "full_exhaustive_int' f d i = (if d < i then None else (case f (i, %_. Code_Evaluation.term_of i) of Some t => Some t | None => full_exhaustive_int' f d (i + 1)))"
  46.141  by pat_completeness auto
  46.142  
  46.143  termination 
  46.144    by (relation "measure (%(_, d, i). nat (d + 1 - i))") auto
  46.145  
  46.146 -definition "full_exhaustive f d = full_exhaustive' f (Code_Numeral.int_of d) (- (Code_Numeral.int_of d))"
  46.147 +definition "full_exhaustive f d = full_exhaustive_int' f (int_of_integer (integer_of_natural d))
  46.148 +  (- (int_of_integer (integer_of_natural d)))"
  46.149  
  46.150  instance ..
  46.151  
  46.152 @@ -154,14 +192,14 @@
  46.153  instantiation "fun" :: ("{equal, exhaustive}", exhaustive) exhaustive
  46.154  begin
  46.155  
  46.156 -fun exhaustive_fun' :: "(('a => 'b) => (bool * term list) option) => code_numeral => code_numeral => (bool * term list) option"
  46.157 +fun exhaustive_fun' :: "(('a => 'b) => (bool * term list) option) => natural => natural => (bool * term list) option"
  46.158  where
  46.159    "exhaustive_fun' f i d = (exhaustive (%b. f (%_. b)) d)
  46.160     orelse (if i > 1 then
  46.161       exhaustive_fun' (%g. exhaustive (%a. exhaustive (%b.
  46.162         f (g(a := b))) d) d) (i - 1) d else None)"
  46.163  
  46.164 -definition exhaustive_fun :: "(('a => 'b) => (bool * term list) option) => code_numeral => (bool * term list) option"
  46.165 +definition exhaustive_fun :: "(('a => 'b) => (bool * term list) option) => natural => (bool * term list) option"
  46.166  where
  46.167    "exhaustive_fun f d = exhaustive_fun' f d d" 
  46.168  
  46.169 @@ -176,14 +214,14 @@
  46.170  instantiation "fun" :: ("{equal, full_exhaustive}", full_exhaustive) full_exhaustive
  46.171  begin
  46.172  
  46.173 -fun full_exhaustive_fun' :: "(('a => 'b) * (unit => term) => (bool * term list) option) => code_numeral => code_numeral => (bool * term list) option"
  46.174 +fun full_exhaustive_fun' :: "(('a => 'b) * (unit => term) => (bool * term list) option) => natural => natural => (bool * term list) option"
  46.175  where
  46.176    "full_exhaustive_fun' f i d = (full_exhaustive (%v. f (valtermify_absdummy v)) d)
  46.177     orelse (if i > 1 then
  46.178       full_exhaustive_fun' (%g. full_exhaustive (%a. full_exhaustive (%b.
  46.179         f (valtermify_fun_upd g a b)) d) d) (i - 1) d else None)"
  46.180  
  46.181 -definition full_exhaustive_fun :: "(('a => 'b) * (unit => term) => (bool * term list) option) => code_numeral => (bool * term list) option"
  46.182 +definition full_exhaustive_fun :: "(('a => 'b) * (unit => term) => (bool * term list) option) => natural => (bool * term list) option"
  46.183  where
  46.184    "full_exhaustive_fun f d = full_exhaustive_fun' f d d" 
  46.185  
  46.186 @@ -197,7 +235,7 @@
  46.187    fixes check_all :: "('a * (unit \<Rightarrow> term) \<Rightarrow> (bool * term list) option) \<Rightarrow> (bool * term list) option"
  46.188    fixes enum_term_of :: "'a itself \<Rightarrow> unit \<Rightarrow> term list"
  46.189    
  46.190 -fun check_all_n_lists :: "(('a :: check_all) list * (unit \<Rightarrow> term list) \<Rightarrow> (bool * term list) option) \<Rightarrow> code_numeral \<Rightarrow> (bool * term list) option"
  46.191 +fun check_all_n_lists :: "(('a :: check_all) list * (unit \<Rightarrow> term list) \<Rightarrow> (bool * term list) option) \<Rightarrow> natural \<Rightarrow> (bool * term list) option"
  46.192  where
  46.193    "check_all_n_lists f n =
  46.194       (if n = 0 then f ([], (%_. [])) else check_all (%(x, xt). check_all_n_lists (%(xs, xst). f ((x # xs), (%_. (xt () # xst ())))) (n - 1)))"
  46.195 @@ -227,7 +265,7 @@
  46.196      (let
  46.197        mk_term = mk_map_term (%_. Typerep.typerep (TYPE('a))) (%_. Typerep.typerep (TYPE('b))) (enum_term_of (TYPE('a)));
  46.198        enum = (Enum.enum :: 'a list)
  46.199 -    in check_all_n_lists (\<lambda>(ys, yst). f (the o map_of (zip enum ys), mk_term yst)) (Code_Numeral.of_nat (length enum)))"
  46.200 +    in check_all_n_lists (\<lambda>(ys, yst). f (the o map_of (zip enum ys), mk_term yst)) (natural_of_nat (length enum)))"
  46.201  
  46.202  definition enum_term_of_fun :: "('a => 'b) itself => unit => term list"
  46.203  where
  46.204 @@ -470,12 +508,12 @@
  46.205  subsection {* Bounded universal quantifiers *}
  46.206  
  46.207  class bounded_forall =
  46.208 -  fixes bounded_forall :: "('a \<Rightarrow> bool) \<Rightarrow> code_numeral \<Rightarrow> bool"
  46.209 +  fixes bounded_forall :: "('a \<Rightarrow> bool) \<Rightarrow> natural \<Rightarrow> bool"
  46.210  
  46.211  subsection {* Fast exhaustive combinators *}
  46.212  
  46.213  class fast_exhaustive = term_of +
  46.214 -  fixes fast_exhaustive :: "('a \<Rightarrow> unit) \<Rightarrow> code_numeral \<Rightarrow> unit"
  46.215 +  fixes fast_exhaustive :: "('a \<Rightarrow> unit) \<Rightarrow> natural \<Rightarrow> unit"
  46.216  
  46.217  axiomatization throw_Counterexample :: "term list => unit"
  46.218  axiomatization catch_Counterexample :: "unit => term list option"
  46.219 @@ -513,7 +551,7 @@
  46.220  where
  46.221    "cps_not n = (%c. case n (%u. Some []) of None => c () | Some _ => None)"
  46.222  
  46.223 -type_synonym 'a pos_bound_cps = "('a => (bool * term list) option) => code_numeral => (bool * term list) option"
  46.224 +type_synonym 'a pos_bound_cps = "('a => (bool * term list) option) => natural => (bool * term list) option"
  46.225  
  46.226  definition pos_bound_cps_empty :: "'a pos_bound_cps"
  46.227  where
  46.228 @@ -538,7 +576,7 @@
  46.229  datatype 'a unknown = Unknown | Known 'a
  46.230  datatype 'a three_valued = Unknown_value | Value 'a | No_value
  46.231  
  46.232 -type_synonym 'a neg_bound_cps = "('a unknown => term list three_valued) => code_numeral => term list three_valued"
  46.233 +type_synonym 'a neg_bound_cps = "('a unknown => term list three_valued) => natural => term list three_valued"
  46.234  
  46.235  definition neg_bound_cps_empty :: "'a neg_bound_cps"
  46.236  where
  46.237 @@ -573,7 +611,7 @@
  46.238  axiomatization unknown :: 'a
  46.239  
  46.240  notation (output) unknown  ("?")
  46.241 - 
  46.242 +
  46.243  ML_file "Tools/Quickcheck/exhaustive_generators.ML"
  46.244  
  46.245  setup {* Exhaustive_Generators.setup *}
  46.246 @@ -588,15 +626,19 @@
  46.247  no_notation orelse (infixr "orelse" 55)
  46.248  
  46.249  hide_fact
  46.250 -  exhaustive'_def
  46.251 -  exhaustive_code_numeral'_def
  46.252 +  exhaustive_int'_def
  46.253 +  exhaustive_integer'_def
  46.254 +  exhaustive_natural'_def
  46.255  
  46.256  hide_const valtermify_absdummy valtermify_fun_upd valterm_emptyset valtermify_insert valtermify_pair
  46.257    valtermify_Inl valtermify_Inr
  46.258    termify_fun_upd term_emptyset termify_insert termify_pair setify
  46.259  
  46.260  hide_const (open)
  46.261 -  exhaustive full_exhaustive exhaustive' exhaustive_code_numeral' full_exhaustive_code_numeral'
  46.262 +  exhaustive full_exhaustive
  46.263 +  exhaustive_int' full_exhaustive_int'
  46.264 +  exhaustive_integer' full_exhaustive_integer'
  46.265 +  exhaustive_natural' full_exhaustive_natural'
  46.266    throw_Counterexample catch_Counterexample
  46.267    check_all enum_term_of
  46.268    orelse unknown mk_map_term check_all_n_lists check_all_subsets
    47.1 --- a/src/HOL/Quickcheck_Narrowing.thy	Fri Feb 15 08:31:30 2013 +0100
    47.2 +++ b/src/HOL/Quickcheck_Narrowing.thy	Fri Feb 15 08:31:31 2013 +0100
    47.3 @@ -9,188 +9,26 @@
    47.4  
    47.5  subsection {* Counterexample generator *}
    47.6  
    47.7 -text {* We create a new target for the necessary code generation setup. *}
    47.8 +subsubsection {* Code generation setup *}
    47.9  
   47.10  setup {* Code_Target.extend_target ("Haskell_Quickcheck", (Code_Haskell.target, K I)) *}
   47.11  
   47.12 -subsubsection {* Code generation setup *}
   47.13 -
   47.14  code_type typerep
   47.15    (Haskell_Quickcheck "Typerep")
   47.16  
   47.17  code_const Typerep.Typerep
   47.18    (Haskell_Quickcheck "Typerep")
   47.19  
   47.20 +code_type integer
   47.21 +  (Haskell_Quickcheck "Prelude.Int")
   47.22 +
   47.23  code_reserved Haskell_Quickcheck Typerep
   47.24  
   47.25 -subsubsection {* Type @{text "code_int"} for Haskell Quickcheck's Int type *}
   47.26 -
   47.27 -typedef code_int = "UNIV \<Colon> int set"
   47.28 -  morphisms int_of of_int by rule
   47.29 -
   47.30 -lemma of_int_int_of [simp]:
   47.31 -  "of_int (int_of k) = k"
   47.32 -  by (rule int_of_inverse)
   47.33 -
   47.34 -lemma int_of_of_int [simp]:
   47.35 -  "int_of (of_int n) = n"
   47.36 -  by (rule of_int_inverse) (rule UNIV_I)
   47.37 -
   47.38 -lemma code_int:
   47.39 -  "(\<And>n\<Colon>code_int. PROP P n) \<equiv> (\<And>n\<Colon>int. PROP P (of_int n))"
   47.40 -proof
   47.41 -  fix n :: int
   47.42 -  assume "\<And>n\<Colon>code_int. PROP P n"
   47.43 -  then show "PROP P (of_int n)" .
   47.44 -next
   47.45 -  fix n :: code_int
   47.46 -  assume "\<And>n\<Colon>int. PROP P (of_int n)"
   47.47 -  then have "PROP P (of_int (int_of n))" .
   47.48 -  then show "PROP P n" by simp
   47.49 -qed
   47.50 -
   47.51 -
   47.52 -lemma int_of_inject [simp]:
   47.53 -  "int_of k = int_of l \<longleftrightarrow> k = l"
   47.54 -  by (rule int_of_inject)
   47.55 -
   47.56 -lemma of_int_inject [simp]:
   47.57 -  "of_int n = of_int m \<longleftrightarrow> n = m"
   47.58 -  by (rule of_int_inject) (rule UNIV_I)+
   47.59 -
   47.60 -instantiation code_int :: equal
   47.61 -begin
   47.62 -
   47.63 -definition
   47.64 -  "HOL.equal k l \<longleftrightarrow> HOL.equal (int_of k) (int_of l)"
   47.65 -
   47.66 -instance proof
   47.67 -qed (auto simp add: equal_code_int_def equal_int_def equal_int_refl)
   47.68 -
   47.69 -end
   47.70 -
   47.71 -definition nat_of :: "code_int => nat"
   47.72 -where
   47.73 -  "nat_of i = nat (int_of i)"
   47.74 -  
   47.75 -instantiation code_int :: "{minus, linordered_semidom, semiring_div, neg_numeral, linorder}"
   47.76 -begin
   47.77 -
   47.78 -definition [simp, code del]:
   47.79 -  "0 = of_int 0"
   47.80 -
   47.81 -definition [simp, code del]:
   47.82 -  "1 = of_int 1"
   47.83 -
   47.84 -definition [simp, code del]:
   47.85 -  "n + m = of_int (int_of n + int_of m)"
   47.86 -
   47.87 -definition [simp, code del]:
   47.88 -  "- n = of_int (- int_of n)"
   47.89 -
   47.90 -definition [simp, code del]:
   47.91 -  "n - m = of_int (int_of n - int_of m)"
   47.92 -
   47.93 -definition [simp, code del]:
   47.94 -  "n * m = of_int (int_of n * int_of m)"
   47.95 -
   47.96 -definition [simp, code del]:
   47.97 -  "n div m = of_int (int_of n div int_of m)"
   47.98 -
   47.99 -definition [simp, code del]:
  47.100 -  "n mod m = of_int (int_of n mod int_of m)"
  47.101 -
  47.102 -definition [simp, code del]:
  47.103 -  "n \<le> m \<longleftrightarrow> int_of n \<le> int_of m"
  47.104 -
  47.105 -definition [simp, code del]:
  47.106 -  "n < m \<longleftrightarrow> int_of n < int_of m"
  47.107 -
  47.108 -instance proof
  47.109 -qed (auto simp add: code_int distrib_right zmult_zless_mono2)
  47.110 -
  47.111 -end
  47.112 -
  47.113 -lemma int_of_numeral [simp]:
  47.114 -  "int_of (numeral k) = numeral k"
  47.115 -  by (induct k) (simp_all only: numeral.simps plus_code_int_def
  47.116 -    one_code_int_def of_int_inverse UNIV_I)
  47.117 -
  47.118 -definition Num :: "num \<Rightarrow> code_int"
  47.119 -  where [code_abbrev]: "Num = numeral"
  47.120 -
  47.121 -lemma [code_abbrev]:
  47.122 -  "- numeral k = (neg_numeral k :: code_int)"
  47.123 -  by (unfold neg_numeral_def) simp
  47.124 -
  47.125 -code_datatype "0::code_int" Num
  47.126 -
  47.127 -lemma one_code_int_code [code, code_unfold]:
  47.128 -  "(1\<Colon>code_int) = Numeral1"
  47.129 -  by (simp only: numeral.simps)
  47.130 -
  47.131 -definition div_mod :: "code_int \<Rightarrow> code_int \<Rightarrow> code_int \<times> code_int" where
  47.132 -  [code del]: "div_mod n m = (n div m, n mod m)"
  47.133 -
  47.134 -lemma [code]:
  47.135 -  "n div m = fst (div_mod n m)"
  47.136 -  unfolding div_mod_def by simp
  47.137 -
  47.138 -lemma [code]:
  47.139 -  "n mod m = snd (div_mod n m)"
  47.140 -  unfolding div_mod_def by simp
  47.141 -
  47.142 -lemma int_of_code [code]:
  47.143 -  "int_of k = (if k = 0 then 0
  47.144 -    else (if k mod 2 = 0 then 2 * int_of (k div 2) else 2 * int_of (k div 2) + 1))"
  47.145 -proof -
  47.146 -  have 1: "(int_of k div 2) * 2 + int_of k mod 2 = int_of k" 
  47.147 -    by (rule mod_div_equality)
  47.148 -  have "int_of k mod 2 = 0 \<or> int_of k mod 2 = 1" by auto
  47.149 -  from this show ?thesis
  47.150 -    apply auto
  47.151 -    apply (insert 1) by (auto simp add: mult_ac)
  47.152 -qed
  47.153 -
  47.154 -
  47.155 -code_instance code_numeral :: equal
  47.156 -  (Haskell_Quickcheck -)
  47.157 -
  47.158 -setup {* fold (Numeral.add_code @{const_name Num}
  47.159 -  false Code_Printer.literal_numeral) ["Haskell_Quickcheck"]  *}
  47.160 -
  47.161 -code_type code_int
  47.162 -  (Haskell_Quickcheck "Prelude.Int")
  47.163 -
  47.164 -code_const "0 \<Colon> code_int"
  47.165 -  (Haskell_Quickcheck "0")
  47.166 -
  47.167 -code_const "1 \<Colon> code_int"
  47.168 -  (Haskell_Quickcheck "1")
  47.169 -
  47.170 -code_const "minus \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> code_int"
  47.171 -  (Haskell_Quickcheck infixl 6 "-")
  47.172 -
  47.173 -code_const div_mod
  47.174 -  (Haskell_Quickcheck "divMod")
  47.175 -
  47.176 -code_const "HOL.equal \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
  47.177 -  (Haskell_Quickcheck infix 4 "==")
  47.178 -
  47.179 -code_const "less_eq \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
  47.180 -  (Haskell_Quickcheck infix 4 "<=")
  47.181 -
  47.182 -code_const "less \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
  47.183 -  (Haskell_Quickcheck infix 4 "<")
  47.184 -
  47.185 -code_abort of_int
  47.186 -
  47.187 -hide_const (open) Num div_mod
  47.188  
  47.189  subsubsection {* Narrowing's deep representation of types and terms *}
  47.190  
  47.191  datatype narrowing_type = Narrowing_sum_of_products "narrowing_type list list"
  47.192 -datatype narrowing_term = Narrowing_variable "code_int list" narrowing_type | Narrowing_constructor code_int "narrowing_term list"
  47.193 +datatype narrowing_term = Narrowing_variable "integer list" narrowing_type | Narrowing_constructor integer "narrowing_term list"
  47.194  datatype 'a narrowing_cons = Narrowing_cons narrowing_type "(narrowing_term list => 'a) list"
  47.195  
  47.196  primrec map_cons :: "('a => 'b) => 'a narrowing_cons => 'b narrowing_cons"
  47.197 @@ -207,7 +45,7 @@
  47.198   
  47.199  subsubsection {* Auxilary functions for Narrowing *}
  47.200  
  47.201 -consts nth :: "'a list => code_int => 'a"
  47.202 +consts nth :: "'a list => integer => 'a"
  47.203  
  47.204  code_const nth (Haskell_Quickcheck infixl 9  "!!")
  47.205  
  47.206 @@ -215,7 +53,7 @@
  47.207  
  47.208  code_const error (Haskell_Quickcheck "error")
  47.209  
  47.210 -consts toEnum :: "code_int => char"
  47.211 +consts toEnum :: "integer => char"
  47.212  
  47.213  code_const toEnum (Haskell_Quickcheck "Prelude.toEnum")
  47.214  
  47.215 @@ -225,7 +63,7 @@
  47.216  
  47.217  subsubsection {* Narrowing's basic operations *}
  47.218  
  47.219 -type_synonym 'a narrowing = "code_int => 'a narrowing_cons"
  47.220 +type_synonym 'a narrowing = "integer => 'a narrowing_cons"
  47.221  
  47.222  definition empty :: "'a narrowing"
  47.223  where
  47.224 @@ -267,35 +105,33 @@
  47.225  using assms unfolding sum_def by (auto split: narrowing_cons.split narrowing_type.split)
  47.226  
  47.227  lemma [fundef_cong]:
  47.228 -  assumes "f d = f' d" "(\<And>d'. 0 <= d' & d' < d ==> a d' = a' d')"
  47.229 +  assumes "f d = f' d" "(\<And>d'. 0 \<le> d' \<and> d' < d \<Longrightarrow> a d' = a' d')"
  47.230    assumes "d = d'"
  47.231    shows "apply f a d = apply f' a' d'"
  47.232  proof -
  47.233 -  note assms moreover
  47.234 -  have "int_of (of_int 0) < int_of d' ==> int_of (of_int 0) <= int_of (of_int (int_of d' - int_of (of_int 1)))"
  47.235 -    by (simp add: of_int_inverse)
  47.236 -  moreover
  47.237 -  have "int_of (of_int (int_of d' - int_of (of_int 1))) < int_of d'"
  47.238 -    by (simp add: of_int_inverse)
  47.239 +  note assms
  47.240 +  moreover have "0 < d' \<Longrightarrow> 0 \<le> d' - 1"
  47.241 +    by (simp add: less_integer_def less_eq_integer_def)
  47.242    ultimately show ?thesis
  47.243 -    unfolding apply_def by (auto split: narrowing_cons.split narrowing_type.split simp add: Let_def)
  47.244 +    by (auto simp add: apply_def Let_def
  47.245 +      split: narrowing_cons.split narrowing_type.split)
  47.246  qed
  47.247  
  47.248  subsubsection {* Narrowing generator type class *}
  47.249  
  47.250  class narrowing =
  47.251 -  fixes narrowing :: "code_int => 'a narrowing_cons"
  47.252 +  fixes narrowing :: "integer => 'a narrowing_cons"
  47.253  
  47.254  datatype property = Universal narrowing_type "(narrowing_term => property)" "narrowing_term => Code_Evaluation.term" | Existential narrowing_type "(narrowing_term => property)" "narrowing_term => Code_Evaluation.term" | Property bool
  47.255  
  47.256  (* FIXME: hard-wired maximal depth of 100 here *)
  47.257  definition exists :: "('a :: {narrowing, partial_term_of} => property) => property"
  47.258  where
  47.259 -  "exists f = (case narrowing (100 :: code_int) of Narrowing_cons ty cs => Existential ty (\<lambda> t. f (conv cs t)) (partial_term_of (TYPE('a))))"
  47.260 +  "exists f = (case narrowing (100 :: integer) of Narrowing_cons ty cs => Existential ty (\<lambda> t. f (conv cs t)) (partial_term_of (TYPE('a))))"
  47.261  
  47.262  definition "all" :: "('a :: {narrowing, partial_term_of} => property) => property"
  47.263  where
  47.264 -  "all f = (case narrowing (100 :: code_int) of Narrowing_cons ty cs => Universal ty (\<lambda>t. f (conv cs t)) (partial_term_of (TYPE('a))))"
  47.265 +  "all f = (case narrowing (100 :: integer) of Narrowing_cons ty cs => Universal ty (\<lambda>t. f (conv cs t)) (partial_term_of (TYPE('a))))"
  47.266  
  47.267  subsubsection {* class @{text is_testable} *}
  47.268  
  47.269 @@ -343,14 +179,14 @@
  47.270  where
  47.271    "narrowing_dummy_partial_term_of = partial_term_of"
  47.272  
  47.273 -definition narrowing_dummy_narrowing :: "code_int => ('a :: narrowing) narrowing_cons"
  47.274 +definition narrowing_dummy_narrowing :: "integer => ('a :: narrowing) narrowing_cons"
  47.275  where
  47.276    "narrowing_dummy_narrowing = narrowing"
  47.277  
  47.278  lemma [code]:
  47.279    "ensure_testable f =
  47.280      (let
  47.281 -      x = narrowing_dummy_narrowing :: code_int => bool narrowing_cons;
  47.282 +      x = narrowing_dummy_narrowing :: integer => bool narrowing_cons;
  47.283        y = narrowing_dummy_partial_term_of :: bool itself => narrowing_term => term;
  47.284        z = (conv :: _ => _ => unit)  in f)"
  47.285  unfolding Let_def ensure_testable_def ..
  47.286 @@ -369,47 +205,76 @@
  47.287  subsection {* Narrowing for integers *}
  47.288  
  47.289  
  47.290 -definition drawn_from :: "'a list => 'a narrowing_cons"
  47.291 -where "drawn_from xs = Narrowing_cons (Narrowing_sum_of_products (map (%_. []) xs)) (map (%x y. x) xs)"
  47.292 +definition drawn_from :: "'a list \<Rightarrow> 'a narrowing_cons"
  47.293 +where
  47.294 +  "drawn_from xs =
  47.295 +    Narrowing_cons (Narrowing_sum_of_products (map (\<lambda>_. []) xs)) (map (\<lambda>x _. x) xs)"
  47.296  
  47.297 -function around_zero :: "int => int list"
  47.298 +function around_zero :: "int \<Rightarrow> int list"
  47.299  where
  47.300    "around_zero i = (if i < 0 then [] else (if i = 0 then [0] else around_zero (i - 1) @ [i, -i]))"
  47.301 -by pat_completeness auto
  47.302 +  by pat_completeness auto
  47.303  termination by (relation "measure nat") auto
  47.304  
  47.305 -declare around_zero.simps[simp del]
  47.306 +declare around_zero.simps [simp del]
  47.307  
  47.308  lemma length_around_zero:
  47.309    assumes "i >= 0" 
  47.310    shows "length (around_zero i) = 2 * nat i + 1"
  47.311 -proof (induct rule: int_ge_induct[OF assms])
  47.312 +proof (induct rule: int_ge_induct [OF assms])
  47.313    case 1
  47.314    from 1 show ?case by (simp add: around_zero.simps)
  47.315  next
  47.316    case (2 i)
  47.317    from 2 show ?case
  47.318 -    by (simp add: around_zero.simps[of "i + 1"])
  47.319 +    by (simp add: around_zero.simps [of "i + 1"])
  47.320  qed
  47.321  
  47.322  instantiation int :: narrowing
  47.323  begin
  47.324  
  47.325  definition
  47.326 -  "narrowing_int d = (let (u :: _ => _ => unit) = conv; i = Quickcheck_Narrowing.int_of d in drawn_from (around_zero i))"
  47.327 +  "narrowing_int d = (let (u :: _ \<Rightarrow> _ \<Rightarrow> unit) = conv; i = int_of_integer d
  47.328 +    in drawn_from (around_zero i))"
  47.329  
  47.330  instance ..
  47.331  
  47.332  end
  47.333  
  47.334 -lemma [code, code del]: "partial_term_of (ty :: int itself) t == undefined"
  47.335 -by (rule partial_term_of_anything)+
  47.336 +lemma [code, code del]: "partial_term_of (ty :: int itself) t \<equiv> undefined"
  47.337 +  by (rule partial_term_of_anything)+
  47.338  
  47.339  lemma [code]:
  47.340 -  "partial_term_of (ty :: int itself) (Narrowing_variable p t) == Code_Evaluation.Free (STR ''_'') (Typerep.Typerep (STR ''Int.int'') [])"
  47.341 -  "partial_term_of (ty :: int itself) (Narrowing_constructor i []) == (if i mod 2 = 0 then
  47.342 -     Code_Evaluation.term_of (- (int_of i) div 2) else Code_Evaluation.term_of ((int_of i + 1) div 2))"
  47.343 -by (rule partial_term_of_anything)+
  47.344 +  "partial_term_of (ty :: int itself) (Narrowing_variable p t) \<equiv>
  47.345 +    Code_Evaluation.Free (STR ''_'') (Typerep.Typerep (STR ''Int.int'') [])"
  47.346 +  "partial_term_of (ty :: int itself) (Narrowing_constructor i []) \<equiv>
  47.347 +    (if i mod 2 = 0
  47.348 +     then Code_Evaluation.term_of (- (int_of_integer i) div 2)
  47.349 +     else Code_Evaluation.term_of ((int_of_integer i + 1) div 2))"
  47.350 +  by (rule partial_term_of_anything)+
  47.351 +
  47.352 +instantiation integer :: narrowing
  47.353 +begin
  47.354 +
  47.355 +definition
  47.356 +  "narrowing_integer d = (let (u :: _ \<Rightarrow> _ \<Rightarrow> unit) = conv; i = int_of_integer d
  47.357 +    in drawn_from (map integer_of_int (around_zero i)))"
  47.358 +
  47.359 +instance ..
  47.360 +
  47.361 +end
  47.362 +
  47.363 +lemma [code, code del]: "partial_term_of (ty :: integer itself) t \<equiv> undefined"
  47.364 +  by (rule partial_term_of_anything)+
  47.365 +
  47.366 +lemma [code]:
  47.367 +  "partial_term_of (ty :: integer itself) (Narrowing_variable p t) \<equiv>
  47.368 +    Code_Evaluation.Free (STR ''_'') (Typerep.Typerep (STR ''Code_Numeral.integer'') [])"
  47.369 +  "partial_term_of (ty :: integer itself) (Narrowing_constructor i []) \<equiv>
  47.370 +    (if i mod 2 = 0
  47.371 +     then Code_Evaluation.term_of (- i div 2)
  47.372 +     else Code_Evaluation.term_of ((i + 1) div 2))"
  47.373 +  by (rule partial_term_of_anything)+
  47.374  
  47.375  
  47.376  subsection {* The @{text find_unused_assms} command *}
  47.377 @@ -418,9 +283,10 @@
  47.378  
  47.379  subsection {* Closing up *}
  47.380  
  47.381 -hide_type code_int narrowing_type narrowing_term narrowing_cons property
  47.382 -hide_const int_of of_int nat_of map_cons nth error toEnum marker empty Narrowing_cons conv non_empty ensure_testable all exists drawn_from around_zero
  47.383 +hide_type narrowing_type narrowing_term narrowing_cons property
  47.384 +hide_const map_cons nth error toEnum marker empty Narrowing_cons conv non_empty ensure_testable all exists drawn_from around_zero
  47.385  hide_const (open) Narrowing_variable Narrowing_constructor "apply" sum cons
  47.386  hide_fact empty_def cons_def conv.simps non_empty.simps apply_def sum_def ensure_testable_def all_def exists_def
  47.387  
  47.388  end
  47.389 +
    48.1 --- a/src/HOL/Quickcheck_Random.thy	Fri Feb 15 08:31:30 2013 +0100
    48.2 +++ b/src/HOL/Quickcheck_Random.thy	Fri Feb 15 08:31:31 2013 +0100
    48.3 @@ -21,7 +21,7 @@
    48.4  subsection {* The @{text random} class *}
    48.5  
    48.6  class random = typerep +
    48.7 -  fixes random :: "code_numeral \<Rightarrow> Random.seed \<Rightarrow> ('a \<times> (unit \<Rightarrow> term)) \<times> Random.seed"
    48.8 +  fixes random :: "natural \<Rightarrow> Random.seed \<Rightarrow> ('a \<times> (unit \<Rightarrow> term)) \<times> Random.seed"
    48.9  
   48.10  
   48.11  subsection {* Fundamental and numeric types*}
   48.12 @@ -41,7 +41,7 @@
   48.13  begin
   48.14  
   48.15  definition
   48.16 -  random_itself :: "code_numeral \<Rightarrow> Random.seed \<Rightarrow> ('a itself \<times> (unit \<Rightarrow> term)) \<times> Random.seed"
   48.17 +  random_itself :: "natural \<Rightarrow> Random.seed \<Rightarrow> ('a itself \<times> (unit \<Rightarrow> term)) \<times> Random.seed"
   48.18  where "random_itself _ = Pair (Code_Evaluation.valtermify TYPE('a))"
   48.19  
   48.20  instance ..
   48.21 @@ -71,11 +71,11 @@
   48.22  instantiation nat :: random
   48.23  begin
   48.24  
   48.25 -definition random_nat :: "code_numeral \<Rightarrow> Random.seed
   48.26 +definition random_nat :: "natural \<Rightarrow> Random.seed
   48.27    \<Rightarrow> (nat \<times> (unit \<Rightarrow> Code_Evaluation.term)) \<times> Random.seed"
   48.28  where
   48.29    "random_nat i = Random.range (i + 1) \<circ>\<rightarrow> (\<lambda>k. Pair (
   48.30 -     let n = Code_Numeral.nat_of k
   48.31 +     let n = nat_of_natural k
   48.32       in (n, \<lambda>_. Code_Evaluation.term_of n)))"
   48.33  
   48.34  instance ..
   48.35 @@ -87,13 +87,39 @@
   48.36  
   48.37  definition
   48.38    "random i = Random.range (2 * i + 1) \<circ>\<rightarrow> (\<lambda>k. Pair (
   48.39 -     let j = (if k \<ge> i then Code_Numeral.int_of (k - i) else - Code_Numeral.int_of (i - k))
   48.40 +     let j = (if k \<ge> i then int (nat_of_natural (k - i)) else - (int (nat_of_natural (i - k))))
   48.41       in (j, \<lambda>_. Code_Evaluation.term_of j)))"
   48.42  
   48.43  instance ..
   48.44  
   48.45  end
   48.46  
   48.47 +instantiation natural :: random
   48.48 +begin
   48.49 +
   48.50 +definition random_natural :: "natural \<Rightarrow> Random.seed
   48.51 +  \<Rightarrow> (natural \<times> (unit \<Rightarrow> Code_Evaluation.term)) \<times> Random.seed"
   48.52 +where
   48.53 +  "random_natural i = Random.range (i + 1) \<circ>\<rightarrow> (\<lambda>n. Pair (n, \<lambda>_. Code_Evaluation.term_of n))"
   48.54 +
   48.55 +instance ..
   48.56 +
   48.57 +end
   48.58 +
   48.59 +instantiation integer :: random
   48.60 +begin
   48.61 +
   48.62 +definition random_integer :: "natural \<Rightarrow> Random.seed
   48.63 +  \<Rightarrow> (integer \<times> (unit \<Rightarrow> Code_Evaluation.term)) \<times> Random.seed"
   48.64 +where
   48.65 +  "random_integer i = Random.range (2 * i + 1) \<circ>\<rightarrow> (\<lambda>k. Pair (
   48.66 +     let j = (if k \<ge> i then integer_of_natural (k - i) else - (integer_of_natural (i - k)))
   48.67 +      in (j, \<lambda>_. Code_Evaluation.term_of j)))"
   48.68 +
   48.69 +instance ..
   48.70 +
   48.71 +end
   48.72 +
   48.73  
   48.74  subsection {* Complex generators *}
   48.75  
   48.76 @@ -114,7 +140,7 @@
   48.77  begin
   48.78  
   48.79  definition
   48.80 -  random_fun :: "code_numeral \<Rightarrow> Random.seed \<Rightarrow> (('a \<Rightarrow> 'b) \<times> (unit \<Rightarrow> term)) \<times> Random.seed"
   48.81 +  random_fun :: "natural \<Rightarrow> Random.seed \<Rightarrow> (('a \<Rightarrow> 'b) \<times> (unit \<Rightarrow> term)) \<times> Random.seed"
   48.82    where "random i = random_fun_lift (random i)"
   48.83  
   48.84  instance ..
   48.85 @@ -126,7 +152,7 @@
   48.86  definition collapse :: "('a \<Rightarrow> ('a \<Rightarrow> 'b \<times> 'a) \<times> 'a) \<Rightarrow> 'a \<Rightarrow> 'b \<times> 'a"
   48.87    where "collapse f = (f \<circ>\<rightarrow> id)"
   48.88  
   48.89 -definition beyond :: "code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   48.90 +definition beyond :: "natural \<Rightarrow> natural \<Rightarrow> natural"
   48.91    where "beyond k l = (if l > k then l else 0)"
   48.92  
   48.93  lemma beyond_zero: "beyond k 0 = 0"
   48.94 @@ -155,13 +181,13 @@
   48.95    "random_aux_set i j =
   48.96      collapse (Random.select_weight [(1, Pair valterm_emptyset),
   48.97        (i, random j \<circ>\<rightarrow> (%x. random_aux_set (i - 1) j \<circ>\<rightarrow> (%s. Pair (valtermify_insert x s))))])"
   48.98 -proof (induct i rule: code_numeral.induct)
   48.99 +proof (induct i rule: natural.induct)
  48.100    case zero
  48.101    show ?case by (subst select_weight_drop_zero [symmetric])
  48.102 -    (simp add: random_aux_set.simps [simplified])
  48.103 +    (simp add: random_aux_set.simps [simplified] less_natural_def)
  48.104  next
  48.105    case (Suc i)
  48.106 -  show ?case by (simp only: random_aux_set.simps(2) [of "i"] Suc_code_numeral_minus_one)
  48.107 +  show ?case by (simp only: random_aux_set.simps(2) [of "i"] Suc_natural_minus_one)
  48.108  qed
  48.109  
  48.110  definition "random_set i = random_aux_set i i"
  48.111 @@ -171,11 +197,11 @@
  48.112  end
  48.113  
  48.114  lemma random_aux_rec:
  48.115 -  fixes random_aux :: "code_numeral \<Rightarrow> 'a"
  48.116 +  fixes random_aux :: "natural \<Rightarrow> 'a"
  48.117    assumes "random_aux 0 = rhs 0"
  48.118      and "\<And>k. random_aux (Code_Numeral.Suc k) = rhs (Code_Numeral.Suc k)"
  48.119    shows "random_aux k = rhs k"
  48.120 -  using assms by (rule code_numeral.induct)
  48.121 +  using assms by (rule natural.induct)
  48.122  
  48.123  subsection {* Deriving random generators for datatypes *}
  48.124  
    49.1 --- a/src/HOL/ROOT	Fri Feb 15 08:31:30 2013 +0100
    49.2 +++ b/src/HOL/ROOT	Fri Feb 15 08:31:31 2013 +0100
    49.3 @@ -28,8 +28,6 @@
    49.4      Code_Char_ord
    49.5      Product_Lexorder
    49.6      Product_Order
    49.7 -    Code_Integer
    49.8 -    Efficient_Nat
    49.9      (* Code_Prolog  FIXME cf. 76965c356d2a *)
   49.10      Code_Real_Approx_By_Float
   49.11      Code_Target_Numeral
   49.12 @@ -282,7 +280,6 @@
   49.13    theories [document = false]
   49.14      "~~/src/HOL/Library/Countable"
   49.15      "~~/src/HOL/Library/Monad_Syntax"
   49.16 -    "~~/src/HOL/Library/Code_Natural"
   49.17      "~~/src/HOL/Library/LaTeXsugar"
   49.18    theories Imperative_HOL_ex
   49.19    files "document/root.bib" "document/root.tex"
   49.20 @@ -299,7 +296,7 @@
   49.21    description {* Examples for program extraction in Higher-Order Logic *}
   49.22    options [condition = ISABELLE_POLYML, proofs = 2, parallel_proofs = 0]
   49.23    theories [document = false]
   49.24 -    "~~/src/HOL/Library/Efficient_Nat"
   49.25 +    "~~/src/HOL/Library/Code_Target_Numeral"
   49.26      "~~/src/HOL/Library/Monad_Syntax"
   49.27      "~~/src/HOL/Number_Theory/Primes"
   49.28      "~~/src/HOL/Number_Theory/UniqueFactorization"
   49.29 @@ -315,7 +312,7 @@
   49.30  session "HOL-Proofs-Lambda" in "Proofs/Lambda" = "HOL-Proofs" +
   49.31    options [document_graph, print_mode = "no_brackets", proofs = 2, parallel_proofs = 0]
   49.32    theories [document = false]
   49.33 -    "~~/src/HOL/Library/Code_Integer"
   49.34 +    "~~/src/HOL/Library/Code_Target_Int"
   49.35    theories
   49.36      Eta
   49.37      StrongNorm
    50.1 --- a/src/HOL/Random.thy	Fri Feb 15 08:31:30 2013 +0100
    50.2 +++ b/src/HOL/Random.thy	Fri Feb 15 08:31:31 2013 +0100
    50.3 @@ -13,21 +13,21 @@
    50.4  
    50.5  subsection {* Auxiliary functions *}
    50.6  
    50.7 -fun log :: "code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral" where
    50.8 +fun log :: "natural \<Rightarrow> natural \<Rightarrow> natural" where
    50.9    "log b i = (if b \<le> 1 \<or> i < b then 1 else 1 + log b (i div b))"
   50.10  
   50.11 -definition inc_shift :: "code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral" where
   50.12 +definition inc_shift :: "natural \<Rightarrow> natural \<Rightarrow> natural" where
   50.13    "inc_shift v k = (if v = k then 1 else k + 1)"
   50.14  
   50.15 -definition minus_shift :: "code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral" where
   50.16 +definition minus_shift :: "natural \<Rightarrow> natural \<Rightarrow> natural \<Rightarrow> natural" where
   50.17    "minus_shift r k l = (if k < l then r + k - l else k - l)"
   50.18  
   50.19  
   50.20  subsection {* Random seeds *}
   50.21  
   50.22 -type_synonym seed = "code_numeral \<times> code_numeral"
   50.23 +type_synonym seed = "natural \<times> natural"
   50.24  
   50.25 -primrec "next" :: "seed \<Rightarrow> code_numeral \<times> seed" where
   50.26 +primrec "next" :: "seed \<Rightarrow> natural \<times> seed" where
   50.27    "next (v, w) = (let
   50.28       k =  v div 53668;
   50.29       v' = minus_shift 2147483563 ((v mod 53668) * 40014) (k * 12211);
   50.30 @@ -47,55 +47,55 @@
   50.31  
   50.32  subsection {* Base selectors *}
   50.33  
   50.34 -fun iterate :: "code_numeral \<Rightarrow> ('b \<Rightarrow> 'a \<Rightarrow> 'b \<times> 'a) \<Rightarrow> 'b \<Rightarrow> 'a \<Rightarrow> 'b \<times> 'a" where
   50.35 +fun iterate :: "natural \<Rightarrow> ('b \<Rightarrow> 'a \<Rightarrow> 'b \<times> 'a) \<Rightarrow> 'b \<Rightarrow> 'a \<Rightarrow> 'b \<times> 'a" where
   50.36    "iterate k f x = (if k = 0 then Pair x else f x \<circ>\<rightarrow> iterate (k - 1) f)"
   50.37  
   50.38 -definition range :: "code_numeral \<Rightarrow> seed \<Rightarrow> code_numeral \<times> seed" where
   50.39 +definition range :: "natural \<Rightarrow> seed \<Rightarrow> natural \<times> seed" where
   50.40    "range k = iterate (log 2147483561 k)
   50.41        (\<lambda>l. next \<circ>\<rightarrow> (\<lambda>v. Pair (v + l * 2147483561))) 1
   50.42      \<circ>\<rightarrow> (\<lambda>v. Pair (v mod k))"
   50.43  
   50.44  lemma range:
   50.45    "k > 0 \<Longrightarrow> fst (range k s) < k"
   50.46 -  by (simp add: range_def split_def del: log.simps iterate.simps)
   50.47 +  by (simp add: range_def split_def less_natural_def del: log.simps iterate.simps)
   50.48  
   50.49  definition select :: "'a list \<Rightarrow> seed \<Rightarrow> 'a \<times> seed" where
   50.50 -  "select xs = range (Code_Numeral.of_nat (length xs))
   50.51 -    \<circ>\<rightarrow> (\<lambda>k. Pair (nth xs (Code_Numeral.nat_of k)))"
   50.52 +  "select xs = range (natural_of_nat (length xs))
   50.53 +    \<circ>\<rightarrow> (\<lambda>k. Pair (nth xs (nat_of_natural k)))"
   50.54       
   50.55  lemma select:
   50.56    assumes "xs \<noteq> []"
   50.57    shows "fst (select xs s) \<in> set xs"
   50.58  proof -
   50.59 -  from assms have "Code_Numeral.of_nat (length xs) > 0" by simp
   50.60 +  from assms have "natural_of_nat (length xs) > 0" by (simp add: less_natural_def)
   50.61    with range have
   50.62 -    "fst (range (Code_Numeral.of_nat (length xs)) s) < Code_Numeral.of_nat (length xs)" by best
   50.63 +    "fst (range (natural_of_nat (length xs)) s) < natural_of_nat (length xs)" by best
   50.64    then have
   50.65 -    "Code_Numeral.nat_of (fst (range (Code_Numeral.of_nat (length xs)) s)) < length xs" by simp
   50.66 +    "nat_of_natural (fst (range (natural_of_nat (length xs)) s)) < length xs" by (simp add: less_natural_def)
   50.67    then show ?thesis
   50.68      by (simp add: split_beta select_def)
   50.69  qed
   50.70  
   50.71 -primrec pick :: "(code_numeral \<times> 'a) list \<Rightarrow> code_numeral \<Rightarrow> 'a" where
   50.72 +primrec pick :: "(natural \<times> 'a) list \<Rightarrow> natural \<Rightarrow> 'a" where
   50.73    "pick (x # xs) i = (if i < fst x then snd x else pick xs (i - fst x))"
   50.74  
   50.75  lemma pick_member:
   50.76    "i < listsum (map fst xs) \<Longrightarrow> pick xs i \<in> set (map snd xs)"
   50.77 -  by (induct xs arbitrary: i) simp_all
   50.78 +  by (induct xs arbitrary: i) (simp_all add: less_natural_def)
   50.79  
   50.80  lemma pick_drop_zero:
   50.81    "pick (filter (\<lambda>(k, _). k > 0) xs) = pick xs"
   50.82 -  by (induct xs) (auto simp add: fun_eq_iff)
   50.83 +  by (induct xs) (auto simp add: fun_eq_iff less_natural_def minus_natural_def)
   50.84  
   50.85  lemma pick_same:
   50.86 -  "l < length xs \<Longrightarrow> Random.pick (map (Pair 1) xs) (Code_Numeral.of_nat l) = nth xs l"
   50.87 +  "l < length xs \<Longrightarrow> Random.pick (map (Pair 1) xs) (natural_of_nat l) = nth xs l"
   50.88  proof (induct xs arbitrary: l)
   50.89    case Nil then show ?case by simp
   50.90  next
   50.91 -  case (Cons x xs) then show ?case by (cases l) simp_all
   50.92 +  case (Cons x xs) then show ?case by (cases l) (simp_all add: less_natural_def)
   50.93  qed
   50.94  
   50.95 -definition select_weight :: "(code_numeral \<times> 'a) list \<Rightarrow> seed \<Rightarrow> 'a \<times> seed" where
   50.96 +definition select_weight :: "(natural \<times> 'a) list \<Rightarrow> seed \<Rightarrow> 'a \<times> seed" where
   50.97    "select_weight xs = range (listsum (map fst xs))
   50.98     \<circ>\<rightarrow> (\<lambda>k. Pair (pick xs k))"
   50.99  
  50.100 @@ -112,13 +112,13 @@
  50.101  
  50.102  lemma select_weight_cons_zero:
  50.103    "select_weight ((0, x) # xs) = select_weight xs"
  50.104 -  by (simp add: select_weight_def)
  50.105 +  by (simp add: select_weight_def less_natural_def)
  50.106  
  50.107  lemma select_weight_drop_zero:
  50.108    "select_weight (filter (\<lambda>(k, _). k > 0) xs) = select_weight xs"
  50.109  proof -
  50.110    have "listsum (map fst [(k, _)\<leftarrow>xs . 0 < k]) = listsum (map fst xs)"
  50.111 -    by (induct xs) auto
  50.112 +    by (induct xs) (auto simp add: less_natural_def, simp add: plus_natural_def)
  50.113    then show ?thesis by (simp only: select_weight_def pick_drop_zero)
  50.114  qed
  50.115  
  50.116 @@ -126,13 +126,13 @@
  50.117    assumes "xs \<noteq> []"
  50.118    shows "select_weight (map (Pair 1) xs) = select xs"
  50.119  proof -
  50.120 -  have less: "\<And>s. fst (range (Code_Numeral.of_nat (length xs)) s) < Code_Numeral.of_nat (length xs)"
  50.121 -    using assms by (intro range) simp
  50.122 -  moreover have "listsum (map fst (map (Pair 1) xs)) = Code_Numeral.of_nat (length xs)"
  50.123 +  have less: "\<And>s. fst (range (natural_of_nat (length xs)) s) < natural_of_nat (length xs)"
  50.124 +    using assms by (intro range) (simp add: less_natural_def)
  50.125 +  moreover have "listsum (map fst (map (Pair 1) xs)) = natural_of_nat (length xs)"
  50.126      by (induct xs) simp_all
  50.127    ultimately show ?thesis
  50.128      by (auto simp add: select_weight_def select_def scomp_def split_def
  50.129 -      fun_eq_iff pick_same [symmetric])
  50.130 +      fun_eq_iff pick_same [symmetric] less_natural_def)
  50.131  qed
  50.132  
  50.133  
  50.134 @@ -147,7 +147,7 @@
  50.135  
  50.136  open Random_Engine;
  50.137  
  50.138 -type seed = int * int;
  50.139 +type seed = Code_Numeral.natural * Code_Numeral.natural;
  50.140  
  50.141  local
  50.142  
  50.143 @@ -156,7 +156,7 @@
  50.144      val now = Time.toMilliseconds (Time.now ());
  50.145      val (q, s1) = IntInf.divMod (now, 2147483562);
  50.146      val s2 = q mod 2147483398;
  50.147 -  in (s1 + 1, s2 + 1) end);
  50.148 +  in pairself Code_Numeral.natural_of_integer (s1 + 1, s2 + 1) end);
  50.149  
  50.150  in
  50.151  
  50.152 @@ -188,3 +188,4 @@
  50.153  no_notation scomp (infixl "\<circ>\<rightarrow>" 60)
  50.154  
  50.155  end
  50.156 +
    51.1 --- a/src/HOL/Random_Pred.thy	Fri Feb 15 08:31:30 2013 +0100
    51.2 +++ b/src/HOL/Random_Pred.thy	Fri Feb 15 08:31:31 2013 +0100
    51.3 @@ -7,13 +7,13 @@
    51.4  imports Quickcheck_Random
    51.5  begin
    51.6  
    51.7 -fun iter' :: "'a itself \<Rightarrow> code_numeral \<Rightarrow> code_numeral \<Rightarrow> Random.seed \<Rightarrow> ('a::random) Predicate.pred"
    51.8 +fun iter' :: "'a itself \<Rightarrow> natural \<Rightarrow> natural \<Rightarrow> Random.seed \<Rightarrow> ('a::random) Predicate.pred"
    51.9  where
   51.10    "iter' T nrandom sz seed = (if nrandom = 0 then bot_class.bot else
   51.11       let ((x, _), seed') = Quickcheck_Random.random sz seed
   51.12     in Predicate.Seq (%u. Predicate.Insert x (iter' T (nrandom - 1) sz seed')))"
   51.13  
   51.14 -definition iter :: "code_numeral \<Rightarrow> code_numeral \<Rightarrow> Random.seed \<Rightarrow> ('a::random) Predicate.pred"
   51.15 +definition iter :: "natural \<Rightarrow> natural \<Rightarrow> Random.seed \<Rightarrow> ('a::random) Predicate.pred"
   51.16  where
   51.17    "iter nrandom sz seed = iter' (TYPE('a)) nrandom sz seed"
   51.18  
   51.19 @@ -48,7 +48,7 @@
   51.20  where
   51.21    "if_randompred b = (if b then single () else empty)"
   51.22  
   51.23 -definition iterate_upto :: "(code_numeral \<Rightarrow> 'a) => code_numeral \<Rightarrow> code_numeral \<Rightarrow> 'a random_pred"
   51.24 +definition iterate_upto :: "(natural \<Rightarrow> 'a) => natural \<Rightarrow> natural \<Rightarrow> 'a random_pred"
   51.25  where
   51.26    "iterate_upto f n m = Pair (Predicate.iterate_upto f n m)"
   51.27  
    52.1 --- a/src/HOL/Random_Sequence.thy	Fri Feb 15 08:31:30 2013 +0100
    52.2 +++ b/src/HOL/Random_Sequence.thy	Fri Feb 15 08:31:31 2013 +0100
    52.3 @@ -7,7 +7,7 @@
    52.4  imports Random_Pred
    52.5  begin
    52.6  
    52.7 -type_synonym 'a random_dseq = "code_numeral \<Rightarrow> code_numeral \<Rightarrow> Random.seed \<Rightarrow> ('a Limited_Sequence.dseq \<times> Random.seed)"
    52.8 +type_synonym 'a random_dseq = "natural \<Rightarrow> natural \<Rightarrow> Random.seed \<Rightarrow> ('a Limited_Sequence.dseq \<times> Random.seed)"
    52.9  
   52.10  definition empty :: "'a random_dseq"
   52.11  where
   52.12 @@ -44,13 +44,13 @@
   52.13  where
   52.14    "map f P = bind P (single o f)"
   52.15  
   52.16 -fun Random :: "(code_numeral \<Rightarrow> Random.seed \<Rightarrow> (('a \<times> (unit \<Rightarrow> term)) \<times> Random.seed)) \<Rightarrow> 'a random_dseq"
   52.17 +fun Random :: "(natural \<Rightarrow> Random.seed \<Rightarrow> (('a \<times> (unit \<Rightarrow> term)) \<times> Random.seed)) \<Rightarrow> 'a random_dseq"
   52.18  where
   52.19    "Random g nrandom = (%size. if nrandom <= 0 then (Pair Limited_Sequence.empty) else
   52.20       (scomp (g size) (%r. scomp (Random g (nrandom - 1) size) (%rs. Pair (Limited_Sequence.union (Limited_Sequence.single (fst r)) rs)))))"
   52.21  
   52.22  
   52.23 -type_synonym 'a pos_random_dseq = "code_numeral \<Rightarrow> code_numeral \<Rightarrow> Random.seed \<Rightarrow> 'a Limited_Sequence.pos_dseq"
   52.24 +type_synonym 'a pos_random_dseq = "natural \<Rightarrow> natural \<Rightarrow> Random.seed \<Rightarrow> 'a Limited_Sequence.pos_dseq"
   52.25  
   52.26  definition pos_empty :: "'a pos_random_dseq"
   52.27  where
   52.28 @@ -76,7 +76,7 @@
   52.29  where
   52.30    "pos_if_random_dseq b = (if b then pos_single () else pos_empty)"
   52.31  
   52.32 -definition pos_iterate_upto :: "(code_numeral => 'a) => code_numeral => code_numeral => 'a pos_random_dseq"
   52.33 +definition pos_iterate_upto :: "(natural => 'a) => natural => natural => 'a pos_random_dseq"
   52.34  where
   52.35    "pos_iterate_upto f n m = (\<lambda>nrandom size seed. Limited_Sequence.pos_iterate_upto f n m)"
   52.36  
   52.37 @@ -85,18 +85,18 @@
   52.38    "pos_map f P = pos_bind P (pos_single o f)"
   52.39  
   52.40  fun iter :: "(Random.seed \<Rightarrow> ('a \<times> (unit \<Rightarrow> term)) \<times> Random.seed)
   52.41 -  \<Rightarrow> code_numeral \<Rightarrow> Random.seed \<Rightarrow> 'a Lazy_Sequence.lazy_sequence"
   52.42 +  \<Rightarrow> natural \<Rightarrow> Random.seed \<Rightarrow> 'a Lazy_Sequence.lazy_sequence"
   52.43  where
   52.44    "iter random nrandom seed =
   52.45      (if nrandom = 0 then Lazy_Sequence.empty else Lazy_Sequence.Lazy_Sequence (%u. let ((x, _), seed') = random seed in Some (x, iter random (nrandom - 1) seed')))"
   52.46  
   52.47 -definition pos_Random :: "(code_numeral \<Rightarrow> Random.seed \<Rightarrow> ('a \<times> (unit \<Rightarrow> term)) \<times> Random.seed)
   52.48 +definition pos_Random :: "(natural \<Rightarrow> Random.seed \<Rightarrow> ('a \<times> (unit \<Rightarrow> term)) \<times> Random.seed)
   52.49    \<Rightarrow> 'a pos_random_dseq"
   52.50  where
   52.51    "pos_Random g = (%nrandom size seed depth. iter (g size) nrandom seed)"
   52.52  
   52.53  
   52.54 -type_synonym 'a neg_random_dseq = "code_numeral \<Rightarrow> code_numeral \<Rightarrow> Random.seed \<Rightarrow> 'a Limited_Sequence.neg_dseq"
   52.55 +type_synonym 'a neg_random_dseq = "natural \<Rightarrow> natural \<Rightarrow> Random.seed \<Rightarrow> 'a Limited_Sequence.neg_dseq"
   52.56  
   52.57  definition neg_empty :: "'a neg_random_dseq"
   52.58  where
   52.59 @@ -122,7 +122,7 @@
   52.60  where
   52.61    "neg_if_random_dseq b = (if b then neg_single () else neg_empty)"
   52.62  
   52.63 -definition neg_iterate_upto :: "(code_numeral => 'a) => code_numeral => code_numeral => 'a neg_random_dseq"
   52.64 +definition neg_iterate_upto :: "(natural => 'a) => natural => natural => 'a neg_random_dseq"
   52.65  where
   52.66    "neg_iterate_upto f n m = (\<lambda>nrandom size seed. Limited_Sequence.neg_iterate_upto f n m)"
   52.67  
    53.1 --- a/src/HOL/Rat.thy	Fri Feb 15 08:31:30 2013 +0100
    53.2 +++ b/src/HOL/Rat.thy	Fri Feb 15 08:31:31 2013 +0100
    53.3 @@ -1031,7 +1031,7 @@
    53.4  
    53.5  definition
    53.6    "Quickcheck_Random.random i = Quickcheck_Random.random i \<circ>\<rightarrow> (\<lambda>num. Random.range i \<circ>\<rightarrow> (\<lambda>denom. Pair (
    53.7 -     let j = Code_Numeral.int_of (denom + 1)
    53.8 +     let j = int_of_integer (integer_of_natural (denom + 1))
    53.9       in valterm_fract num (j, \<lambda>u. Code_Evaluation.term_of j))))"
   53.10  
   53.11  instance ..
   53.12 @@ -1045,7 +1045,8 @@
   53.13  begin
   53.14  
   53.15  definition
   53.16 -  "exhaustive_rat f d = Quickcheck_Exhaustive.exhaustive (%l. Quickcheck_Exhaustive.exhaustive (%k. f (Fract k (Code_Numeral.int_of l + 1))) d) d"
   53.17 +  "exhaustive_rat f d = Quickcheck_Exhaustive.exhaustive
   53.18 +    (\<lambda>l. Quickcheck_Exhaustive.exhaustive (\<lambda>k. f (Fract k (int_of_integer (integer_of_natural l) + 1))) d) d"
   53.19  
   53.20  instance ..
   53.21  
   53.22 @@ -1056,7 +1057,7 @@
   53.23  
   53.24  definition
   53.25    "full_exhaustive_rat f d = Quickcheck_Exhaustive.full_exhaustive (%(l, _). Quickcheck_Exhaustive.full_exhaustive (%k.
   53.26 -     f (let j = Code_Numeral.int_of l + 1
   53.27 +     f (let j = int_of_integer (integer_of_natural l) + 1
   53.28          in valterm_fract k (j, %_. Code_Evaluation.term_of j))) d) d"
   53.29  
   53.30  instance ..
   53.31 @@ -1135,3 +1136,4 @@
   53.32  declare Quotient_rat[quot_del]
   53.33  
   53.34  end
   53.35 +
    54.1 --- a/src/HOL/Tools/Nitpick/nitpick_hol.ML	Fri Feb 15 08:31:30 2013 +0100
    54.2 +++ b/src/HOL/Tools/Nitpick/nitpick_hol.ML	Fri Feb 15 08:31:31 2013 +0100
    54.3 @@ -589,11 +589,11 @@
    54.4  val is_real_datatype = is_some oo Datatype.get_info
    54.5  fun is_standard_datatype thy = the oo triple_lookup (type_match thy)
    54.6  
    54.7 -(* FIXME: Use antiquotation for "code_numeral" below or detect "rep_datatype",
    54.8 +(* FIXME: Use antiquotation for "natural" below or detect "rep_datatype",
    54.9     e.g., by adding a field to "Datatype_Aux.info". *)
   54.10  fun is_basic_datatype thy stds s =
   54.11    member (op =) [@{type_name prod}, @{type_name set}, @{type_name bool},
   54.12 -                 @{type_name int}, "Code_Numeral.code_numeral"] s orelse
   54.13 +                 @{type_name int}, @{type_name natural}, @{type_name integer}] s orelse
   54.14    (s = @{type_name nat} andalso is_standard_datatype thy stds nat_T)
   54.15  
   54.16  fun repair_constr_type ctxt body_T' T =
    55.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_compilations.ML	Fri Feb 15 08:31:30 2013 +0100
    55.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_compilations.ML	Fri Feb 15 08:31:31 2013 +0100
    55.3 @@ -31,7 +31,7 @@
    55.4  
    55.5  fun mk_iterate_upto T (f, from, to) =
    55.6    list_comb (Const (@{const_name Predicate.iterate_upto},
    55.7 -      [@{typ code_numeral} --> T, @{typ code_numeral}, @{typ code_numeral}] ---> mk_monadT T),
    55.8 +      [@{typ natural} --> T, @{typ natural}, @{typ natural}] ---> mk_monadT T),
    55.9      [f, from, to])
   55.10  
   55.11  fun mk_not t =
   55.12 @@ -115,10 +115,10 @@
   55.13  struct
   55.14  
   55.15  val resultT = @{typ "(bool * Code_Evaluation.term list) option"}
   55.16 -fun mk_monadT T = (T --> resultT) --> @{typ "code_numeral"} --> resultT
   55.17 +fun mk_monadT T = (T --> resultT) --> @{typ "natural"} --> resultT
   55.18  
   55.19  fun dest_monadT (Type ("fun", [Type ("fun", [T, @{typ "(bool * term list) option"}]),
   55.20 -  @{typ "code_numeral => (bool * term list) option"}])) = T
   55.21 +  @{typ "natural => (bool * term list) option"}])) = T
   55.22    | dest_monadT T = raise TYPE ("dest_monadT", [T], []);
   55.23  
   55.24  fun mk_empty T = Const (@{const_name Quickcheck_Exhaustive.pos_bound_cps_empty}, mk_monadT T);
   55.25 @@ -143,7 +143,7 @@
   55.26  fun mk_not t =
   55.27    let
   55.28      val nT = @{typ "(unit Quickcheck_Exhaustive.unknown =>
   55.29 -      Code_Evaluation.term list Quickcheck_Exhaustive.three_valued) => code_numeral =>
   55.30 +      Code_Evaluation.term list Quickcheck_Exhaustive.three_valued) => natural =>
   55.31        Code_Evaluation.term list Quickcheck_Exhaustive.three_valued"}
   55.32      val T = mk_monadT HOLogic.unitT
   55.33    in Const (@{const_name Quickcheck_Exhaustive.pos_bound_cps_not}, nT --> T) $ t end
   55.34 @@ -169,11 +169,11 @@
   55.35  fun mk_monadT T =
   55.36    (Type (@{type_name "Quickcheck_Exhaustive.unknown"}, [T])
   55.37      --> @{typ "Code_Evaluation.term list Quickcheck_Exhaustive.three_valued"})
   55.38 -    --> @{typ "code_numeral => Code_Evaluation.term list Quickcheck_Exhaustive.three_valued"}
   55.39 +    --> @{typ "natural => Code_Evaluation.term list Quickcheck_Exhaustive.three_valued"}
   55.40  
   55.41  fun dest_monadT (Type ("fun", [Type ("fun", [Type (@{type_name "Quickcheck_Exhaustive.unknown"}, [T]),
   55.42      @{typ "term list Quickcheck_Exhaustive.three_valued"}]),
   55.43 -    @{typ "code_numeral => term list Quickcheck_Exhaustive.three_valued"}])) = T
   55.44 +    @{typ "natural => term list Quickcheck_Exhaustive.three_valued"}])) = T
   55.45    | dest_monadT T = raise TYPE ("dest_monadT", [T], []);
   55.46  
   55.47  fun mk_empty T = Const (@{const_name Quickcheck_Exhaustive.neg_bound_cps_empty}, mk_monadT T);
   55.48 @@ -199,7 +199,7 @@
   55.49    let
   55.50      val T = mk_monadT HOLogic.unitT
   55.51      val pT = @{typ "(unit => (bool * Code_Evaluation.term list) option)"}
   55.52 -      --> @{typ "code_numeral => (bool * Code_Evaluation.term list) option"}
   55.53 +      --> @{typ "natural => (bool * Code_Evaluation.term list) option"}
   55.54    in Const (@{const_name Quickcheck_Exhaustive.neg_bound_cps_not}, pT --> T) $ t end
   55.55  
   55.56  fun mk_Enum _ = error "not implemented"
   55.57 @@ -251,7 +251,7 @@
   55.58  
   55.59  fun mk_iterate_upto T (f, from, to) =
   55.60    list_comb (Const (@{const_name Random_Pred.iterate_upto},
   55.61 -      [@{typ code_numeral} --> T, @{typ code_numeral}, @{typ code_numeral}] ---> mk_randompredT T),
   55.62 +      [@{typ natural} --> T, @{typ natural}, @{typ natural}] ---> mk_randompredT T),
   55.63      [f, from, to])
   55.64  
   55.65  fun mk_not t =
   55.66 @@ -272,10 +272,10 @@
   55.67  structure DSequence_CompFuns =
   55.68  struct
   55.69  
   55.70 -fun mk_dseqT T = Type ("fun", [@{typ code_numeral}, Type ("fun", [@{typ bool},
   55.71 +fun mk_dseqT T = Type ("fun", [@{typ natural}, Type ("fun", [@{typ bool},
   55.72    Type (@{type_name Option.option}, [Type  (@{type_name Lazy_Sequence.lazy_sequence}, [T])])])])
   55.73  
   55.74 -fun dest_dseqT (Type ("fun", [@{typ code_numeral}, Type ("fun", [@{typ bool},
   55.75 +fun dest_dseqT (Type ("fun", [@{typ natural}, Type ("fun", [@{typ bool},
   55.76    Type (@{type_name Option.option}, [Type (@{type_name Lazy_Sequence.lazy_sequence}, [T])])])])) = T
   55.77    | dest_dseqT T = raise TYPE ("dest_dseqT", [T], []);
   55.78  
   55.79 @@ -315,9 +315,9 @@
   55.80  struct
   55.81  
   55.82  fun mk_pos_dseqT T =
   55.83 -    @{typ code_numeral} --> Type (@{type_name Lazy_Sequence.lazy_sequence}, [T])
   55.84 +    @{typ natural} --> Type (@{type_name Lazy_Sequence.lazy_sequence}, [T])
   55.85  
   55.86 -fun dest_pos_dseqT (Type ("fun", [@{typ code_numeral},
   55.87 +fun dest_pos_dseqT (Type ("fun", [@{typ natural},
   55.88      Type (@{type_name Lazy_Sequence.lazy_sequence}, [T])])) = T
   55.89    | dest_pos_dseqT T = raise TYPE ("dest_pos_dseqT", [T], []);
   55.90  
   55.91 @@ -353,7 +353,7 @@
   55.92    let
   55.93      val pT = mk_pos_dseqT HOLogic.unitT
   55.94      val nT =
   55.95 -      @{typ code_numeral} --> Type (@{type_name Lazy_Sequence.lazy_sequence},
   55.96 +      @{typ natural} --> Type (@{type_name Lazy_Sequence.lazy_sequence},
   55.97          [Type (@{type_name Option.option}, [@{typ unit}])])
   55.98    in Const (@{const_name Limited_Sequence.pos_not_seq}, nT --> pT) $ t end
   55.99  
  55.100 @@ -375,10 +375,10 @@
  55.101  structure New_Neg_DSequence_CompFuns =
  55.102  struct
  55.103  
  55.104 -fun mk_neg_dseqT T = @{typ code_numeral} -->
  55.105 +fun mk_neg_dseqT T = @{typ natural} -->
  55.106    Type (@{type_name Lazy_Sequence.lazy_sequence}, [Type (@{type_name Option.option}, [T])])
  55.107  
  55.108 -fun dest_neg_dseqT (Type ("fun", [@{typ code_numeral},
  55.109 +fun dest_neg_dseqT (Type ("fun", [@{typ natural},
  55.110      Type (@{type_name Lazy_Sequence.lazy_sequence}, [Type (@{type_name Option.option}, [T])])])) = T
  55.111    | dest_neg_dseqT T = raise TYPE ("dest_neg_dseqT", [T], []);
  55.112  
  55.113 @@ -414,7 +414,7 @@
  55.114    let
  55.115      val nT = mk_neg_dseqT HOLogic.unitT
  55.116      val pT =
  55.117 -      @{typ code_numeral} --> Type (@{type_name Lazy_Sequence.lazy_sequence},
  55.118 +      @{typ natural} --> Type (@{type_name Lazy_Sequence.lazy_sequence},
  55.119          [@{typ unit}])
  55.120    in Const (@{const_name Limited_Sequence.neg_not_seq}, pT --> nT) $ t end
  55.121  
  55.122 @@ -437,11 +437,11 @@
  55.123  struct
  55.124  
  55.125  fun mk_pos_random_dseqT T =
  55.126 -  @{typ code_numeral} --> @{typ code_numeral} --> @{typ Random.seed} -->
  55.127 -    @{typ code_numeral} --> Type (@{type_name Lazy_Sequence.lazy_sequence}, [T])
  55.128 +  @{typ natural} --> @{typ natural} --> @{typ Random.seed} -->
  55.129 +    @{typ natural} --> Type (@{type_name Lazy_Sequence.lazy_sequence}, [T])
  55.130  
  55.131 -fun dest_pos_random_dseqT (Type ("fun", [@{typ code_numeral}, Type ("fun", [@{typ code_numeral},
  55.132 -    Type ("fun", [@{typ Random.seed}, Type ("fun", [@{typ code_numeral},
  55.133 +fun dest_pos_random_dseqT (Type ("fun", [@{typ natural}, Type ("fun", [@{typ natural},
  55.134 +    Type ("fun", [@{typ Random.seed}, Type ("fun", [@{typ natural},
  55.135      Type (@{type_name Lazy_Sequence.lazy_sequence}, [T])])])])])) = T
  55.136    | dest_pos_random_dseqT T = raise TYPE ("dest_random_dseqT", [T], []);
  55.137  
  55.138 @@ -473,15 +473,15 @@
  55.139  
  55.140  fun mk_iterate_upto T (f, from, to) =
  55.141    list_comb (Const (@{const_name Random_Sequence.pos_iterate_upto},
  55.142 -      [@{typ code_numeral} --> T, @{typ code_numeral}, @{typ code_numeral}]
  55.143 +      [@{typ natural} --> T, @{typ natural}, @{typ natural}]
  55.144          ---> mk_pos_random_dseqT T),
  55.145      [f, from, to])
  55.146  
  55.147  fun mk_not t =
  55.148    let
  55.149      val pT = mk_pos_random_dseqT HOLogic.unitT
  55.150 -    val nT = @{typ code_numeral} --> @{typ code_numeral} --> @{typ Random.seed} -->
  55.151 -      @{typ code_numeral} --> Type (@{type_name Lazy_Sequence.lazy_sequence},
  55.152 +    val nT = @{typ natural} --> @{typ natural} --> @{typ Random.seed} -->
  55.153 +      @{typ natural} --> Type (@{type_name Lazy_Sequence.lazy_sequence},
  55.154          [Type (@{type_name Option.option}, [@{typ unit}])])
  55.155  
  55.156    in Const (@{const_name Random_Sequence.pos_not_random_dseq}, nT --> pT) $ t end
  55.157 @@ -504,12 +504,12 @@
  55.158  struct
  55.159  
  55.160  fun mk_neg_random_dseqT T =
  55.161 -   @{typ code_numeral} --> @{typ code_numeral} --> @{typ Random.seed} -->
  55.162 -    @{typ code_numeral} --> 
  55.163 +   @{typ natural} --> @{typ natural} --> @{typ Random.seed} -->
  55.164 +    @{typ natural} --> 
  55.165      Type (@{type_name Lazy_Sequence.lazy_sequence}, [Type (@{type_name Option.option}, [T])])
  55.166  
  55.167 -fun dest_neg_random_dseqT (Type ("fun", [@{typ code_numeral}, Type ("fun", [@{typ code_numeral},
  55.168 -    Type ("fun", [@{typ Random.seed}, Type ("fun", [@{typ code_numeral},
  55.169 +fun dest_neg_random_dseqT (Type ("fun", [@{typ natural}, Type ("fun", [@{typ natural},
  55.170 +    Type ("fun", [@{typ Random.seed}, Type ("fun", [@{typ natural},
  55.171        Type (@{type_name Lazy_Sequence.lazy_sequence},
  55.172          [Type (@{type_name Option.option}, [T])])])])])])) = T
  55.173    | dest_neg_random_dseqT T = raise TYPE ("dest_random_dseqT", [T], []);
  55.174 @@ -542,15 +542,15 @@
  55.175  
  55.176  fun mk_iterate_upto T (f, from, to) =
  55.177    list_comb (Const (@{const_name Random_Sequence.neg_iterate_upto},
  55.178 -      [@{typ code_numeral} --> T, @{typ code_numeral}, @{typ code_numeral}]
  55.179 +      [@{typ natural} --> T, @{typ natural}, @{typ natural}]
  55.180          ---> mk_neg_random_dseqT T),
  55.181      [f, from, to])
  55.182  
  55.183  fun mk_not t =
  55.184    let
  55.185      val nT = mk_neg_random_dseqT HOLogic.unitT
  55.186 -    val pT = @{typ code_numeral} --> @{typ code_numeral} --> @{typ Random.seed} -->
  55.187 -    @{typ code_numeral} --> Type (@{type_name Lazy_Sequence.lazy_sequence}, [@{typ unit}])
  55.188 +    val pT = @{typ natural} --> @{typ natural} --> @{typ Random.seed} -->
  55.189 +    @{typ natural} --> Type (@{type_name Lazy_Sequence.lazy_sequence}, [@{typ unit}])
  55.190    in Const (@{const_name Random_Sequence.neg_not_random_dseq}, pT --> nT) $ t end
  55.191  
  55.192  fun mk_map T1 T2 tf tp = Const (@{const_name Random_Sequence.neg_map},
  55.193 @@ -572,10 +572,10 @@
  55.194  struct
  55.195  
  55.196  fun mk_random_dseqT T =
  55.197 -  @{typ code_numeral} --> @{typ code_numeral} --> @{typ Random.seed} -->
  55.198 +  @{typ natural} --> @{typ natural} --> @{typ Random.seed} -->
  55.199      HOLogic.mk_prodT (DSequence_CompFuns.mk_dseqT T, @{typ Random.seed})
  55.200  
  55.201 -fun dest_random_dseqT (Type ("fun", [@{typ code_numeral}, Type ("fun", [@{typ code_numeral},
  55.202 +fun dest_random_dseqT (Type ("fun", [@{typ natural}, Type ("fun", [@{typ natural},
  55.203    Type ("fun", [@{typ Random.seed},
  55.204    Type (@{type_name Product_Type.prod}, [T, @{typ Random.seed}])])])])) = DSequence_CompFuns.dest_dseqT T
  55.205    | dest_random_dseqT T = raise TYPE ("dest_random_dseqT", [T], []);
    56.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML	Fri Feb 15 08:31:30 2013 +0100
    56.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML	Fri Feb 15 08:31:31 2013 +0100
    56.3 @@ -27,15 +27,15 @@
    56.4    val put_pred_random_result : (unit -> seed -> term Predicate.pred * seed) ->
    56.5      Proof.context -> Proof.context
    56.6    val put_dseq_result : (unit -> term Limited_Sequence.dseq) -> Proof.context -> Proof.context
    56.7 -  val put_dseq_random_result : (unit -> int -> int -> seed -> term Limited_Sequence.dseq * seed) ->
    56.8 +  val put_dseq_random_result : (unit -> Code_Numeral.natural -> Code_Numeral.natural -> seed -> term Limited_Sequence.dseq * seed) ->
    56.9      Proof.context -> Proof.context
   56.10 -  val put_new_dseq_result : (unit -> int -> term Lazy_Sequence.lazy_sequence) ->
   56.11 +  val put_new_dseq_result : (unit -> Code_Numeral.natural -> term Lazy_Sequence.lazy_sequence) ->
   56.12      Proof.context -> Proof.context
   56.13    val put_lseq_random_result :
   56.14 -    (unit -> int -> int -> seed -> int -> term Lazy_Sequence.lazy_sequence) ->
   56.15 +    (unit -> Code_Numeral.natural -> Code_Numeral.natural -> seed -> Code_Numeral.natural -> term Lazy_Sequence.lazy_sequence) ->
   56.16      Proof.context -> Proof.context
   56.17    val put_lseq_random_stats_result :
   56.18 -    (unit -> int -> int -> seed -> int -> (term * int) Lazy_Sequence.lazy_sequence) ->
   56.19 +    (unit -> Code_Numeral.natural -> Code_Numeral.natural -> seed -> Code_Numeral.natural -> (term * Code_Numeral.natural) Lazy_Sequence.lazy_sequence) ->
   56.20      Proof.context -> Proof.context
   56.21  
   56.22    val code_pred_intro_attrib : attribute
   56.23 @@ -66,6 +66,8 @@
   56.24  structure Predicate_Compile_Core : PREDICATE_COMPILE_CORE =
   56.25  struct
   56.26  
   56.27 +type random_seed = Random_Engine.seed
   56.28 +
   56.29  open Predicate_Compile_Aux;
   56.30  open Core_Data;
   56.31  open Mode_Inference;
   56.32 @@ -294,9 +296,9 @@
   56.33    additional_arguments = fn names =>
   56.34      let
   56.35        val depth_name = singleton (Name.variant_list names) "depth"
   56.36 -    in [Free (depth_name, @{typ code_numeral})] end,
   56.37 +    in [Free (depth_name, @{typ natural})] end,
   56.38    modify_funT = (fn T => let val (Ts, U) = strip_type T
   56.39 -  val Ts' = [@{typ code_numeral}] in (Ts @ Ts') ---> U end),
   56.40 +  val Ts' = [@{typ natural}] in (Ts @ Ts') ---> U end),
   56.41    wrap_compilation =
   56.42      fn compfuns => fn s => fn T => fn mode => fn additional_arguments => fn compilation =>
   56.43      let
   56.44 @@ -305,7 +307,7 @@
   56.45        val T' = mk_monadT compfuns (HOLogic.mk_tupleT Ts)
   56.46        val if_const = Const (@{const_name "If"}, @{typ bool} --> T' --> T' --> T')
   56.47      in
   56.48 -      if_const $ HOLogic.mk_eq (depth, @{term "0 :: code_numeral"})
   56.49 +      if_const $ HOLogic.mk_eq (depth, @{term "0 :: natural"})
   56.50          $ mk_empty compfuns (dest_monadT compfuns T')
   56.51          $ compilation
   56.52      end,
   56.53 @@ -314,8 +316,8 @@
   56.54      let
   56.55        val [depth] = additional_arguments
   56.56        val depth' =
   56.57 -        Const (@{const_name Groups.minus}, @{typ "code_numeral => code_numeral => code_numeral"})
   56.58 -          $ depth $ Const (@{const_name Groups.one}, @{typ "Code_Numeral.code_numeral"})
   56.59 +        Const (@{const_name Groups.minus}, @{typ "natural => natural => natural"})
   56.60 +          $ depth $ Const (@{const_name Groups.one}, @{typ "natural"})
   56.61      in [depth'] end
   56.62    }
   56.63  
   56.64 @@ -326,18 +328,18 @@
   56.65    compfuns = Predicate_Comp_Funs.compfuns,
   56.66    mk_random = (fn T => fn additional_arguments =>
   56.67    list_comb (Const(@{const_name Random_Pred.iter},
   56.68 -  [@{typ code_numeral}, @{typ code_numeral}, @{typ Random.seed}] ---> 
   56.69 +  [@{typ natural}, @{typ natural}, @{typ Random.seed}] ---> 
   56.70      Predicate_Comp_Funs.mk_monadT T), additional_arguments)),
   56.71    modify_funT = (fn T =>
   56.72      let
   56.73        val (Ts, U) = strip_type T
   56.74 -      val Ts' = [@{typ code_numeral}, @{typ code_numeral}, @{typ Random.seed}]
   56.75 +      val Ts' = [@{typ natural}, @{typ natural}, @{typ Random.seed}]
   56.76      in (Ts @ Ts') ---> U end),
   56.77    additional_arguments = (fn names =>
   56.78      let
   56.79        val [nrandom, size, seed] = Name.variant_list names ["nrandom", "size", "seed"]
   56.80      in
   56.81 -      [Free (nrandom, @{typ code_numeral}), Free (size, @{typ code_numeral}),
   56.82 +      [Free (nrandom, @{typ natural}), Free (size, @{typ natural}),
   56.83          Free (seed, @{typ Random.seed})]
   56.84      end),
   56.85    wrap_compilation = K (K (K (K (K I))))
   56.86 @@ -352,20 +354,20 @@
   56.87    compfuns = Predicate_Comp_Funs.compfuns,
   56.88    mk_random = (fn T => fn additional_arguments =>
   56.89    list_comb (Const(@{const_name Random_Pred.iter},
   56.90 -  [@{typ code_numeral}, @{typ code_numeral}, @{typ Random.seed}] ---> 
   56.91 +  [@{typ natural}, @{typ natural}, @{typ Random.seed}] ---> 
   56.92      Predicate_Comp_Funs.mk_monadT T), tl additional_arguments)),
   56.93    modify_funT = (fn T =>
   56.94      let
   56.95        val (Ts, U) = strip_type T
   56.96 -      val Ts' = [@{typ code_numeral}, @{typ code_numeral}, @{typ code_numeral},
   56.97 +      val Ts' = [@{typ natural}, @{typ natural}, @{typ natural},
   56.98          @{typ Random.seed}]
   56.99      in (Ts @ Ts') ---> U end),
  56.100    additional_arguments = (fn names =>
  56.101      let
  56.102        val [depth, nrandom, size, seed] = Name.variant_list names ["depth", "nrandom", "size", "seed"]
  56.103      in
  56.104 -      [Free (depth, @{typ code_numeral}), Free (nrandom, @{typ code_numeral}),
  56.105 -        Free (size, @{typ code_numeral}), Free (seed, @{typ Random.seed})]
  56.106 +      [Free (depth, @{typ natural}), Free (nrandom, @{typ natural}),
  56.107 +        Free (size, @{typ natural}), Free (seed, @{typ Random.seed})]
  56.108      end),
  56.109    wrap_compilation =
  56.110    fn compfuns => fn _ => fn T => fn mode => fn additional_arguments => fn compilation =>
  56.111 @@ -376,7 +378,7 @@
  56.112        val T' = mk_monadT compfuns (HOLogic.mk_tupleT Ts)
  56.113        val if_const = Const (@{const_name "If"}, @{typ bool} --> T' --> T' --> T')
  56.114      in
  56.115 -      if_const $ HOLogic.mk_eq (depth, @{term "0 :: code_numeral"})
  56.116 +      if_const $ HOLogic.mk_eq (depth, @{term "0 :: natural"})
  56.117          $ mk_empty compfuns (dest_monadT compfuns T')
  56.118          $ compilation
  56.119      end,
  56.120 @@ -385,8 +387,8 @@
  56.121      let
  56.122        val [depth, nrandom, size, seed] = additional_arguments
  56.123        val depth' =
  56.124 -        Const (@{const_name Groups.minus}, @{typ "code_numeral => code_numeral => code_numeral"})
  56.125 -          $ depth $ Const (@{const_name Groups.one}, @{typ "Code_Numeral.code_numeral"})
  56.126 +        Const (@{const_name Groups.minus}, @{typ "natural => natural => natural"})
  56.127 +          $ depth $ Const (@{const_name Groups.one}, @{typ "natural"})
  56.128      in [depth', nrandom, size, seed] end
  56.129  }
  56.130  
  56.131 @@ -424,10 +426,10 @@
  56.132    mk_random = (fn T => fn _ =>
  56.133    let
  56.134      val random = Const (@{const_name Quickcheck_Random.random},
  56.135 -      @{typ code_numeral} --> @{typ Random.seed} -->
  56.136 +      @{typ natural} --> @{typ Random.seed} -->
  56.137          HOLogic.mk_prodT (HOLogic.mk_prodT (T, @{typ "unit => term"}), @{typ Random.seed}))
  56.138    in
  56.139 -    Const (@{const_name Random_Sequence.Random}, (@{typ code_numeral} --> @{typ Random.seed} -->
  56.140 +    Const (@{const_name Random_Sequence.Random}, (@{typ natural} --> @{typ Random.seed} -->
  56.141        HOLogic.mk_prodT (HOLogic.mk_prodT (T, @{typ "unit => term"}), @{typ Random.seed})) -->
  56.142        Random_Sequence_CompFuns.mk_random_dseqT T) $ random
  56.143    end),
  56.144 @@ -461,10 +463,10 @@
  56.145    mk_random = (fn T => fn _ =>
  56.146    let
  56.147      val random = Const (@{const_name Quickcheck_Random.random},
  56.148 -      @{typ code_numeral} --> @{typ Random.seed} -->
  56.149 +      @{typ natural} --> @{typ Random.seed} -->
  56.150          HOLogic.mk_prodT (HOLogic.mk_prodT (T, @{typ "unit => term"}), @{typ Random.seed}))
  56.151    in
  56.152 -    Const (@{const_name Random_Sequence.pos_Random}, (@{typ code_numeral} --> @{typ Random.seed} -->
  56.153 +    Const (@{const_name Random_Sequence.pos_Random}, (@{typ natural} --> @{typ Random.seed} -->
  56.154        HOLogic.mk_prodT (HOLogic.mk_prodT (T, @{typ "unit => term"}), @{typ Random.seed})) -->
  56.155        New_Pos_Random_Sequence_CompFuns.mk_pos_random_dseqT T) $ random
  56.156    end),
  56.157 @@ -496,7 +498,7 @@
  56.158    mk_random =
  56.159      (fn T => fn _ =>
  56.160        Const (@{const_name "Lazy_Sequence.small_lazy_class.small_lazy"},
  56.161 -        @{typ "Code_Numeral.code_numeral"} --> Type (@{type_name "Lazy_Sequence.lazy_sequence"}, [T]))),
  56.162 +        @{typ "natural"} --> Type (@{type_name "Lazy_Sequence.lazy_sequence"}, [T]))),
  56.163    modify_funT = I,
  56.164    additional_arguments = K [],
  56.165    wrap_compilation = K (K (K (K (K I))))
  56.166 @@ -526,7 +528,7 @@
  56.167      (fn T => fn _ =>
  56.168         Const (@{const_name "Quickcheck_Exhaustive.exhaustive"},
  56.169         (T --> @{typ "(bool * term list) option"}) -->
  56.170 -         @{typ "code_numeral => (bool * term list) option"})),
  56.171 +         @{typ "natural => (bool * term list) option"})),
  56.172    modify_funT = I,
  56.173    additional_arguments = K [],
  56.174    wrap_compilation = K (K (K (K (K I))))
  56.175 @@ -1655,7 +1657,7 @@
  56.176  
  56.177  structure Dseq_Random_Result = Proof_Data
  56.178  (
  56.179 -  type T = unit -> int -> int -> seed -> term Limited_Sequence.dseq * seed
  56.180 +  type T = unit -> Code_Numeral.natural -> Code_Numeral.natural -> seed -> term Limited_Sequence.dseq * seed
  56.181    (* FIXME avoid user error with non-user text *)
  56.182    fun init _ () = error "Dseq_Random_Result"
  56.183  );
  56.184 @@ -1663,7 +1665,7 @@
  56.185  
  56.186  structure New_Dseq_Result = Proof_Data
  56.187  (
  56.188 -  type T = unit -> int -> term Lazy_Sequence.lazy_sequence
  56.189 +  type T = unit -> Code_Numeral.natural -> term Lazy_Sequence.lazy_sequence
  56.190    (* FIXME avoid user error with non-user text *)
  56.191    fun init _ () = error "New_Dseq_Random_Result"
  56.192  );
  56.193 @@ -1671,7 +1673,7 @@
  56.194  
  56.195  structure Lseq_Random_Result = Proof_Data
  56.196  (
  56.197 -  type T = unit -> int -> int -> seed -> int -> term Lazy_Sequence.lazy_sequence
  56.198 +  type T = unit -> Code_Numeral.natural -> Code_Numeral.natural -> seed -> Code_Numeral.natural -> term Lazy_Sequence.lazy_sequence
  56.199    (* FIXME avoid user error with non-user text *)
  56.200    fun init _ () = error "Lseq_Random_Result"
  56.201  );
  56.202 @@ -1679,7 +1681,7 @@
  56.203  
  56.204  structure Lseq_Random_Stats_Result = Proof_Data
  56.205  (
  56.206 -  type T = unit -> int -> int -> seed -> int -> (term * int) Lazy_Sequence.lazy_sequence
  56.207 +  type T = unit -> Code_Numeral.natural -> Code_Numeral.natural -> seed -> Code_Numeral.natural -> (term * Code_Numeral.natural) Lazy_Sequence.lazy_sequence
  56.208    (* FIXME avoid user error with non-user text *)
  56.209    fun init _ () = error "Lseq_Random_Stats_Result"
  56.210  );
  56.211 @@ -1795,7 +1797,7 @@
  56.212          fun count' i [] = i
  56.213            | count' i (x' :: xs) = if x = x' then count' (i + 1) xs else count' i xs
  56.214        in count' 0 xs end
  56.215 -    fun accumulate xs = map (fn x => (x, count xs x)) (sort int_ord (distinct (op =) xs))
  56.216 +    fun accumulate xs = (map (fn x => (x, count xs x)) o sort int_ord o distinct (op =)) xs;
  56.217      val comp_modifiers =
  56.218        case compilation of
  56.219            Pred => predicate_comp_modifiers
  56.220 @@ -1811,12 +1813,12 @@
  56.221      val additional_arguments =
  56.222        case compilation of
  56.223          Pred => []
  56.224 -      | Random => map (HOLogic.mk_number @{typ "code_numeral"}) arguments @
  56.225 -        [@{term "(1, 1) :: code_numeral * code_numeral"}]
  56.226 +      | Random => map (HOLogic.mk_number @{typ "natural"}) arguments @
  56.227 +        [@{term "(1, 1) :: natural * natural"}]
  56.228        | Annotated => []
  56.229 -      | Depth_Limited => [HOLogic.mk_number @{typ "code_numeral"} (hd arguments)]
  56.230 -      | Depth_Limited_Random => map (HOLogic.mk_number @{typ "code_numeral"}) arguments @
  56.231 -        [@{term "(1, 1) :: code_numeral * code_numeral"}]
  56.232 +      | Depth_Limited => [HOLogic.mk_number @{typ "natural"} (hd arguments)]
  56.233 +      | Depth_Limited_Random => map (HOLogic.mk_number @{typ "natural"}) arguments @
  56.234 +        [@{term "(1, 1) :: natural * natural"}]
  56.235        | DSeq => []
  56.236        | Pos_Random_DSeq => []
  56.237        | New_Pos_Random_DSeq => []
  56.238 @@ -1825,9 +1827,9 @@
  56.239      val T = dest_monadT compfuns (fastype_of t);
  56.240      val t' =
  56.241        if stats andalso compilation = New_Pos_Random_DSeq then
  56.242 -        mk_map compfuns T (HOLogic.mk_prodT (HOLogic.termT, @{typ code_numeral}))
  56.243 +        mk_map compfuns T (HOLogic.mk_prodT (HOLogic.termT, @{typ natural}))
  56.244            (absdummy T (HOLogic.mk_prod (HOLogic.term_of_const T $ Bound 0,
  56.245 -            @{term Code_Numeral.of_nat} $ (HOLogic.size_const T $ Bound 0)))) t
  56.246 +            @{term natural_of_nat} $ (HOLogic.size_const T $ Bound 0)))) t
  56.247        else
  56.248          mk_map compfuns T HOLogic.termT (HOLogic.term_of_const T) t
  56.249      val thy = Proof_Context.theory_of ctxt
  56.250 @@ -1841,7 +1843,7 @@
  56.251              |> Random_Engine.run))*)
  56.252          Pos_Random_DSeq =>
  56.253            let
  56.254 -            val [nrandom, size, depth] = arguments
  56.255 +            val [nrandom, size, depth] = map Code_Numeral.natural_of_integer arguments
  56.256            in
  56.257              rpair NONE (TimeLimit.timeLimit time_limit (fn () => fst (Limited_Sequence.yieldn k
  56.258                (Code_Runtime.dynamic_value_strict (Dseq_Random_Result.get, put_dseq_random_result, "Predicate_Compile_Core.put_dseq_random_result")
  56.259 @@ -1853,10 +1855,10 @@
  56.260        | DSeq =>
  56.261            rpair NONE (TimeLimit.timeLimit time_limit (fn () => fst (Limited_Sequence.yieldn k
  56.262              (Code_Runtime.dynamic_value_strict (Dseq_Result.get, put_dseq_result, "Predicate_Compile_Core.put_dseq_result")
  56.263 -              thy NONE Limited_Sequence.map t' []) (the_single arguments) true)) ())
  56.264 +              thy NONE Limited_Sequence.map t' []) (Code_Numeral.natural_of_integer (the_single arguments)) true)) ())
  56.265        | Pos_Generator_DSeq =>
  56.266            let
  56.267 -            val depth = (the_single arguments)
  56.268 +            val depth = Code_Numeral.natural_of_integer (the_single arguments)
  56.269            in
  56.270              rpair NONE (TimeLimit.timeLimit time_limit (fn () => fst (Lazy_Sequence.yieldn k
  56.271                (Code_Runtime.dynamic_value_strict (New_Dseq_Result.get, put_new_dseq_result, "Predicate_Compile_Core.put_new_dseq_result")
  56.272 @@ -1865,11 +1867,12 @@
  56.273            end
  56.274        | New_Pos_Random_DSeq =>
  56.275            let
  56.276 -            val [nrandom, size, depth] = arguments
  56.277 +            val [nrandom, size, depth] = map Code_Numeral.natural_of_integer arguments
  56.278              val seed = Random_Engine.next_seed ()
  56.279            in
  56.280              if stats then
  56.281 -              apsnd (SOME o accumulate) (split_list (TimeLimit.timeLimit time_limit
  56.282 +              apsnd (SOME o accumulate o map Code_Numeral.integer_of_natural)
  56.283 +              (split_list (TimeLimit.timeLimit time_limit
  56.284                (fn () => fst (Lazy_Sequence.yieldn k
  56.285                  (Code_Runtime.dynamic_value_strict
  56.286                    (Lseq_Random_Stats_Result.get, put_lseq_random_stats_result, "Predicate_Compile_Core.put_lseq_random_stats_result")
    57.1 --- a/src/HOL/Tools/Predicate_Compile/predicate_compile_quickcheck.ML	Fri Feb 15 08:31:30 2013 +0100
    57.2 +++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_quickcheck.ML	Fri Feb 15 08:31:31 2013 +0100
    57.3 @@ -9,17 +9,17 @@
    57.4    type seed = Random_Engine.seed
    57.5    (*val quickcheck : Proof.context -> term -> int -> term list option*)
    57.6    val put_pred_result :
    57.7 -    (unit -> int -> int -> int -> seed -> term list Predicate.pred) ->
    57.8 +    (unit -> Code_Numeral.natural -> Code_Numeral.natural -> Code_Numeral.natural -> seed -> term list Predicate.pred) ->
    57.9        Proof.context -> Proof.context;
   57.10    val put_dseq_result :
   57.11 -    (unit -> int -> int -> seed -> term list Limited_Sequence.dseq * seed) ->
   57.12 +    (unit -> Code_Numeral.natural -> Code_Numeral.natural -> seed -> term list Limited_Sequence.dseq * seed) ->
   57.13        Proof.context -> Proof.context;
   57.14    val put_lseq_result :
   57.15 -    (unit -> int -> int -> seed -> int -> term list Lazy_Sequence.lazy_sequence) ->
   57.16 +    (unit -> Code_Numeral.natural -> Code_Numeral.natural -> seed -> Code_Numeral.natural -> term list Lazy_Sequence.lazy_sequence) ->
   57.17        Proof.context -> Proof.context;
   57.18 -  val put_new_dseq_result : (unit -> int -> term list Lazy_Sequence.lazy_sequence) ->
   57.19 +  val put_new_dseq_result : (unit -> Code_Numeral.natural -> term list Lazy_Sequence.lazy_sequence) ->
   57.20      Proof.context -> Proof.context
   57.21 -  val put_cps_result : (unit -> int -> (bool * term list) option) ->
   57.22 +  val put_cps_result : (unit -> Code_Numeral.natural -> (bool * term list) option) ->
   57.23      Proof.context -> Proof.context
   57.24    val test_goals : (Predicate_Compile_Aux.compilation * bool) ->
   57.25      Proof.context -> bool * bool -> (string * typ) list -> (term * term list) list
   57.26 @@ -41,7 +41,7 @@
   57.27  
   57.28  structure Pred_Result = Proof_Data
   57.29  (
   57.30 -  type T = unit -> int -> int -> int -> seed -> term list Predicate.pred
   57.31 +  type T = unit -> Code_Numeral.natural -> Code_Numeral.natural -> Code_Numeral.natural -> seed -> term list Predicate.pred
   57.32    (* FIXME avoid user error with non-user text *)
   57.33    fun init _ () = error "Pred_Result"
   57.34  );
   57.35 @@ -49,7 +49,7 @@
   57.36  
   57.37  structure Dseq_Result = Proof_Data
   57.38  (
   57.39 -  type T = unit -> int -> int -> seed -> term list Limited_Sequence.dseq * seed
   57.40 +  type T = unit -> Code_Numeral.natural -> Code_Numeral.natural -> seed -> term list Limited_Sequence.dseq * seed
   57.41    (* FIXME avoid user error with non-user text *)
   57.42    fun init _ () = error "Dseq_Result"
   57.43  );
   57.44 @@ -57,7 +57,7 @@
   57.45  
   57.46  structure Lseq_Result = Proof_Data
   57.47  (
   57.48 -  type T = unit -> int -> int -> seed -> int -> term list Lazy_Sequence.lazy_sequence
   57.49 +  type T = unit -> Code_Numeral.natural -> Code_Numeral.natural -> seed -> Code_Numeral.natural -> term list Lazy_Sequence.lazy_sequence
   57.50    (* FIXME avoid user error with non-user text *)
   57.51    fun init _ () = error "Lseq_Result"
   57.52  );
   57.53 @@ -65,7 +65,7 @@
   57.54  
   57.55  structure New_Dseq_Result = Proof_Data
   57.56  (
   57.57 -  type T = unit -> int -> term list Lazy_Sequence.lazy_sequence
   57.58 +  type T = unit -> Code_Numeral.natural -> term list Lazy_Sequence.lazy_sequence
   57.59    (* FIXME avoid user error with non-user text *)
   57.60    fun init _ () = error "New_Dseq_Random_Result"
   57.61  );
   57.62 @@ -73,7 +73,7 @@
   57.63  
   57.64  structure CPS_Result = Proof_Data
   57.65  (
   57.66 -  type T = unit -> int -> (bool * term list) option
   57.67 +  type T = unit -> Code_Numeral.natural -> (bool * term list) option
   57.68    (* FIXME avoid user error with non-user text *)
   57.69    fun init _ () = error "CPS_Result"
   57.70  );
   57.71 @@ -141,7 +141,7 @@
   57.72      show_intermediate_results = s_ir, show_proof_trace = s_pt, show_modes = s_m,
   57.73      show_mode_inference = s_mi, show_compilation = s_c, show_caught_failures = s_cf,
   57.74      show_invalid_clauses = s_ic, skip_proof = s_p,
   57.75 -    compilation = c, inductify = i, specialise = sp, detect_switches = ds, function_flattening = f_f, 
   57.76 +    compilation = c, inductify = i, specialise = sp, detect_switches = ds, function_flattening = _, 
   57.77      fail_safe_function_flattening = fs_ff, no_higher_order_predicate = no_ho,
   57.78      smart_depth_limiting = sm_dl, no_topmost_reordering = re}) =
   57.79    (Options { expected_modes = e_m, proposed_modes = p_m, proposed_names = p_n, show_steps = s_s,
   57.80 @@ -158,7 +158,7 @@
   57.81      show_mode_inference = s_mi, show_compilation = s_c, show_caught_failures = s_cf,
   57.82      show_invalid_clauses = s_ic, skip_proof = s_p,
   57.83      compilation = c, inductify = i, specialise = sp, detect_switches = ds, function_flattening = f_f, 
   57.84 -    fail_safe_function_flattening = fs_ff, no_higher_order_predicate = no_ho,
   57.85 +    fail_safe_function_flattening = _, no_higher_order_predicate = no_ho,
   57.86      smart_depth_limiting = sm_dl, no_topmost_reordering = re}) =
   57.87    (Options { expected_modes = e_m, proposed_modes = p_m, proposed_names = p_n, show_steps = s_s,
   57.88      show_intermediate_results = s_ir, show_proof_trace = s_pt, show_modes = s_m,
   57.89 @@ -174,7 +174,7 @@
   57.90      show_mode_inference = s_mi, show_compilation = s_c, show_caught_failures = s_cf,
   57.91      show_invalid_clauses = s_ic, skip_proof = s_p,
   57.92      compilation = c, inductify = i, specialise = sp, detect_switches = ds, function_flattening = f_f, 
   57.93 -    fail_safe_function_flattening = fs_ff, no_higher_order_predicate = no_ho,
   57.94 +    fail_safe_function_flattening = fs_ff, no_higher_order_predicate = _,
   57.95      smart_depth_limiting = sm_dl, no_topmost_reordering = re}) =
   57.96    (Options { expected_modes = e_m, proposed_modes = p_m, proposed_names = p_n, show_steps = s_s,
   57.97      show_intermediate_results = s_ir, show_proof_trace = s_pt, show_modes = s_m,
   57.98 @@ -214,10 +214,6 @@
   57.99  
  57.100  val mk_cpsT =
  57.101    Predicate_Compile_Aux.mk_monadT Pos_Bounded_CPS_Comp_Funs.compfuns
  57.102 -val mk_cps_return =
  57.103 -  Predicate_Compile_Aux.mk_single Pos_Bounded_CPS_Comp_Funs.compfuns
  57.104 -val mk_cps_bind =
  57.105 -  Predicate_Compile_Aux.mk_bind Pos_Bounded_CPS_Comp_Funs.compfuns
  57.106  
  57.107  val mk_split_lambda = HOLogic.tupled_lambda o HOLogic.mk_tuple
  57.108  
  57.109 @@ -232,9 +228,9 @@
  57.110      val ((((full_constname, constT), vs'), intro), thy1) =
  57.111        Predicate_Compile_Aux.define_quickcheck_predicate t' thy
  57.112      val thy2 = Context.theory_map (Predicate_Compile_Alternative_Defs.add_thm intro) thy1
  57.113 -    val (thy3, preproc_time) = cpu_time "predicate preprocessing"
  57.114 +    val (thy3, _) = cpu_time "predicate preprocessing"
  57.115          (fn () => Predicate_Compile.preprocess options (Const (full_constname, constT)) thy2)
  57.116 -    val (thy4, core_comp_time) = cpu_time "random_dseq core compilation"
  57.117 +    val (thy4, _) = cpu_time "random_dseq core compilation"
  57.118          (fn () =>
  57.119            case compilation of
  57.120              Pos_Random_DSeq =>
  57.121 @@ -261,7 +257,7 @@
  57.122              | New_Pos_Random_DSeq => mk_new_randompredT (HOLogic.mk_tupleT (map snd vs'))
  57.123              | Pos_Generator_DSeq => mk_new_dseqT (HOLogic.mk_tupleT (map snd vs'))
  57.124              | Depth_Limited_Random =>
  57.125 -              [@{typ code_numeral}, @{typ code_numeral}, @{typ code_numeral},
  57.126 +              [@{typ natural}, @{typ natural}, @{typ natural},
  57.127                @{typ Random.seed}] ---> mk_predT (HOLogic.mk_tupleT (map snd vs'))
  57.128              | Pos_Generator_CPS => mk_cpsT (HOLogic.mk_tupleT (map snd vs'))
  57.129          in
  57.130 @@ -285,7 +281,7 @@
  57.131              HOLogic.mk_prod (@{term "True"}, HOLogic.mk_list @{typ term}
  57.132                  (map2 HOLogic.mk_term_of (map snd vs') (map Free vs'))))     
  57.133          | Depth_Limited_Random => fold_rev absdummy
  57.134 -            [@{typ code_numeral}, @{typ code_numeral}, @{typ code_numeral},
  57.135 +            [@{typ natural}, @{typ natural}, @{typ natural},
  57.136               @{typ Random.seed}]
  57.137              (mk_bind' (list_comb (prog, map Bound (3 downto 0)),
  57.138              mk_split_lambda (map Free vs') (mk_return' (HOLogic.mk_list @{typ term}
  57.139 @@ -340,7 +336,7 @@
  57.140                  (fn proc => fn g => fn depth => g depth |> Option.map (apsnd (map proc)))
  57.141                  qc_term []
  57.142            in
  57.143 -            fn size => fn nrandom => Option.map snd o compiled_term
  57.144 +            fn _ => fn _ => Option.map snd o compiled_term
  57.145            end
  57.146         | Depth_Limited_Random =>
  57.147            let
  57.148 @@ -382,11 +378,12 @@
  57.149  
  57.150  (* quickcheck interface functions *)
  57.151  
  57.152 -fun compile_term' compilation options ctxt (t, eval_terms) =
  57.153 +fun compile_term' compilation options ctxt (t, _) =
  57.154    let
  57.155      val size = Config.get ctxt Quickcheck.size
  57.156      val c = compile_term compilation options ctxt t
  57.157 -    val counterexample = try_upto_depth ctxt (c size (!nrandom))
  57.158 +    val counterexample = try_upto_depth ctxt (c (Code_Numeral.natural_of_integer size)
  57.159 +      (Code_Numeral.natural_of_integer (!nrandom)) o Code_Numeral.natural_of_integer)
  57.160    in
  57.161      Quickcheck.Result
  57.162        {counterexample = Option.map (pair true o (curry (op ~~)) (Term.add_free_names t [])) counterexample,
  57.163 @@ -403,7 +400,7 @@
  57.164    end
  57.165  
  57.166  
  57.167 -fun test_goals options ctxt catch_code_errors insts goals =
  57.168 +fun test_goals options ctxt _ insts goals =
  57.169    let
  57.170      val (compilation, fail_safe_function_flattening) = options
  57.171      val function_flattening = Config.get ctxt (Quickcheck.allow_function_inversion)
    58.1 --- a/src/HOL/Tools/Qelim/cooper.ML	Fri Feb 15 08:31:30 2013 +0100
    58.2 +++ b/src/HOL/Tools/Qelim/cooper.ML	Fri Feb 15 08:31:31 2013 +0100
    58.3 @@ -267,23 +267,23 @@
    58.4    end
    58.5   | _ => addC $ (mulC $ one $ tm) $ zero;
    58.6  
    58.7 -fun lin (vs as x::_) (Const (@{const_name Not}, _) $ (Const (@{const_name Orderings.less}, T) $ s $ t)) =
    58.8 +fun lin (vs as _::_) (Const (@{const_name Not}, _) $ (Const (@{const_name Orderings.less}, T) $ s $ t)) =
    58.9      lin vs (Const (@{const_name Orderings.less_eq}, T) $ t $ s)
   58.10 -  | lin (vs as x::_) (Const (@{const_name Not},_) $ (Const(@{const_name Orderings.less_eq}, T) $ s $ t)) =
   58.11 +  | lin (vs as _::_) (Const (@{const_name Not},_) $ (Const(@{const_name Orderings.less_eq}, T) $ s $ t)) =
   58.12      lin vs (Const (@{const_name Orderings.less}, T) $ t $ s)
   58.13    | lin vs (Const (@{const_name Not},T)$t) = Const (@{const_name Not},T)$ (lin vs t)
   58.14 -  | lin (vs as x::_) (Const(@{const_name Rings.dvd},_)$d$t) =
   58.15 +  | lin (vs as _::_) (Const(@{const_name Rings.dvd},_)$d$t) =
   58.16      HOLogic.mk_binrel @{const_name Rings.dvd} (numeral1 abs d, lint vs t)
   58.17    | lin (vs as x::_) ((b as Const(@{const_name HOL.eq},_))$s$t) =
   58.18       (case lint vs (subC$t$s) of
   58.19 -      (t as a$(m$c$y)$r) =>
   58.20 +      (t as _$(m$c$y)$r) =>
   58.21          if x <> y then b$zero$t
   58.22          else if dest_number c < 0 then b$(m$(numeral1 ~ c)$y)$r
   58.23          else b$(m$c$y)$(linear_neg r)
   58.24        | t => b$zero$t)
   58.25    | lin (vs as x::_) (b$s$t) =
   58.26       (case lint vs (subC$t$s) of
   58.27 -      (t as a$(m$c$y)$r) =>
   58.28 +      (t as _$(m$c$y)$r) =>
   58.29          if x <> y then b$zero$t
   58.30          else if dest_number c < 0 then b$(m$(numeral1 ~ c)$y)$r
   58.31          else b$(linear_neg r)$(m$c$y)
   58.32 @@ -303,7 +303,7 @@
   58.33    | is_intrel _ = false;
   58.34  
   58.35  fun linearize_conv ctxt vs ct = case term_of ct of
   58.36 -  Const(@{const_name Rings.dvd},_)$d$t =>
   58.37 +  Const(@{const_name Rings.dvd},_)$_$_ =>
   58.38    let
   58.39      val th = Conv.binop_conv (lint_conv ctxt vs) ct
   58.40      val (d',t') = Thm.dest_binop (Thm.rhs_of th)
   58.41 @@ -565,9 +565,9 @@
   58.42    Qelim.gen_qelim_conv (Simplifier.rewrite conv_ss) (Simplifier.rewrite presburger_ss) (Simplifier.rewrite conv_ss)
   58.43      (cons o term_of) (Misc_Legacy.term_frees (term_of p)) (linearize_conv ctxt) (integer_nnf_conv ctxt)
   58.44      (cooperex_conv ctxt) p
   58.45 -  handle CTERM s => raise COOPER "bad cterm"
   58.46 -       | THM s => raise COOPER "bad thm"
   58.47 -       | TYPE s => raise COOPER "bad type"
   58.48 +  handle CTERM _ => raise COOPER "bad cterm"
   58.49 +       | THM _ => raise COOPER "bad thm"
   58.50 +       | TYPE _ => raise COOPER "bad type"
   58.51  
   58.52  fun add_bools t =
   58.53    let
   58.54 @@ -593,14 +593,14 @@
   58.55  
   58.56  local structure Proc = Cooper_Procedure in
   58.57  
   58.58 -fun num_of_term vs (Free vT) = Proc.Bound (find_index (fn vT' => vT' = vT) vs)
   58.59 -  | num_of_term vs (Term.Bound i) = Proc.Bound i
   58.60 -  | num_of_term vs @{term "0::int"} = Proc.C 0
   58.61 -  | num_of_term vs @{term "1::int"} = Proc.C 1
   58.62 +fun num_of_term vs (Free vT) = Proc.Bound (Proc.nat_of_integer (find_index (fn vT' => vT' = vT) vs))
   58.63 +  | num_of_term vs (Term.Bound i) = Proc.Bound (Proc.nat_of_integer i)
   58.64 +  | num_of_term vs @{term "0::int"} = Proc.C (Proc.Int_of_integer 0)
   58.65 +  | num_of_term vs @{term "1::int"} = Proc.C (Proc.Int_of_integer 1)
   58.66    | num_of_term vs (t as Const (@{const_name numeral}, _) $ _) =
   58.67 -      Proc.C (dest_number t)
   58.68 +      Proc.C (Proc.Int_of_integer (dest_number t))
   58.69    | num_of_term vs (t as Const (@{const_name neg_numeral}, _) $ _) =
   58.70 -      Proc.Neg (Proc.C (dest_number t))
   58.71 +      Proc.Neg (Proc.C (Proc.Int_of_integer (dest_number t)))
   58.72    | num_of_term vs (Const (@{const_name Groups.uminus}, _) $ t') =
   58.73        Proc.Neg (num_of_term vs t')
   58.74    | num_of_term vs (Const (@{const_name Groups.plus}, _) $ t1 $ t2) =
   58.75 @@ -609,9 +609,9 @@
   58.76        Proc.Sub (num_of_term vs t1, num_of_term vs t2)
   58.77    | num_of_term vs (Const (@{const_name Groups.times}, _) $ t1 $ t2) =
   58.78       (case perhaps_number t1
   58.79 -       of SOME n => Proc.Mul (n, num_of_term vs t2)
   58.80 +       of SOME n => Proc.Mul (Proc.Int_of_integer n, num_of_term vs t2)
   58.81          | NONE => (case perhaps_number t2
   58.82 -           of SOME n => Proc.Mul (n, num_of_term vs t1)
   58.83 +           of SOME n => Proc.Mul (Proc.Int_of_integer n, num_of_term vs t1)
   58.84              | NONE => raise COOPER "reification: unsupported kind of multiplication"))
   58.85    | num_of_term _ _ = raise COOPER "reification: bad term";
   58.86  
   58.87 @@ -639,13 +639,13 @@
   58.88        Proc.Lt (Proc.Sub (num_of_term vs t1, num_of_term vs t2))
   58.89    | fm_of_term ps vs (Const (@{const_name Rings.dvd}, _) $ t1 $ t2) =
   58.90       (case perhaps_number t1
   58.91 -       of SOME n => Proc.Dvd (n, num_of_term vs t2)
   58.92 +       of SOME n => Proc.Dvd (Proc.Int_of_integer n, num_of_term vs t2)
   58.93          | NONE => raise COOPER "reification: unsupported dvd")
   58.94    | fm_of_term ps vs t = let val n = find_index (fn t' => t aconv t') ps
   58.95 -      in if n > 0 then Proc.Closed n else raise COOPER "reification: unknown term" end;
   58.96 +      in if n > 0 then Proc.Closed (Proc.nat_of_integer n) else raise COOPER "reification: unknown term" end;
   58.97  
   58.98 -fun term_of_num vs (Proc.C i) = HOLogic.mk_number HOLogic.intT i
   58.99 -  | term_of_num vs (Proc.Bound n) = Free (nth vs n)
  58.100 +fun term_of_num vs (Proc.C i) = HOLogic.mk_number HOLogic.intT (Proc.integer_of_int i)
  58.101 +  | term_of_num vs (Proc.Bound n) = Free (nth vs (Proc.integer_of_nat n))
  58.102    | term_of_num vs (Proc.Neg t') =
  58.103        @{term "uminus :: int => _"} $ term_of_num vs t'
  58.104    | term_of_num vs (Proc.Add (t1, t2)) =
  58.105 @@ -653,7 +653,7 @@
  58.106    | term_of_num vs (Proc.Sub (t1, t2)) =
  58.107        @{term "op - :: int => _"} $ term_of_num vs t1 $ term_of_num vs t2
  58.108    | term_of_num vs (Proc.Mul (i, t2)) =
  58.109 -      @{term "op * :: int => _"} $ HOLogic.mk_number HOLogic.intT i $ term_of_num vs t2
  58.110 +      @{term "op * :: int => _"} $ HOLogic.mk_number HOLogic.intT (Proc.integer_of_int i) $ term_of_num vs t2
  58.111    | term_of_num vs (Proc.Cn (n, i, t')) =
  58.112        term_of_num vs (Proc.Add (Proc.Mul (i, Proc.Bound n), t'));
  58.113  
  58.114 @@ -671,9 +671,9 @@
  58.115    | term_of_fm ps vs (Proc.Gt t') = @{term "op < :: int => _ "} $ @{term "0::int"} $ term_of_num vs t'
  58.116    | term_of_fm ps vs (Proc.Ge t') = @{term "op <= :: int => _ "} $ @{term "0::int"} $ term_of_num vs t'
  58.117    | term_of_fm ps vs (Proc.Dvd (i, t')) = @{term "op dvd :: int => _ "} $
  58.118 -      HOLogic.mk_number HOLogic.intT i $ term_of_num vs t'
  58.119 +      HOLogic.mk_number HOLogic.intT (Proc.integer_of_int i) $ term_of_num vs t'
  58.120    | term_of_fm ps vs (Proc.NDvd (i, t')) = term_of_fm ps vs (Proc.Not (Proc.Dvd (i, t')))
  58.121 -  | term_of_fm ps vs (Proc.Closed n) = nth ps n
  58.122 +  | term_of_fm ps vs (Proc.Closed n) = nth ps (Proc.integer_of_nat n)
  58.123    | term_of_fm ps vs (Proc.NClosed n) = term_of_fm ps vs (Proc.Not (Proc.Closed n));
  58.124  
  58.125  fun procedure t =
  58.126 @@ -701,7 +701,7 @@
  58.127  
  58.128  fun strip_objall ct = 
  58.129   case term_of ct of 
  58.130 -  Const (@{const_name All}, _) $ Abs (xn,xT,p) => 
  58.131 +  Const (@{const_name All}, _) $ Abs (xn,_,_) => 
  58.132     let val (a,(v,t')) = (apsnd (Thm.dest_abs (SOME xn)) o Thm.dest_comb) ct
  58.133     in apfst (cons (a,v)) (strip_objall t')
  58.134     end
  58.135 @@ -782,7 +782,7 @@
  58.136   in h [] ct end
  58.137  end;
  58.138  
  58.139 -fun generalize_tac f = CSUBGOAL (fn (p, i) => PRIMITIVE (fn st =>
  58.140 +fun generalize_tac f = CSUBGOAL (fn (p, _) => PRIMITIVE (fn st =>
  58.141   let 
  58.142     fun all T = Drule.cterm_rule (instantiate' [SOME T] []) @{cpat "all"}
  58.143     fun gen x t = Thm.apply (all (ctyp_of_term x)) (Thm.lambda x t)
    59.1 --- a/src/HOL/Tools/Qelim/cooper_procedure.ML	Fri Feb 15 08:31:30 2013 +0100
    59.2 +++ b/src/HOL/Tools/Qelim/cooper_procedure.ML	Fri Feb 15 08:31:31 2013 +0100
    59.3 @@ -1,57 +1,60 @@
    59.4  (* Generated from Cooper.thy; DO NOT EDIT! *)
    59.5  
    59.6  structure Cooper_Procedure : sig
    59.7 +  val id : 'a -> 'a
    59.8    type 'a equal
    59.9    val equal : 'a equal -> 'a -> 'a -> bool
   59.10    val eq : 'a equal -> 'a -> 'a -> bool
   59.11 -  val suc : int -> int
   59.12 -  datatype num = C of int | Bound of int | Cn of int * int * num | Neg of num |
   59.13 -    Add of num * num | Sub of num * num | Mul of int * num
   59.14 -  datatype fm = T | F | Lt of num | Le of num | Gt of num | Ge of num |
   59.15 -    Eq of num | NEq of num | Dvd of int * num | NDvd of int * num | Not of fm |
   59.16 -    And of fm * fm | Or of fm * fm | Imp of fm * fm | Iff of fm * fm | E of fm |
   59.17 -    A of fm | Closed of int | NClosed of int
   59.18 +  datatype inta = Int_of_integer of int
   59.19 +  datatype nat = Nat of int
   59.20 +  datatype num = One | Bit0 of num | Bit1 of num
   59.21 +  type 'a ord
   59.22 +  val less_eq : 'a ord -> 'a -> 'a -> bool
   59.23 +  val less : 'a ord -> 'a -> 'a -> bool
   59.24 +  val ord_integer : int ord
   59.25 +  val max : 'a ord -> 'a -> 'a -> 'a
   59.26 +  val nat_of_integer : int -> nat
   59.27 +  val integer_of_nat : nat -> int
   59.28 +  val plus_nat : nat -> nat -> nat
   59.29 +  val suc : nat -> nat
   59.30 +  datatype numa = C of inta | Bound of nat | Cn of nat * inta * numa |
   59.31 +    Neg of numa | Add of numa * numa | Sub of numa * numa | Mul of inta * numa
   59.32 +  datatype fm = T | F | Lt of numa | Le of numa | Gt of numa | Ge of numa |
   59.33 +    Eq of numa | NEq of numa | Dvd of inta * numa | NDvd of inta * numa |
   59.34 +    Not of fm | And of fm * fm | Or of fm * fm | Imp of fm * fm | Iff of fm * fm
   59.35 +    | E of fm | A of fm | Closed of nat | NClosed of nat
   59.36    val map : ('a -> 'b) -> 'a list -> 'b list
   59.37 -  val equal_numa : num -> num -> bool
   59.38 +  val disjuncts : fm -> fm list
   59.39 +  val foldr : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
   59.40 +  val equal_nat : nat -> nat -> bool
   59.41 +  val integer_of_int : inta -> int
   59.42 +  val equal_inta : inta -> inta -> bool
   59.43 +  val equal_numa : numa -> numa -> bool
   59.44    val equal_fm : fm -> fm -> bool
   59.45    val djf : ('a -> fm) -> 'a -> fm -> fm
   59.46 -  val foldr : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
   59.47    val evaldjf : ('a -> fm) -> 'a list -> fm
   59.48 -  val disjuncts : fm -> fm list
   59.49    val dj : (fm -> fm) -> fm -> fm
   59.50 -  val prep : fm -> fm
   59.51 -  val conj : fm -> fm -> fm
   59.52 -  val disj : fm -> fm -> fm
   59.53 -  val nota : fm -> fm
   59.54 -  val iffa : fm -> fm -> fm
   59.55 -  val impa : fm -> fm -> fm
   59.56 -  type 'a times
   59.57 -  val times : 'a times -> 'a -> 'a -> 'a
   59.58 -  type 'a dvd
   59.59 -  val times_dvd : 'a dvd -> 'a times
   59.60 -  type 'a diva
   59.61 -  val dvd_div : 'a diva -> 'a dvd
   59.62 -  val diva : 'a diva -> 'a -> 'a -> 'a
   59.63 -  val moda : 'a diva -> 'a -> 'a -> 'a
   59.64 -  type 'a zero
   59.65 -  val zero : 'a zero -> 'a
   59.66 -  type 'a no_zero_divisors
   59.67 -  val times_no_zero_divisors : 'a no_zero_divisors -> 'a times
   59.68 -  val zero_no_zero_divisors : 'a no_zero_divisors -> 'a zero
   59.69 -  type 'a semigroup_mult
   59.70 -  val times_semigroup_mult : 'a semigroup_mult -> 'a times
   59.71 +  val minus_nat : nat -> nat -> nat
   59.72 +  val zero_nat : nat
   59.73 +  val minusinf : fm -> fm
   59.74 +  val numsubst0 : numa -> numa -> numa
   59.75 +  val subst0 : numa -> fm -> fm
   59.76    type 'a plus
   59.77    val plus : 'a plus -> 'a -> 'a -> 'a
   59.78    type 'a semigroup_add
   59.79    val plus_semigroup_add : 'a semigroup_add -> 'a plus
   59.80 +  type 'a cancel_semigroup_add
   59.81 +  val semigroup_add_cancel_semigroup_add :
   59.82 +    'a cancel_semigroup_add -> 'a semigroup_add
   59.83    type 'a ab_semigroup_add
   59.84    val semigroup_add_ab_semigroup_add : 'a ab_semigroup_add -> 'a semigroup_add
   59.85 -  type 'a semiring
   59.86 -  val ab_semigroup_add_semiring : 'a semiring -> 'a ab_semigroup_add
   59.87 -  val semigroup_mult_semiring : 'a semiring -> 'a semigroup_mult
   59.88 -  type 'a mult_zero
   59.89 -  val times_mult_zero : 'a mult_zero -> 'a times
   59.90 -  val zero_mult_zero : 'a mult_zero -> 'a zero
   59.91 +  type 'a cancel_ab_semigroup_add
   59.92 +  val ab_semigroup_add_cancel_ab_semigroup_add :
   59.93 +    'a cancel_ab_semigroup_add -> 'a ab_semigroup_add
   59.94 +  val cancel_semigroup_add_cancel_ab_semigroup_add :
   59.95 +    'a cancel_ab_semigroup_add -> 'a cancel_semigroup_add
   59.96 +  type 'a zero
   59.97 +  val zero : 'a zero -> 'a
   59.98    type 'a monoid_add
   59.99    val semigroup_add_monoid_add : 'a monoid_add -> 'a semigroup_add
  59.100    val zero_monoid_add : 'a monoid_add -> 'a zero
  59.101 @@ -59,25 +62,29 @@
  59.102    val ab_semigroup_add_comm_monoid_add :
  59.103      'a comm_monoid_add -> 'a ab_semigroup_add
  59.104    val monoid_add_comm_monoid_add : 'a comm_monoid_add -> 'a monoid_add
  59.105 +  type 'a cancel_comm_monoid_add
  59.106 +  val cancel_ab_semigroup_add_cancel_comm_monoid_add :
  59.107 +    'a cancel_comm_monoid_add -> 'a cancel_ab_semigroup_add
  59.108 +  val comm_monoid_add_cancel_comm_monoid_add :
  59.109 +    'a cancel_comm_monoid_add -> 'a comm_monoid_add
  59.110 +  type 'a times
  59.111 +  val times : 'a times -> 'a -> 'a -> 'a
  59.112 +  type 'a mult_zero
  59.113 +  val times_mult_zero : 'a mult_zero -> 'a times
  59.114 +  val zero_mult_zero : 'a mult_zero -> 'a zero
  59.115 +  type 'a semigroup_mult
  59.116 +  val times_semigroup_mult : 'a semigroup_mult -> 'a times
  59.117 +  type 'a semiring
  59.118 +  val ab_semigroup_add_semiring : 'a semiring -> 'a ab_semigroup_add
  59.119 +  val semigroup_mult_semiring : 'a semiring -> 'a semigroup_mult
  59.120    type 'a semiring_0
  59.121    val comm_monoid_add_semiring_0 : 'a semiring_0 -> 'a comm_monoid_add
  59.122    val mult_zero_semiring_0 : 'a semiring_0 -> 'a mult_zero
  59.123    val semiring_semiring_0 : 'a semiring_0 -> 'a semiring
  59.124 -  type 'a one
  59.125 -  val one : 'a one -> 'a
  59.126 -  type 'a power
  59.127 -  val one_power : 'a power -> 'a one
  59.128 -  val times_power : 'a power -> 'a times
  59.129 -  type 'a monoid_mult
  59.130 -  val semigroup_mult_monoid_mult : 'a monoid_mult -> 'a semigroup_mult
  59.131 -  val power_monoid_mult : 'a monoid_mult -> 'a power
  59.132 -  type 'a zero_neq_one
  59.133 -  val one_zero_neq_one : 'a zero_neq_one -> 'a one
  59.134 -  val zero_zero_neq_one : 'a zero_neq_one -> 'a zero
  59.135 -  type 'a semiring_1
  59.136 -  val monoid_mult_semiring_1 : 'a semiring_1 -> 'a monoid_mult
  59.137 -  val semiring_0_semiring_1 : 'a semiring_1 -> 'a semiring_0
  59.138 -  val zero_neq_one_semiring_1 : 'a semiring_1 -> 'a zero_neq_one
  59.139 +  type 'a semiring_0_cancel
  59.140 +  val cancel_comm_monoid_add_semiring_0_cancel :
  59.141 +    'a semiring_0_cancel -> 'a cancel_comm_monoid_add
  59.142 +  val semiring_0_semiring_0_cancel : 'a semiring_0_cancel -> 'a semiring_0
  59.143    type 'a ab_semigroup_mult
  59.144    val semigroup_mult_ab_semigroup_mult :
  59.145      'a ab_semigroup_mult -> 'a semigroup_mult
  59.146 @@ -87,42 +94,49 @@
  59.147    type 'a comm_semiring_0
  59.148    val comm_semiring_comm_semiring_0 : 'a comm_semiring_0 -> 'a comm_semiring
  59.149    val semiring_0_comm_semiring_0 : 'a comm_semiring_0 -> 'a semiring_0
  59.150 +  type 'a comm_semiring_0_cancel
  59.151 +  val comm_semiring_0_comm_semiring_0_cancel :
  59.152 +    'a comm_semiring_0_cancel -> 'a comm_semiring_0
  59.153 +  val semiring_0_cancel_comm_semiring_0_cancel :
  59.154 +    'a comm_semiring_0_cancel -> 'a semiring_0_cancel
  59.155 +  type 'a one
  59.156 +  val one : 'a one -> 'a
  59.157 +  type 'a power
  59.158 +  val one_power : 'a power -> 'a one
  59.159 +  val times_power : 'a power -> 'a times
  59.160 +  type 'a monoid_mult
  59.161 +  val semigroup_mult_monoid_mult : 'a monoid_mult -> 'a semigroup_mult
  59.162 +  val power_monoid_mult : 'a monoid_mult -> 'a power
  59.163 +  type 'a numeral
  59.164 +  val one_numeral : 'a numeral -> 'a one
  59.165 +  val semigroup_add_numeral : 'a numeral -> 'a semigroup_add
  59.166 +  type 'a semiring_numeral
  59.167 +  val monoid_mult_semiring_numeral : 'a semiring_numeral -> 'a monoid_mult
  59.168 +  val numeral_semiring_numeral : 'a semiring_numeral -> 'a numeral
  59.169 +  val semiring_semiring_numeral : 'a semiring_numeral -> 'a semiring
  59.170 +  type 'a zero_neq_one
  59.171 +  val one_zero_neq_one : 'a zero_neq_one -> 'a one
  59.172 +  val zero_zero_neq_one : 'a zero_neq_one -> 'a zero
  59.173 +  type 'a semiring_1
  59.174 +  val semiring_numeral_semiring_1 : 'a semiring_1 -> 'a semiring_numeral
  59.175 +  val semiring_0_semiring_1 : 'a semiring_1 -> 'a semiring_0
  59.176 +  val zero_neq_one_semiring_1 : 'a semiring_1 -> 'a zero_neq_one
  59.177 +  type 'a semiring_1_cancel
  59.178 +  val semiring_0_cancel_semiring_1_cancel :
  59.179 +    'a semiring_1_cancel -> 'a semiring_0_cancel
  59.180 +  val semiring_1_semiring_1_cancel : 'a semiring_1_cancel -> 'a semiring_1
  59.181    type 'a comm_monoid_mult
  59.182    val ab_semigroup_mult_comm_monoid_mult :
  59.183      'a comm_monoid_mult -> 'a ab_semigroup_mult
  59.184    val monoid_mult_comm_monoid_mult : 'a comm_monoid_mult -> 'a monoid_mult
  59.185 +  type 'a dvd
  59.186 +  val times_dvd : 'a dvd -> 'a times
  59.187    type 'a comm_semiring_1
  59.188    val comm_monoid_mult_comm_semiring_1 :
  59.189      'a comm_semiring_1 -> 'a comm_monoid_mult
  59.190    val comm_semiring_0_comm_semiring_1 : 'a comm_semiring_1 -> 'a comm_semiring_0
  59.191    val dvd_comm_semiring_1 : 'a comm_semiring_1 -> 'a dvd
  59.192    val semiring_1_comm_semiring_1 : 'a comm_semiring_1 -> 'a semiring_1
  59.193 -  type 'a cancel_semigroup_add
  59.194 -  val semigroup_add_cancel_semigroup_add :
  59.195 -    'a cancel_semigroup_add -> 'a semigroup_add
  59.196 -  type 'a cancel_ab_semigroup_add
  59.197 -  val ab_semigroup_add_cancel_ab_semigroup_add :
  59.198 -    'a cancel_ab_semigroup_add -> 'a ab_semigroup_add
  59.199 -  val cancel_semigroup_add_cancel_ab_semigroup_add :
  59.200 -    'a cancel_ab_semigroup_add -> 'a cancel_semigroup_add
  59.201 -  type 'a cancel_comm_monoid_add
  59.202 -  val cancel_ab_semigroup_add_cancel_comm_monoid_add :
  59.203 -    'a cancel_comm_monoid_add -> 'a cancel_ab_semigroup_add
  59.204 -  val comm_monoid_add_cancel_comm_monoid_add :
  59.205 -    'a cancel_comm_monoid_add -> 'a comm_monoid_add
  59.206 -  type 'a semiring_0_cancel
  59.207 -  val cancel_comm_monoid_add_semiring_0_cancel :
  59.208 -    'a semiring_0_cancel -> 'a cancel_comm_monoid_add
  59.209 -  val semiring_0_semiring_0_cancel : 'a semiring_0_cancel -> 'a semiring_0
  59.210 -  type 'a semiring_1_cancel
  59.211 -  val semiring_0_cancel_semiring_1_cancel :
  59.212 -    'a semiring_1_cancel -> 'a semiring_0_cancel
  59.213 -  val semiring_1_semiring_1_cancel : 'a semiring_1_cancel -> 'a semiring_1
  59.214 -  type 'a comm_semiring_0_cancel
  59.215 -  val comm_semiring_0_comm_semiring_0_cancel :
  59.216 -    'a comm_semiring_0_cancel -> 'a comm_semiring_0
  59.217 -  val semiring_0_cancel_comm_semiring_0_cancel :
  59.218 -    'a comm_semiring_0_cancel -> 'a semiring_0_cancel
  59.219    type 'a comm_semiring_1_cancel
  59.220    val comm_semiring_0_cancel_comm_semiring_1_cancel :
  59.221      'a comm_semiring_1_cancel -> 'a comm_semiring_0_cancel
  59.222 @@ -130,107 +144,182 @@
  59.223      'a comm_semiring_1_cancel -> 'a comm_semiring_1
  59.224    val semiring_1_cancel_comm_semiring_1_cancel :
  59.225      'a comm_semiring_1_cancel -> 'a semiring_1_cancel
  59.226 +  type 'a no_zero_divisors
  59.227 +  val times_no_zero_divisors : 'a no_zero_divisors -> 'a times
  59.228 +  val zero_no_zero_divisors : 'a no_zero_divisors -> 'a zero
  59.229 +  type 'a diva
  59.230 +  val dvd_div : 'a diva -> 'a dvd
  59.231 +  val diva : 'a diva -> 'a -> 'a -> 'a
  59.232 +  val moda : 'a diva -> 'a -> 'a -> 'a
  59.233    type 'a semiring_div
  59.234    val div_semiring_div : 'a semiring_div -> 'a diva
  59.235    val comm_semiring_1_cancel_semiring_div :
  59.236      'a semiring_div -> 'a comm_semiring_1_cancel
  59.237    val no_zero_divisors_semiring_div : 'a semiring_div -> 'a no_zero_divisors
  59.238 -  val dvd : 'a semiring_div * 'a equal -> 'a -> 'a -> bool
  59.239 -  val abs_int : int -> int
  59.240 -  val equal_int : int equal
  59.241 -  val numadd : num * num -> num
  59.242 -  val nummul : int -> num -> num
  59.243 -  val numneg : num -> num
  59.244 -  val numsub : num -> num -> num
  59.245 -  val simpnum : num -> num
  59.246 -  val one_inta : int
  59.247 -  val zero_inta : int
  59.248 -  val times_int : int times
  59.249 -  val dvd_int : int dvd
  59.250 -  val fst : 'a * 'b -> 'a
  59.251 -  val sgn_int : int -> int
  59.252 +  val plus_inta : inta -> inta -> inta
  59.253 +  val plus_int : inta plus
  59.254 +  val semigroup_add_int : inta semigroup_add
  59.255 +  val cancel_semigroup_add_int : inta cancel_semigroup_add
  59.256 +  val ab_semigroup_add_int : inta ab_semigroup_add
  59.257 +  val cancel_ab_semigroup_add_int : inta cancel_ab_semigroup_add
  59.258 +  val zero_inta : inta
  59.259 +  val zero_int : inta zero
  59.260 +  val monoid_add_int : inta monoid_add
  59.261 +  val comm_monoid_add_int : inta comm_monoid_add
  59.262 +  val cancel_comm_monoid_add_int : inta cancel_comm_monoid_add
  59.263 +  val times_inta : inta -> inta -> inta
  59.264 +  val times_int : inta times
  59.265 +  val mult_zero_int : inta mult_zero
  59.266 +  val semigroup_mult_int : inta semigroup_mult
  59.267 +  val semiring_int : inta semiring
  59.268 +  val semiring_0_int : inta semiring_0
  59.269 +  val semiring_0_cancel_int : inta semiring_0_cancel
  59.270 +  val ab_semigroup_mult_int : inta ab_semigroup_mult
  59.271 +  val comm_semiring_int : inta comm_semiring
  59.272 +  val comm_semiring_0_int : inta comm_semiring_0
  59.273 +  val comm_semiring_0_cancel_int : inta comm_semiring_0_cancel
  59.274 +  val one_inta : inta
  59.275 +  val one_int : inta one
  59.276 +  val power_int : inta power
  59.277 +  val monoid_mult_int : inta monoid_mult
  59.278 +  val numeral_int : inta numeral
  59.279 +  val semiring_numeral_int : inta semiring_numeral
  59.280 +  val zero_neq_one_int : inta zero_neq_one
  59.281 +  val semiring_1_int : inta semiring_1
  59.282 +  val semiring_1_cancel_int : inta semiring_1_cancel
  59.283 +  val comm_monoid_mult_int : inta comm_monoid_mult
  59.284 +  val dvd_int : inta dvd
  59.285 +  val comm_semiring_1_int : inta comm_semiring_1
  59.286 +  val comm_semiring_1_cancel_int : inta comm_semiring_1_cancel
  59.287 +  val no_zero_divisors_int : inta no_zero_divisors
  59.288 +  val sgn_integer : int -> int
  59.289 +  val abs_integer : int -> int
  59.290    val apsnd : ('a -> 'b) -> 'c * 'a -> 'c * 'b
  59.291 -  val divmod_int : int -> int -> int * int
  59.292 -  val div_inta : int -> int -> int
  59.293 +  val divmod_integer : int -> int -> int * int
  59.294    val snd : 'a * 'b -> 'b
  59.295 -  val mod_int : int -> int -> int
  59.296 -  val div_int : int diva
  59.297 -  val zero_int : int zero
  59.298 -  val no_zero_divisors_int : int no_zero_divisors
  59.299 -  val semigroup_mult_int : int semigroup_mult
  59.300 -  val plus_int : int plus
  59.301 -  val semigroup_add_int : int semigroup_add
  59.302 -  val ab_semigroup_add_int : int ab_semigroup_add
  59.303 -  val semiring_int : int semiring
  59.304 -  val mult_zero_int : int mult_zero
  59.305 -  val monoid_add_int : int monoid_add
  59.306 -  val comm_monoid_add_int : int comm_monoid_add
  59.307 -  val semiring_0_int : int semiring_0
  59.308 -  val one_int : int one
  59.309 -  val power_int : int power
  59.310 -  val monoid_mult_int : int monoid_mult
  59.311 -  val zero_neq_one_int : int zero_neq_one
  59.312 -  val semiring_1_int : int semiring_1
  59.313 -  val ab_semigroup_mult_int : int ab_semigroup_mult
  59.314 -  val comm_semiring_int : int comm_semiring
  59.315 -  val comm_semiring_0_int : int comm_semiring_0
  59.316 -  val comm_monoid_mult_int : int comm_monoid_mult
  59.317 -  val comm_semiring_1_int : int comm_semiring_1
  59.318 -  val cancel_semigroup_add_int : int cancel_semigroup_add
  59.319 -  val cancel_ab_semigroup_add_int : int cancel_ab_semigroup_add
  59.320 -  val cancel_comm_monoid_add_int : int cancel_comm_monoid_add
  59.321 -  val semiring_0_cancel_int : int semiring_0_cancel
  59.322 -  val semiring_1_cancel_int : int semiring_1_cancel
  59.323 -  val comm_semiring_0_cancel_int : int comm_semiring_0_cancel
  59.324 -  val comm_semiring_1_cancel_int : int comm_semiring_1_cancel
  59.325 -  val semiring_div_int : int semiring_div
  59.326 +  val mod_integer : int -> int -> int
  59.327 +  val mod_int : inta -> inta -> inta
  59.328 +  val fst : 'a * 'b -> 'a
  59.329 +  val div_integer : int -> int -> int
  59.330 +  val div_inta : inta -> inta -> inta
  59.331 +  val div_int : inta diva
  59.332 +  val semiring_div_int : inta semiring_div
  59.333 +  val less_eq_int : inta -> inta -> bool
  59.334 +  val uminus_int : inta -> inta
  59.335 +  val nummul : inta -> numa -> numa
  59.336 +  val numneg : numa -> numa
  59.337 +  val less_eq_nat : nat -> nat -> bool
  59.338 +  val numadd : numa * numa -> numa
  59.339 +  val numsub : numa -> numa -> numa
  59.340 +  val simpnum : numa -> numa
  59.341 +  val less_int : inta -> inta -> bool
  59.342 +  val equal_int : inta equal
  59.343 +  val abs_int : inta -> inta
  59.344 +  val nota : fm -> fm
  59.345 +  val impa : fm -> fm -> fm
  59.346 +  val iffa : fm -> fm -> fm
  59.347 +  val disj : fm -> fm -> fm
  59.348 +  val conj : fm -> fm -> fm
  59.349 +  val dvd : 'a semiring_div * 'a equal -> 'a -> 'a -> bool
  59.350    val simpfm : fm -> fm
  59.351 -  val qelim : fm -> (fm -> fm) -> fm
  59.352 -  val maps : ('a -> 'b list) -> 'a list -> 'b list
  59.353 -  val uptoa : int -> int -> int list
  59.354 -  val minus_nat : int -> int -> int
  59.355 -  val decrnum : num -> num
  59.356 -  val decr : fm -> fm
  59.357 -  val beta : fm -> num list
  59.358 -  val gcd_int : int -> int -> int
  59.359 -  val lcm_int : int -> int -> int
  59.360 -  val zeta : fm -> int
  59.361 -  val zsplit0 : num -> int * num
  59.362 -  val zlfm : fm -> fm
  59.363 -  val alpha : fm -> num list
  59.364 -  val delta : fm -> int
  59.365 +  val equal_num : numa equal
  59.366 +  val gen_length : nat -> 'a list -> nat
  59.367 +  val size_list : 'a list -> nat
  59.368 +  val mirror : fm -> fm
  59.369 +  val a_beta : fm -> inta -> fm
  59.370    val member : 'a equal -> 'a list -> 'a -> bool
  59.371    val remdups : 'a equal -> 'a list -> 'a list
  59.372 -  val a_beta : fm -> int -> fm
  59.373 -  val mirror : fm -> fm
  59.374 -  val size_list : 'a list -> int
  59.375 -  val equal_num : num equal
  59.376 -  val unita : fm -> fm * (num list * int)
  59.377 -  val numsubst0 : num -> num -> num
  59.378 -  val subst0 : num -> fm -> fm
  59.379 -  val minusinf : fm -> fm
  59.380 +  val gcd_int : inta -> inta -> inta
  59.381 +  val lcm_int : inta -> inta -> inta
  59.382 +  val delta : fm -> inta
  59.383 +  val alpha : fm -> numa list
  59.384 +  val minus_int : inta -> inta -> inta
  59.385 +  val zsplit0 : numa -> inta * numa
  59.386 +  val zlfm : fm -> fm
  59.387 +  val zeta : fm -> inta
  59.388 +  val beta : fm -> numa list
  59.389 +  val unita : fm -> fm * (numa list * inta)
  59.390 +  val decrnum : numa -> numa
  59.391 +  val decr : fm -> fm
  59.392 +  val uptoa : inta -> inta -> inta list
  59.393 +  val maps : ('a -> 'b list) -> 'a list -> 'b list
  59.394    val cooper : fm -> fm
  59.395 +  val qelim : fm -> (fm -> fm) -> fm
  59.396 +  val prep : fm -> fm
  59.397    val pa : fm -> fm
  59.398  end = struct
  59.399  
  59.400 +fun id x = (fn xa => xa) x;
  59.401 +
  59.402  type 'a equal = {equal : 'a -> 'a -> bool};
  59.403  val equal = #equal : 'a equal -> 'a -> 'a -> bool;
  59.404  
  59.405  fun eq A_ a b = equal A_ a b;
  59.406  
  59.407 -fun suc n = n + (1 : IntInf.int);
  59.408 +datatype inta = Int_of_integer of int;
  59.409 +
  59.410 +datatype nat = Nat of int;
  59.411 +
  59.412 +datatype num = One | Bit0 of num | Bit1 of num;
  59.413  
  59.414 -datatype num = C of int | Bound of int | Cn of int * int * num | Neg of num |
  59.415 -  Add of num * num | Sub of num * num | Mul of int * num;
  59.416 +type 'a ord = {less_eq : 'a -> 'a -> bool, less : 'a -> 'a -> bool};
  59.417 +val less_eq = #less_eq : 'a ord -> 'a -> 'a -> bool;
  59.418 +val less = #less : 'a ord -> 'a -> 'a -> bool;
  59.419 +
  59.420 +val ord_integer =
  59.421 +  {less_eq = (fn a => fn b => a <= b), less = (fn a => fn b => a < b)} :
  59.422 +  int ord;
  59.423 +
  59.424 +fun max A_ a b = (if less_eq A_ a b then b else a);
  59.425  
  59.426 -datatype fm = T | F | Lt of num | Le of num | Gt of num | Ge of num | Eq of num
  59.427 -  | NEq of num | Dvd of int * num | NDvd of int * num | Not of fm |
  59.428 -  And of fm * fm | Or of fm * fm | Imp of fm * fm | Iff of fm * fm | E of fm |
  59.429 -  A of fm | Closed of int | NClosed of int;
  59.430 +fun nat_of_integer k = Nat (max ord_integer 0 k);
  59.431 +
  59.432 +fun integer_of_nat (Nat x) = x;
  59.433 +
  59.434 +fun plus_nat m n = Nat (integer_of_nat m + integer_of_nat n);
  59.435 +
  59.436 +fun suc n = plus_nat n (nat_of_integer (1 : IntInf.int));
  59.437 +
  59.438 +datatype numa = C of inta | Bound of nat | Cn of nat * inta * numa | Neg of numa
  59.439 +  | Add of numa * numa | Sub of numa * numa | Mul of inta * numa;
  59.440 +
  59.441 +datatype fm = T | F | Lt of numa | Le of numa | Gt of numa | Ge of numa |
  59.442 +  Eq of numa | NEq of numa | Dvd of inta * numa | NDvd of inta * numa |
  59.443 +  Not of fm | And of fm * fm | Or of fm * fm | Imp of fm * fm | Iff of fm * fm |
  59.444 +  E of fm | A of fm | Closed of nat | NClosed of nat;
  59.445  
  59.446  fun map f [] = []
  59.447    | map f (x :: xs) = f x :: map f xs;
  59.448  
  59.449 +fun disjuncts (Or (p, q)) = disjuncts p @ disjuncts q
  59.450 +  | disjuncts F = []
  59.451 +  | disjuncts T = [T]
  59.452 +  | disjuncts (Lt v) = [Lt v]
  59.453 +  | disjuncts (Le v) = [Le v]
  59.454 +  | disjuncts (Gt v) = [Gt v]
  59.455 +  | disjuncts (Ge v) = [Ge v]
  59.456 +  | disjuncts (Eq v) = [Eq v]
  59.457 +  | disjuncts (NEq v) = [NEq v]
  59.458 +  | disjuncts (Dvd (v, va)) = [Dvd (v, va)]
  59.459 +  | disjuncts (NDvd (v, va)) = [NDvd (v, va)]
  59.460 +  | disjuncts (Not v) = [Not v]
  59.461 +  | disjuncts (And (v, va)) = [And (v, va)]
  59.462 +  | disjuncts (Imp (v, va)) = [Imp (v, va)]
  59.463 +  | disjuncts (Iff (v, va)) = [Iff (v, va)]
  59.464 +  | disjuncts (E v) = [E v]
  59.465 +  | disjuncts (A v) = [A v]
  59.466 +  | disjuncts (Closed v) = [Closed v]
  59.467 +  | disjuncts (NClosed v) = [NClosed v];
  59.468 +
  59.469 +fun foldr f [] = id
  59.470 +  | foldr f (x :: xs) = f x o foldr f xs;
  59.471 +
  59.472 +fun equal_nat m n = integer_of_nat m = integer_of_nat n;
  59.473 +
  59.474 +fun integer_of_int (Int_of_integer k) = k;
  59.475 +
  59.476 +fun equal_inta k l = integer_of_int k = integer_of_int l;
  59.477 +
  59.478  fun equal_numa (Mul (inta, num)) (Sub (num1, num2)) = false
  59.479    | equal_numa (Sub (num1, num2)) (Mul (inta, num)) = false
  59.480    | equal_numa (Mul (inta, num)) (Add (num1, num2)) = false
  59.481 @@ -274,16 +363,17 @@
  59.482    | equal_numa (Bound nat) (C inta) = false
  59.483    | equal_numa (C inta) (Bound nat) = false
  59.484    | equal_numa (Mul (intaa, numa)) (Mul (inta, num)) =
  59.485 -    intaa = inta andalso equal_numa numa num
  59.486 +    equal_inta intaa inta andalso equal_numa numa num
  59.487    | equal_numa (Sub (num1a, num2a)) (Sub (num1, num2)) =
  59.488      equal_numa num1a num1 andalso equal_numa num2a num2
  59.489    | equal_numa (Add (num1a, num2a)) (Add (num1, num2)) =
  59.490      equal_numa num1a num1 andalso equal_numa num2a num2
  59.491    | equal_numa (Neg numa) (Neg num) = equal_numa numa num
  59.492    | equal_numa (Cn (nata, intaa, numa)) (Cn (nat, inta, num)) =
  59.493 -    nata = nat andalso (intaa = inta andalso equal_numa numa num)
  59.494 -  | equal_numa (Bound nata) (Bound nat) = nata = nat
  59.495 -  | equal_numa (C intaa) (C inta) = intaa = inta;
  59.496 +    equal_nat nata nat andalso
  59.497 +      (equal_inta intaa inta andalso equal_numa numa num)
  59.498 +  | equal_numa (Bound nata) (Bound nat) = equal_nat nata nat
  59.499 +  | equal_numa (C intaa) (C inta) = equal_inta intaa inta;
  59.500  
  59.501  fun equal_fm (NClosed nata) (Closed nat) = false
  59.502    | equal_fm (Closed nata) (NClosed nat) = false
  59.503 @@ -627,8 +717,8 @@
  59.504    | equal_fm T (Lt num) = false
  59.505    | equal_fm F T = false
  59.506    | equal_fm T F = false
  59.507 -  | equal_fm (NClosed nata) (NClosed nat) = nata = nat
  59.508 -  | equal_fm (Closed nata) (Closed nat) = nata = nat
  59.509 +  | equal_fm (NClosed nata) (NClosed nat) = equal_nat nata nat
  59.510 +  | equal_fm (Closed nata) (Closed nat) = equal_nat nata nat
  59.511    | equal_fm (A fma) (A fm) = equal_fm fma fm
  59.512    | equal_fm (E fma) (E fm) = equal_fm fma fm
  59.513    | equal_fm (Iff (fm1a, fm2a)) (Iff (fm1, fm2)) =
  59.514 @@ -641,9 +731,9 @@
  59.515      equal_fm fm1a fm1 andalso equal_fm fm2a fm2
  59.516    | equal_fm (Not fma) (Not fm) = equal_fm fma fm
  59.517    | equal_fm (NDvd (intaa, numa)) (NDvd (inta, num)) =
  59.518 -    intaa = inta andalso equal_numa numa num
  59.519 +    equal_inta intaa inta andalso equal_numa numa num
  59.520    | equal_fm (Dvd (intaa, numa)) (Dvd (inta, num)) =
  59.521 -    intaa = inta andalso equal_numa numa num
  59.522 +    equal_inta intaa inta andalso equal_numa numa num
  59.523    | equal_fm (NEq numa) (NEq num) = equal_numa numa num
  59.524    | equal_fm (Eq numa) (Eq num) = equal_numa numa num
  59.525    | equal_fm (Ge numa) (Ge num) = equal_numa numa num
  59.526 @@ -666,32 +756,1457 @@
  59.527                    | E _ => Or (f p, q) | A _ => Or (f p, q)
  59.528                    | Closed _ => Or (f p, q) | NClosed _ => Or (f p, q))));
  59.529  
  59.530 -fun foldr f [] a = a
  59.531 -  | foldr f (x :: xs) a = f x (foldr f xs a);
  59.532 -
  59.533  fun evaldjf f ps = foldr (djf f) ps F;
  59.534  
  59.535 -fun disjuncts (Or (p, q)) = disjuncts p @ disjuncts q
  59.536 -  | disjuncts F = []
  59.537 -  | disjuncts T = [T]
  59.538 -  | disjuncts (Lt v) = [Lt v]
  59.539 -  | disjuncts (Le v) = [Le v]
  59.540 -  | disjuncts (Gt v) = [Gt v]
  59.541 -  | disjuncts (Ge v) = [Ge v]
  59.542 -  | disjuncts (Eq v) = [Eq v]
  59.543 -  | disjuncts (NEq v) = [NEq v]
  59.544 -  | disjuncts (Dvd (v, va)) = [Dvd (v, va)]
  59.545 -  | disjuncts (NDvd (v, va)) = [NDvd (v, va)]
  59.546 -  | disjuncts (Not v) = [Not v]
  59.547 -  | disjuncts (And (v, va)) = [And (v, va)]
  59.548 -  | disjuncts (Imp (v, va)) = [Imp (v, va)]
  59.549 -  | disjuncts (Iff (v, va)) = [Iff (v, va)]
  59.550 -  | disjuncts (E v) = [E v]
  59.551 -  | disjuncts (A v) = [A v]
  59.552 -  | disjuncts (Closed v) = [Closed v]
  59.553 -  | disjuncts (NClosed v) = [NClosed v];
  59.554 +fun dj f p = evaldjf f (disjuncts p);
  59.555 +
  59.556 +fun minus_nat m n =
  59.557 +  Nat (max ord_integer 0 (integer_of_nat m - integer_of_nat n));
  59.558 +
  59.559 +val zero_nat : nat = Nat 0;
  59.560 +
  59.561 +fun minusinf (And (p, q)) = And (minusinf p, minusinf q)
  59.562 +  | minusinf (Or (p, q)) = Or (minusinf p, minusinf q)
  59.563 +  | minusinf T = T
  59.564 +  | minusinf F = F
  59.565 +  | minusinf (Lt (C bo)) = Lt (C bo)
  59.566 +  | minusinf (Lt (Bound bp)) = Lt (Bound bp)
  59.567 +  | minusinf (Lt (Neg bt)) = Lt (Neg bt)
  59.568 +  | minusinf (Lt (Add (bu, bv))) = Lt (Add (bu, bv))
  59.569 +  | minusinf (Lt (Sub (bw, bx))) = Lt (Sub (bw, bx))
  59.570 +  | minusinf (Lt (Mul (by, bz))) = Lt (Mul (by, bz))
  59.571 +  | minusinf (Le (C co)) = Le (C co)
  59.572 +  | minusinf (Le (Bound cp)) = Le (Bound cp)
  59.573 +  | minusinf (Le (Neg ct)) = Le (Neg ct)
  59.574 +  | minusinf (Le (Add (cu, cv))) = Le (Add (cu, cv))
  59.575 +  | minusinf (Le (Sub (cw, cx))) = Le (Sub (cw, cx))
  59.576 +  | minusinf (Le (Mul (cy, cz))) = Le (Mul (cy, cz))
  59.577 +  | minusinf (Gt (C doa)) = Gt (C doa)
  59.578 +  | minusinf (Gt (Bound dp)) = Gt (Bound dp)
  59.579 +  | minusinf (Gt (Neg dt)) = Gt (Neg dt)
  59.580 +  | minusinf (Gt (Add (du, dv))) = Gt (Add (du, dv))
  59.581 +  | minusinf (Gt (Sub (dw, dx))) = Gt (Sub (dw, dx))
  59.582 +  | minusinf (Gt (Mul (dy, dz))) = Gt (Mul (dy, dz))
  59.583 +  | minusinf (Ge (C eo)) = Ge (C eo)
  59.584 +  | minusinf (Ge (Bound ep)) = Ge (Bound ep)
  59.585 +  | minusinf (Ge (Neg et)) = Ge (Neg et)
  59.586 +  | minusinf (Ge (Add (eu, ev))) = Ge (Add (eu, ev))
  59.587 +  | minusinf (Ge (Sub (ew, ex))) = Ge (Sub (ew, ex))
  59.588 +  | minusinf (Ge (Mul (ey, ez))) = Ge (Mul (ey, ez))
  59.589 +  | minusinf (Eq (C fo)) = Eq (C fo)
  59.590 +  | minusinf (Eq (Bound fp)) = Eq (Bound fp)
  59.591 +  | minusinf (Eq (Neg ft)) = Eq (Neg ft)
  59.592 +  | minusinf (Eq (Add (fu, fv))) = Eq (Add (fu, fv))
  59.593 +  | minusinf (Eq (Sub (fw, fx))) = Eq (Sub (fw, fx))
  59.594 +  | minusinf (Eq (Mul (fy, fz))) = Eq (Mul (fy, fz))
  59.595 +  | minusinf (NEq (C go)) = NEq (C go)
  59.596 +  | minusinf (NEq (Bound gp)) = NEq (Bound gp)
  59.597 +  | minusinf (NEq (Neg gt)) = NEq (Neg gt)
  59.598 +  | minusinf (NEq (Add (gu, gv))) = NEq (Add (gu, gv))
  59.599 +  | minusinf (NEq (Sub (gw, gx))) = NEq (Sub (gw, gx))
  59.600 +  | minusinf (NEq (Mul (gy, gz))) = NEq (Mul (gy, gz))
  59.601 +  | minusinf (Dvd (aa, ab)) = Dvd (aa, ab)
  59.602 +  | minusinf (NDvd (ac, ad)) = NDvd (ac, ad)
  59.603 +  | minusinf (Not ae) = Not ae
  59.604 +  | minusinf (Imp (aj, ak)) = Imp (aj, ak)
  59.605 +  | minusinf (Iff (al, am)) = Iff (al, am)
  59.606 +  | minusinf (E an) = E an
  59.607 +  | minusinf (A ao) = A ao
  59.608 +  | minusinf (Closed ap) = Closed ap
  59.609 +  | minusinf (NClosed aq) = NClosed aq
  59.610 +  | minusinf (Lt (Cn (cm, c, e))) =
  59.611 +    (if equal_nat cm zero_nat then T
  59.612 +      else Lt (Cn (suc (minus_nat cm (nat_of_integer (1 : IntInf.int))), c, e)))
  59.613 +  | minusinf (Le (Cn (dm, c, e))) =
  59.614 +    (if equal_nat dm zero_nat then T
  59.615 +      else Le (Cn (suc (minus_nat dm (nat_of_integer (1 : IntInf.int))), c, e)))
  59.616 +  | minusinf (Gt (Cn (em, c, e))) =
  59.617 +    (if equal_nat em zero_nat then F
  59.618 +      else Gt (Cn (suc (minus_nat em (nat_of_integer (1 : IntInf.int))), c, e)))
  59.619 +  | minusinf (Ge (Cn (fm, c, e))) =
  59.620 +    (if equal_nat fm zero_nat then F
  59.621 +      else Ge (Cn (suc (minus_nat fm (nat_of_integer (1 : IntInf.int))), c, e)))
  59.622 +  | minusinf (Eq (Cn (gm, c, e))) =
  59.623 +    (if equal_nat gm zero_nat then F
  59.624 +      else Eq (Cn (suc (minus_nat gm (nat_of_integer (1 : IntInf.int))), c, e)))
  59.625 +  | minusinf (NEq (Cn (hm, c, e))) =
  59.626 +    (if equal_nat hm zero_nat then T
  59.627 +      else NEq (Cn (suc (minus_nat hm (nat_of_integer (1 : IntInf.int))), c,
  59.628 +                     e)));
  59.629 +
  59.630 +fun numsubst0 t (C c) = C c
  59.631 +  | numsubst0 t (Bound n) = (if equal_nat n zero_nat then t else Bound n)
  59.632 +  | numsubst0 t (Neg a) = Neg (numsubst0 t a)
  59.633 +  | numsubst0 t (Add (a, b)) = Add (numsubst0 t a, numsubst0 t b)
  59.634 +  | numsubst0 t (Sub (a, b)) = Sub (numsubst0 t a, numsubst0 t b)
  59.635 +  | numsubst0 t (Mul (i, a)) = Mul (i, numsubst0 t a)
  59.636 +  | numsubst0 t (Cn (v, i, a)) =
  59.637 +    (if equal_nat v zero_nat then Add (Mul (i, t), numsubst0 t a)
  59.638 +      else Cn (suc (minus_nat v (nat_of_integer (1 : IntInf.int))), i,
  59.639 +                numsubst0 t a));
  59.640 +
  59.641 +fun subst0 t T = T
  59.642 +  | subst0 t F = F
  59.643 +  | subst0 t (Lt a) = Lt (numsubst0 t a)
  59.644 +  | subst0 t (Le a) = Le (numsubst0 t a)
  59.645 +  | subst0 t (Gt a) = Gt (numsubst0 t a)
  59.646 +  | subst0 t (Ge a) = Ge (numsubst0 t a)
  59.647 +  | subst0 t (Eq a) = Eq (numsubst0 t a)
  59.648 +  | subst0 t (NEq a) = NEq (numsubst0 t a)
  59.649 +  | subst0 t (Dvd (i, a)) = Dvd (i, numsubst0 t a)
  59.650 +  | subst0 t (NDvd (i, a)) = NDvd (i, numsubst0 t a)
  59.651 +  | subst0 t (Not p) = Not (subst0 t p)
  59.652 +  | subst0 t (And (p, q)) = And (subst0 t p, subst0 t q)
  59.653 +  | subst0 t (Or (p, q)) = Or (subst0 t p, subst0 t q)
  59.654 +  | subst0 t (Imp (p, q)) = Imp (subst0 t p, subst0 t q)
  59.655 +  | subst0 t (Iff (p, q)) = Iff (subst0 t p, subst0 t q)
  59.656 +  | subst0 t (Closed p) = Closed p
  59.657 +  | subst0 t (NClosed p) = NClosed p;
  59.658 +
  59.659 +type 'a plus = {plus : 'a -> 'a -> 'a};
  59.660 +val plus = #plus : 'a plus -> 'a -> 'a -> 'a;
  59.661 +
  59.662 +type 'a semigroup_add = {plus_semigroup_add : 'a plus};
  59.663 +val plus_semigroup_add = #plus_semigroup_add : 'a semigroup_add -> 'a plus;
  59.664 +
  59.665 +type 'a cancel_semigroup_add =
  59.666 +  {semigroup_add_cancel_semigroup_add : 'a semigroup_add};
  59.667 +val semigroup_add_cancel_semigroup_add = #semigroup_add_cancel_semigroup_add :
  59.668 +  'a cancel_semigroup_add -> 'a semigroup_add;
  59.669 +
  59.670 +type 'a ab_semigroup_add = {semigroup_add_ab_semigroup_add : 'a semigroup_add};
  59.671 +val semigroup_add_ab_semigroup_add = #semigroup_add_ab_semigroup_add :
  59.672 +  'a ab_semigroup_add -> 'a semigroup_add;
  59.673 +
  59.674 +type 'a cancel_ab_semigroup_add =
  59.675 +  {ab_semigroup_add_cancel_ab_semigroup_add : 'a ab_semigroup_add,
  59.676 +    cancel_semigroup_add_cancel_ab_semigroup_add : 'a cancel_semigroup_add};
  59.677 +val ab_semigroup_add_cancel_ab_semigroup_add =
  59.678 +  #ab_semigroup_add_cancel_ab_semigroup_add :
  59.679 +  'a cancel_ab_semigroup_add -> 'a ab_semigroup_add;
  59.680 +val cancel_semigroup_add_cancel_ab_semigroup_add =
  59.681 +  #cancel_semigroup_add_cancel_ab_semigroup_add :
  59.682 +  'a cancel_ab_semigroup_add -> 'a cancel_semigroup_add;
  59.683 +
  59.684 +type 'a zero = {zero : 'a};
  59.685 +val zero = #zero : 'a zero -> 'a;
  59.686 +
  59.687 +type 'a monoid_add =
  59.688 +  {semigroup_add_monoid_add : 'a semigroup_add, zero_monoid_add : 'a zero};
  59.689 +val semigroup_add_monoid_add = #semigroup_add_monoid_add :
  59.690 +  'a monoid_add -> 'a semigroup_add;
  59.691 +val zero_monoid_add = #zero_monoid_add : 'a monoid_add -> 'a zero;
  59.692 +
  59.693 +type 'a comm_monoid_add =
  59.694 +  {ab_semigroup_add_comm_monoid_add : 'a ab_semigroup_add,
  59.695 +    monoid_add_comm_monoid_add : 'a monoid_add};
  59.696 +val ab_semigroup_add_comm_monoid_add = #ab_semigroup_add_comm_monoid_add :
  59.697 +  'a comm_monoid_add -> 'a ab_semigroup_add;
  59.698 +val monoid_add_comm_monoid_add = #monoid_add_comm_monoid_add :
  59.699 +  'a comm_monoid_add -> 'a monoid_add;
  59.700 +
  59.701 +type 'a cancel_comm_monoid_add =
  59.702 +  {cancel_ab_semigroup_add_cancel_comm_monoid_add : 'a cancel_ab_semigroup_add,
  59.703 +    comm_monoid_add_cancel_comm_monoid_add : 'a comm_monoid_add};
  59.704 +val cancel_ab_semigroup_add_cancel_comm_monoid_add =
  59.705 +  #cancel_ab_semigroup_add_cancel_comm_monoid_add :
  59.706 +  'a cancel_comm_monoid_add -> 'a cancel_ab_semigroup_add;
  59.707 +val comm_monoid_add_cancel_comm_monoid_add =
  59.708 +  #comm_monoid_add_cancel_comm_monoid_add :
  59.709 +  'a cancel_comm_monoid_add -> 'a comm_monoid_add;
  59.710 +
  59.711 +type 'a times = {times : 'a -> 'a -> 'a};
  59.712 +val times = #times : 'a times -> 'a -> 'a -> 'a;
  59.713 +
  59.714 +type 'a mult_zero = {times_mult_zero : 'a times, zero_mult_zero : 'a zero};
  59.715 +val times_mult_zero = #times_mult_zero : 'a mult_zero -> 'a times;
  59.716 +val zero_mult_zero = #zero_mult_zero : 'a mult_zero -> 'a zero;
  59.717 +
  59.718 +type 'a semigroup_mult = {times_semigroup_mult : 'a times};
  59.719 +val times_semigroup_mult = #times_semigroup_mult :
  59.720 +  'a semigroup_mult -> 'a times;
  59.721 +
  59.722 +type 'a semiring =
  59.723 +  {ab_semigroup_add_semiring : 'a ab_semigroup_add,
  59.724 +    semigroup_mult_semiring : 'a semigroup_mult};
  59.725 +val ab_semigroup_add_semiring = #ab_semigroup_add_semiring :
  59.726 +  'a semiring -> 'a ab_semigroup_add;
  59.727 +val semigroup_mult_semiring = #semigroup_mult_semiring :
  59.728 +  'a semiring -> 'a semigroup_mult;
  59.729 +
  59.730 +type 'a semiring_0 =
  59.731 +  {comm_monoid_add_semiring_0 : 'a comm_monoid_add,
  59.732 +    mult_zero_semiring_0 : 'a mult_zero, semiring_semiring_0 : 'a semiring};
  59.733 +val comm_monoid_add_semiring_0 = #comm_monoid_add_semiring_0 :
  59.734 +  'a semiring_0 -> 'a comm_monoid_add;
  59.735 +val mult_zero_semiring_0 = #mult_zero_semiring_0 :
  59.736 +  'a semiring_0 -> 'a mult_zero;
  59.737 +val semiring_semiring_0 = #semiring_semiring_0 : 'a semiring_0 -> 'a semiring;
  59.738 +
  59.739 +type 'a semiring_0_cancel =
  59.740 +  {cancel_comm_monoid_add_semiring_0_cancel : 'a cancel_comm_monoid_add,
  59.741 +    semiring_0_semiring_0_cancel : 'a semiring_0};
  59.742 +val cancel_comm_monoid_add_semiring_0_cancel =
  59.743 +  #cancel_comm_monoid_add_semiring_0_cancel :
  59.744 +  'a semiring_0_cancel -> 'a cancel_comm_monoid_add;
  59.745 +val semiring_0_semiring_0_cancel = #semiring_0_semiring_0_cancel :
  59.746 +  'a semiring_0_cancel -> 'a semiring_0;
  59.747 +
  59.748 +type 'a ab_semigroup_mult =
  59.749 +  {semigroup_mult_ab_semigroup_mult : 'a semigroup_mult};
  59.750 +val semigroup_mult_ab_semigroup_mult = #semigroup_mult_ab_semigroup_mult :
  59.751 +  'a ab_semigroup_mult -> 'a semigroup_mult;
  59.752 +
  59.753 +type 'a comm_semiring =
  59.754 +  {ab_semigroup_mult_comm_semiring : 'a ab_semigroup_mult,
  59.755 +    semiring_comm_semiring : 'a semiring};
  59.756 +val ab_semigroup_mult_comm_semiring = #ab_semigroup_mult_comm_semiring :
  59.757 +  'a comm_semiring -> 'a ab_semigroup_mult;
  59.758 +val semiring_comm_semiring = #semiring_comm_semiring :
  59.759 +  'a comm_semiring -> 'a semiring;
  59.760 +
  59.761 +type 'a comm_semiring_0 =
  59.762 +  {comm_semiring_comm_semiring_0 : 'a comm_semiring,
  59.763 +    semiring_0_comm_semiring_0 : 'a semiring_0};
  59.764 +val comm_semiring_comm_semiring_0 = #comm_semiring_comm_semiring_0 :
  59.765 +  'a comm_semiring_0 -> 'a comm_semiring;
  59.766 +val semiring_0_comm_semiring_0 = #semiring_0_comm_semiring_0 :
  59.767 +  'a comm_semiring_0 -> 'a semiring_0;
  59.768 +
  59.769 +type 'a comm_semiring_0_cancel =
  59.770 +  {comm_semiring_0_comm_semiring_0_cancel : 'a comm_semiring_0,
  59.771 +    semiring_0_cancel_comm_semiring_0_cancel : 'a semiring_0_cancel};
  59.772 +val comm_semiring_0_comm_semiring_0_cancel =
  59.773 +  #comm_semiring_0_comm_semiring_0_cancel :
  59.774 +  'a comm_semiring_0_cancel -> 'a comm_semiring_0;
  59.775 +val semiring_0_cancel_comm_semiring_0_cancel =
  59.776 +  #semiring_0_cancel_comm_semiring_0_cancel :
  59.777 +  'a comm_semiring_0_cancel -> 'a semiring_0_cancel;
  59.778 +
  59.779 +type 'a one = {one : 'a};
  59.780 +val one = #one : 'a one -> 'a;
  59.781 +
  59.782 +type 'a power = {one_power : 'a one, times_power : 'a times};
  59.783 +val one_power = #one_power : 'a power -> 'a one;
  59.784 +val times_power = #times_power : 'a power -> 'a times;
  59.785 +
  59.786 +type 'a monoid_mult =
  59.787 +  {semigroup_mult_monoid_mult : 'a semigroup_mult,
  59.788 +    power_monoid_mult : 'a power};
  59.789 +val semigroup_mult_monoid_mult = #semigroup_mult_monoid_mult :
  59.790 +  'a monoid_mult -> 'a semigroup_mult;
  59.791 +val power_monoid_mult = #power_monoid_mult : 'a monoid_mult -> 'a power;
  59.792 +
  59.793 +type 'a numeral =
  59.794 +  {one_numeral : 'a one, semigroup_add_numeral : 'a semigroup_add};
  59.795 +val one_numeral = #one_numeral : 'a numeral -> 'a one;
  59.796 +val semigroup_add_numeral = #semigroup_add_numeral :
  59.797 +  'a numeral -> 'a semigroup_add;
  59.798 +
  59.799 +type 'a semiring_numeral =
  59.800 +  {monoid_mult_semiring_numeral : 'a monoid_mult,
  59.801 +    numeral_semiring_numeral : 'a numeral,
  59.802 +    semiring_semiring_numeral : 'a semiring};
  59.803 +val monoid_mult_semiring_numeral = #monoid_mult_semiring_numeral :
  59.804 +  'a semiring_numeral -> 'a monoid_mult;
  59.805 +val numeral_semiring_numeral = #numeral_semiring_numeral :
  59.806 +  'a semiring_numeral -> 'a numeral;
  59.807 +val semiring_semiring_numeral = #semiring_semiring_numeral :
  59.808 +  'a semiring_numeral -> 'a semiring;
  59.809 +
  59.810 +type 'a zero_neq_one = {one_zero_neq_one : 'a one, zero_zero_neq_one : 'a zero};
  59.811 +val one_zero_neq_one = #one_zero_neq_one : 'a zero_neq_one -> 'a one;
  59.812 +val zero_zero_neq_one = #zero_zero_neq_one : 'a zero_neq_one -> 'a zero;
  59.813 +
  59.814 +type 'a semiring_1 =
  59.815 +  {semiring_numeral_semiring_1 : 'a semiring_numeral,
  59.816 +    semiring_0_semiring_1 : 'a semiring_0,
  59.817 +    zero_neq_one_semiring_1 : 'a zero_neq_one};
  59.818 +val semiring_numeral_semiring_1 = #semiring_numeral_semiring_1 :
  59.819 +  'a semiring_1 -> 'a semiring_numeral;
  59.820 +val semiring_0_semiring_1 = #semiring_0_semiring_1 :
  59.821 +  'a semiring_1 -> 'a semiring_0;
  59.822 +val zero_neq_one_semiring_1 = #zero_neq_one_semiring_1 :
  59.823 +  'a semiring_1 -> 'a zero_neq_one;
  59.824 +
  59.825 +type 'a semiring_1_cancel =
  59.826 +  {semiring_0_cancel_semiring_1_cancel : 'a semiring_0_cancel,
  59.827 +    semiring_1_semiring_1_cancel : 'a semiring_1};
  59.828 +val semiring_0_cancel_semiring_1_cancel = #semiring_0_cancel_semiring_1_cancel :
  59.829 +  'a semiring_1_cancel -> 'a semiring_0_cancel;
  59.830 +val semiring_1_semiring_1_cancel = #semiring_1_semiring_1_cancel :
  59.831 +  'a semiring_1_cancel -> 'a semiring_1;
  59.832 +
  59.833 +type 'a comm_monoid_mult =
  59.834 +  {ab_semigroup_mult_comm_monoid_mult : 'a ab_semigroup_mult,
  59.835 +    monoid_mult_comm_monoid_mult : 'a monoid_mult};
  59.836 +val ab_semigroup_mult_comm_monoid_mult = #ab_semigroup_mult_comm_monoid_mult :
  59.837 +  'a comm_monoid_mult -> 'a ab_semigroup_mult;
  59.838 +val monoid_mult_comm_monoid_mult = #monoid_mult_comm_monoid_mult :
  59.839 +  'a comm_monoid_mult -> 'a monoid_mult;
  59.840 +
  59.841 +type 'a dvd = {times_dvd : 'a times};
  59.842 +val times_dvd = #times_dvd : 'a dvd -> 'a times;
  59.843 +
  59.844 +type 'a comm_semiring_1 =
  59.845 +  {comm_monoid_mult_comm_semiring_1 : 'a comm_monoid_mult,
  59.846 +    comm_semiring_0_comm_semiring_1 : 'a comm_semiring_0,
  59.847 +    dvd_comm_semiring_1 : 'a dvd, semiring_1_comm_semiring_1 : 'a semiring_1};
  59.848 +val comm_monoid_mult_comm_semiring_1 = #comm_monoid_mult_comm_semiring_1 :
  59.849 +  'a comm_semiring_1 -> 'a comm_monoid_mult;
  59.850 +val comm_semiring_0_comm_semiring_1 = #comm_semiring_0_comm_semiring_1 :
  59.851 +  'a comm_semiring_1 -> 'a comm_semiring_0;
  59.852 +val dvd_comm_semiring_1 = #dvd_comm_semiring_1 : 'a comm_semiring_1 -> 'a dvd;
  59.853 +val semiring_1_comm_semiring_1 = #semiring_1_comm_semiring_1 :
  59.854 +  'a comm_semiring_1 -> 'a semiring_1;
  59.855 +
  59.856 +type 'a comm_semiring_1_cancel =
  59.857 +  {comm_semiring_0_cancel_comm_semiring_1_cancel : 'a comm_semiring_0_cancel,
  59.858 +    comm_semiring_1_comm_semiring_1_cancel : 'a comm_semiring_1,
  59.859 +    semiring_1_cancel_comm_semiring_1_cancel : 'a semiring_1_cancel};
  59.860 +val comm_semiring_0_cancel_comm_semiring_1_cancel =
  59.861 +  #comm_semiring_0_cancel_comm_semiring_1_cancel :
  59.862 +  'a comm_semiring_1_cancel -> 'a comm_semiring_0_cancel;
  59.863 +val comm_semiring_1_comm_semiring_1_cancel =
  59.864 +  #comm_semiring_1_comm_semiring_1_cancel :
  59.865 +  'a comm_semiring_1_cancel -> 'a comm_semiring_1;
  59.866 +val semiring_1_cancel_comm_semiring_1_cancel =
  59.867 +  #semiring_1_cancel_comm_semiring_1_cancel :
  59.868 +  'a comm_semiring_1_cancel -> 'a semiring_1_cancel;
  59.869 +
  59.870 +type 'a no_zero_divisors =
  59.871 +  {times_no_zero_divisors : 'a times, zero_no_zero_divisors : 'a zero};
  59.872 +val times_no_zero_divisors = #times_no_zero_divisors :
  59.873 +  'a no_zero_divisors -> 'a times;
  59.874 +val zero_no_zero_divisors = #zero_no_zero_divisors :
  59.875 +  'a no_zero_divisors -> 'a zero;
  59.876 +
  59.877 +type 'a diva = {dvd_div : 'a dvd, diva : 'a -> 'a -> 'a, moda : 'a -> 'a -> 'a};
  59.878 +val dvd_div = #dvd_div : 'a diva -> 'a dvd;
  59.879 +val diva = #diva : 'a diva -> 'a -> 'a -> 'a;
  59.880 +val moda = #moda : 'a diva -> 'a -> 'a -> 'a;
  59.881 +
  59.882 +type 'a semiring_div =
  59.883 +  {div_semiring_div : 'a diva,
  59.884 +    comm_semiring_1_cancel_semiring_div : 'a comm_semiring_1_cancel,
  59.885 +    no_zero_divisors_semiring_div : 'a no_zero_divisors};
  59.886 +val div_semiring_div = #div_semiring_div : 'a semiring_div -> 'a diva;
  59.887 +val comm_semiring_1_cancel_semiring_div = #comm_semiring_1_cancel_semiring_div :
  59.888 +  'a semiring_div -> 'a comm_semiring_1_cancel;
  59.889 +val no_zero_divisors_semiring_div = #no_zero_divisors_semiring_div :
  59.890 +  'a semiring_div -> 'a no_zero_divisors;
  59.891 +
  59.892 +fun plus_inta k l = Int_of_integer (integer_of_int k + integer_of_int l);
  59.893 +
  59.894 +val plus_int = {plus = plus_inta} : inta plus;
  59.895 +
  59.896 +val semigroup_add_int = {plus_semigroup_add = plus_int} : inta semigroup_add;
  59.897 +
  59.898 +val cancel_semigroup_add_int =
  59.899 +  {semigroup_add_cancel_semigroup_add = semigroup_add_int} :
  59.900 +  inta cancel_semigroup_add;
  59.901 +
  59.902 +val ab_semigroup_add_int = {semigroup_add_ab_semigroup_add = semigroup_add_int}
  59.903 +  : inta ab_semigroup_add;
  59.904 +
  59.905 +val cancel_ab_semigroup_add_int =
  59.906 +  {ab_semigroup_add_cancel_ab_semigroup_add = ab_semigroup_add_int,
  59.907 +    cancel_semigroup_add_cancel_ab_semigroup_add = cancel_semigroup_add_int}
  59.908 +  : inta cancel_ab_semigroup_add;
  59.909 +
  59.910 +val zero_inta : inta = Int_of_integer 0;
  59.911 +
  59.912 +val zero_int = {zero = zero_inta} : inta zero;
  59.913 +
  59.914 +val monoid_add_int =
  59.915 +  {semigroup_add_monoid_add = semigroup_add_int, zero_monoid_add = zero_int} :
  59.916 +  inta monoid_add;
  59.917 +
  59.918 +val comm_monoid_add_int =
  59.919 +  {ab_semigroup_add_comm_monoid_add = ab_semigroup_add_int,
  59.920 +    monoid_add_comm_monoid_add = monoid_add_int}
  59.921 +  : inta comm_monoid_add;
  59.922 +
  59.923 +val cancel_comm_monoid_add_int =
  59.924 +  {cancel_ab_semigroup_add_cancel_comm_monoid_add = cancel_ab_semigroup_add_int,
  59.925 +    comm_monoid_add_cancel_comm_monoid_add = comm_monoid_add_int}
  59.926 +  : inta cancel_comm_monoid_add;
  59.927 +
  59.928 +fun times_inta k l = Int_of_integer (integer_of_int k * integer_of_int l);
  59.929 +
  59.930 +val times_int = {times = times_inta} : inta times;
  59.931 +
  59.932 +val mult_zero_int = {times_mult_zero = times_int, zero_mult_zero = zero_int} :
  59.933 +  inta mult_zero;
  59.934 +
  59.935 +val semigroup_mult_int = {times_semigroup_mult = times_int} :
  59.936 +  inta semigroup_mult;
  59.937 +
  59.938 +val semiring_int =
  59.939 +  {ab_semigroup_add_semiring = ab_semigroup_add_int,
  59.940 +    semigroup_mult_semiring = semigroup_mult_int}
  59.941 +  : inta semiring;
  59.942 +
  59.943 +val semiring_0_int =
  59.944 +  {comm_monoid_add_semiring_0 = comm_monoid_add_int,
  59.945 +    mult_zero_semiring_0 = mult_zero_int, semiring_semiring_0 = semiring_int}
  59.946 +  : inta semiring_0;
  59.947 +
  59.948 +val semiring_0_cancel_int =
  59.949 +  {cancel_comm_monoid_add_semiring_0_cancel = cancel_comm_monoid_add_int,
  59.950 +    semiring_0_semiring_0_cancel = semiring_0_int}
  59.951 +  : inta semiring_0_cancel;
  59.952 +
  59.953 +val ab_semigroup_mult_int =
  59.954 +  {semigroup_mult_ab_semigroup_mult = semigroup_mult_int} :
  59.955 +  inta ab_semigroup_mult;
  59.956 +
  59.957 +val comm_semiring_int =
  59.958 +  {ab_semigroup_mult_comm_semiring = ab_semigroup_mult_int,
  59.959 +    semiring_comm_semiring = semiring_int}
  59.960 +  : inta comm_semiring;
  59.961 +
  59.962 +val comm_semiring_0_int =
  59.963 +  {comm_semiring_comm_semiring_0 = comm_semiring_int,
  59.964 +    semiring_0_comm_semiring_0 = semiring_0_int}
  59.965 +  : inta comm_semiring_0;
  59.966 +
  59.967 +val comm_semiring_0_cancel_int =
  59.968 +  {comm_semiring_0_comm_semiring_0_cancel = comm_semiring_0_int,
  59.969 +    semiring_0_cancel_comm_semiring_0_cancel = semiring_0_cancel_int}
  59.970 +  : inta comm_semiring_0_cancel;
  59.971 +
  59.972 +val one_inta : inta = Int_of_integer (1 : IntInf.int);
  59.973 +
  59.974 +val one_int = {one = one_inta} : inta one;
  59.975 +
  59.976 +val power_int = {one_power = one_int, times_power = times_int} : inta power;
  59.977 +
  59.978 +val monoid_mult_int =
  59.979 +  {semigroup_mult_monoid_mult = semigroup_mult_int,
  59.980 +    power_monoid_mult = power_int}
  59.981 +  : inta monoid_mult;
  59.982 +
  59.983 +val numeral_int =
  59.984 +  {one_numeral = one_int, semigroup_add_numeral = semigroup_add_int} :
  59.985 +  inta numeral;
  59.986 +
  59.987 +val semiring_numeral_int =
  59.988 +  {monoid_mult_semiring_numeral = monoid_mult_int,
  59.989 +    numeral_semiring_numeral = numeral_int,
  59.990 +    semiring_semiring_numeral = semiring_int}
  59.991 +  : inta semiring_numeral;
  59.992 +
  59.993 +val zero_neq_one_int =
  59.994 +  {one_zero_neq_one = one_int, zero_zero_neq_one = zero_int} :
  59.995 +  inta zero_neq_one;
  59.996 +
  59.997 +val semiring_1_int =
  59.998 +  {semiring_numeral_semiring_1 = semiring_numeral_int,
  59.999 +    semiring_0_semiring_1 = semiring_0_int,
 59.1000 +    zero_neq_one_semiring_1 = zero_neq_one_int}
 59.1001 +  : inta semiring_1;
 59.1002 +
 59.1003 +val semiring_1_cancel_int =
 59.1004 +  {semiring_0_cancel_semiring_1_cancel = semiring_0_cancel_int,
 59.1005 +    semiring_1_semiring_1_cancel = semiring_1_int}
 59.1006 +  : inta semiring_1_cancel;
 59.1007 +
 59.1008 +val comm_monoid_mult_int =
 59.1009 +  {ab_semigroup_mult_comm_monoid_mult = ab_semigroup_mult_int,
 59.1010 +    monoid_mult_comm_monoid_mult = monoid_mult_int}
 59.1011 +  : inta comm_monoid_mult;
 59.1012 +
 59.1013 +val dvd_int = {times_dvd = times_int} : inta dvd;
 59.1014 +
 59.1015 +val comm_semiring_1_int =
 59.1016 +  {comm_monoid_mult_comm_semiring_1 = comm_monoid_mult_int,
 59.1017 +    comm_semiring_0_comm_semiring_1 = comm_semiring_0_int,
 59.1018 +    dvd_comm_semiring_1 = dvd_int, semiring_1_comm_semiring_1 = semiring_1_int}
 59.1019 +  : inta comm_semiring_1;
 59.1020 +
 59.1021 +val comm_semiring_1_cancel_int =
 59.1022 +  {comm_semiring_0_cancel_comm_semiring_1_cancel = comm_semiring_0_cancel_int,
 59.1023 +    comm_semiring_1_comm_semiring_1_cancel = comm_semiring_1_int,
 59.1024 +    semiring_1_cancel_comm_semiring_1_cancel = semiring_1_cancel_int}
 59.1025 +  : inta comm_semiring_1_cancel;
 59.1026 +
 59.1027 +val no_zero_divisors_int =
 59.1028 +  {times_no_zero_divisors = times_int, zero_no_zero_divisors = zero_int} :
 59.1029 +  inta no_zero_divisors;
 59.1030 +
 59.1031 +fun sgn_integer k =
 59.1032 +  (if k = 0 then 0
 59.1033 +    else (if k < 0 then ~ (1 : IntInf.int) else (1 : IntInf.int)));
 59.1034 +
 59.1035 +fun abs_integer k = (if k < 0 then ~ k else k);
 59.1036 +
 59.1037 +fun apsnd f (x, y) = (x, f y);
 59.1038 +
 59.1039 +fun divmod_integer k l =
 59.1040 +  (if k = 0 then (0, 0)
 59.1041 +    else (if l = 0 then (0, k)
 59.1042 +           else (apsnd o (fn a => fn b => a * b) o sgn_integer) l
 59.1043 +                  (if sgn_integer k = sgn_integer l
 59.1044 +                    then Integer.div_mod (abs k) (abs l)
 59.1045 +                    else let
 59.1046 +                           val (r, s) = Integer.div_mod (abs k) (abs l);
 59.1047 +                         in
 59.1048 +                           (if s = 0 then (~ r, 0)
 59.1049 +                             else (~ r - (1 : IntInf.int), abs_integer l - s))
 59.1050 +                         end)));
 59.1051 +
 59.1052 +fun snd (a, b) = b;
 59.1053 +
 59.1054 +fun mod_integer k l = snd (divmod_integer k l);
 59.1055 +
 59.1056 +fun mod_int k l =
 59.1057 +  Int_of_integer (mod_integer (integer_of_int k) (integer_of_int l));
 59.1058 +
 59.1059 +fun fst (a, b) = a;
 59.1060 +
 59.1061 +fun div_integer k l = fst (divmod_integer k l);
 59.1062 +
 59.1063 +fun div_inta k l =
 59.1064 +  Int_of_integer (div_integer (integer_of_int k) (integer_of_int l));
 59.1065 +
 59.1066 +val div_int = {dvd_div = dvd_int, diva = div_inta, moda = mod_int} : inta diva;
 59.1067 +
 59.1068 +val semiring_div_int =
 59.1069 +  {div_semiring_div = div_int,
 59.1070 +    comm_semiring_1_cancel_semiring_div = comm_semiring_1_cancel_int,
 59.1071 +    no_zero_divisors_semiring_div = no_zero_divisors_int}
 59.1072 +  : inta semiring_div;
 59.1073 +
 59.1074 +fun less_eq_int k l = integer_of_int k <= integer_of_int l;
 59.1075 +
 59.1076 +fun uminus_int k = Int_of_integer (~ (integer_of_int k));
 59.1077 +
 59.1078 +fun nummul i (C j) = C (times_inta i j)
 59.1079 +  | nummul i (Cn (n, c, t)) = Cn (n, times_inta c i, nummul i t)
 59.1080 +  | nummul i (Bound v) = Mul (i, Bound v)
 59.1081 +  | nummul i (Neg v) = Mul (i, Neg v)
 59.1082 +  | nummul i (Add (v, va)) = Mul (i, Add (v, va))
 59.1083 +  | nummul i (Sub (v, va)) = Mul (i, Sub (v, va))
 59.1084 +  | nummul i (Mul (v, va)) = Mul (i, Mul (v, va));
 59.1085 +
 59.1086 +fun numneg t = nummul (uminus_int (Int_of_integer (1 : IntInf.int))) t;
 59.1087 +
 59.1088 +fun less_eq_nat m n = integer_of_nat m <= integer_of_nat n;
 59.1089 +
 59.1090 +fun numadd (Cn (n1, c1, r1), Cn (n2, c2, r2)) =
 59.1091 +  (if equal_nat n1 n2
 59.1092 +    then let
 59.1093 +           val c = plus_inta c1 c2;
 59.1094 +         in
 59.1095 +           (if equal_inta c zero_inta then numadd (r1, r2)
 59.1096 +             else Cn (n1, c, numadd (r1, r2)))
 59.1097 +         end
 59.1098 +    else (if less_eq_nat n1 n2
 59.1099 +           then Cn (n1, c1, numadd (r1, Add (Mul (c2, Bound n2), r2)))
 59.1100 +           else Cn (n2, c2, numadd (Add (Mul (c1, Bound n1), r1), r2))))
 59.1101 +  | numadd (Cn (n1, c1, r1), C dd) = Cn (n1, c1, numadd (r1, C dd))
 59.1102 +  | numadd (Cn (n1, c1, r1), Bound de) = Cn (n1, c1, numadd (r1, Bound de))
 59.1103 +  | numadd (Cn (n1, c1, r1), Neg di) = Cn (n1, c1, numadd (r1, Neg di))
 59.1104 +  | numadd (Cn (n1, c1, r1), Add (dj, dk)) =
 59.1105 +    Cn (n1, c1, numadd (r1, Add (dj, dk)))
 59.1106 +  | numadd (Cn (n1, c1, r1), Sub (dl, dm)) =
 59.1107 +    Cn (n1, c1, numadd (r1, Sub (dl, dm)))
 59.1108 +  | numadd (Cn (n1, c1, r1), Mul (dn, doa)) =
 59.1109 +    Cn (n1, c1, numadd (r1, Mul (dn, doa)))
 59.1110 +  | numadd (C w, Cn (n2, c2, r2)) = Cn (n2, c2, numadd (C w, r2))
 59.1111 +  | numadd (Bound x, Cn (n2, c2, r2)) = Cn (n2, c2, numadd (Bound x, r2))
 59.1112 +  | numadd (Neg ac, Cn (n2, c2, r2)) = Cn (n2, c2, numadd (Neg ac, r2))
 59.1113 +  | numadd (Add (ad, ae), Cn (n2, c2, r2)) =
 59.1114 +    Cn (n2, c2, numadd (Add (ad, ae), r2))
 59.1115 +  | numadd (Sub (af, ag), Cn (n2, c2, r2)) =
 59.1116 +    Cn (n2, c2, numadd (Sub (af, ag), r2))
 59.1117 +  | numadd (Mul (ah, ai), Cn (n2, c2, r2)) =
 59.1118 +    Cn (n2, c2, numadd (Mul (ah, ai), r2))
 59.1119 +  | numadd (C b1, C b2) = C (plus_inta b1 b2)
 59.1120 +  | numadd (C aj, Bound bi) = Add (C aj, Bound bi)
 59.1121 +  | numadd (C aj, Neg bm) = Add (C aj, Neg bm)
 59.1122 +  | numadd (C aj, Add (bn, bo)) = Add (C aj, Add (bn, bo))
 59.1123 +  | numadd (C aj, Sub (bp, bq)) = Add (C aj, Sub (bp, bq))
 59.1124 +  | numadd (C aj, Mul (br, bs)) = Add (C aj, Mul (br, bs))
 59.1125 +  | numadd (Bound ak, C cf) = Add (Bound ak, C cf)
 59.1126 +  | numadd (Bound ak, Bound cg) = Add (Bound ak, Bound cg)
 59.1127 +  | numadd (Bound ak, Neg ck) = Add (Bound ak, Neg ck)
 59.1128 +  | numadd (Bound ak, Add (cl, cm)) = Add (Bound ak, Add (cl, cm))
 59.1129 +  | numadd (Bound ak, Sub (cn, co)) = Add (Bound ak, Sub (cn, co))
 59.1130 +  | numadd (Bound ak, Mul (cp, cq)) = Add (Bound ak, Mul (cp, cq))
 59.1131 +  | numadd (Neg ao, C en) = Add (Neg ao, C en)
 59.1132 +  | numadd (Neg ao, Bound eo) = Add (Neg ao, Bound eo)
 59.1133 +  | numadd (Neg ao, Neg et) = Add (Neg ao, Neg et)
 59.1134 +  | numadd (Neg ao, Add (eu, ev)) = Add (Neg ao, Add (eu, ev))
 59.1135 +  | numadd (Neg ao, Sub (ew, ex)) = Add (Neg ao, Sub (ew, ex))
 59.1136 +  | numadd (Neg ao, Mul (ey, ez)) = Add (Neg ao, Mul (ey, ez))
 59.1137 +  | numadd (Add (ap, aq), C fm) = Add (Add (ap, aq), C fm)
 59.1138 +  | numadd (Add (ap, aq), Bound fna) = Add (Add (ap, aq), Bound fna)
 59.1139 +  | numadd (Add (ap, aq), Neg fr) = Add (Add (ap, aq), Neg fr)
 59.1140 +  | numadd (Add (ap, aq), Add (fs, ft)) = Add (Add (ap, aq), Add (fs, ft))
 59.1141 +  | numadd (Add (ap, aq), Sub (fu, fv)) = Add (Add (ap, aq), Sub (fu, fv))
 59.1142 +  | numadd (Add (ap, aq), Mul (fw, fx)) = Add (Add (ap, aq), Mul (fw, fx))
 59.1143 +  | numadd (Sub (ar, asa), C gk) = Add (Sub (ar, asa), C gk)
 59.1144 +  | numadd (Sub (ar, asa), Bound gl) = Add (Sub (ar, asa), Bound gl)
 59.1145 +  | numadd (Sub (ar, asa), Neg gp) = Add (Sub (ar, asa), Neg gp)
 59.1146 +  | numadd (Sub (ar, asa), Add (gq, gr)) = Add (Sub (ar, asa), Add (gq, gr))
 59.1147 +  | numadd (Sub (ar, asa), Sub (gs, gt)) = Add (Sub (ar, asa), Sub (gs, gt))
 59.1148 +  | numadd (Sub (ar, asa), Mul (gu, gv)) = Add (Sub (ar, asa), Mul (gu, gv))
 59.1149 +  | numadd (Mul (at, au), C hi) = Add (Mul (at, au), C hi)
 59.1150 +  | numadd (Mul (at, au), Bound hj) = Add (Mul (at, au), Bound hj)
 59.1151 +  | numadd (Mul (at, au), Neg hn) = Add (Mul (at, au), Neg hn)
 59.1152 +  | numadd (Mul (at, au), Add (ho, hp)) = Add (Mul (at, au), Add (ho, hp))
 59.1153 +  | numadd (Mul (at, au), Sub (hq, hr)) = Add (Mul (at, au), Sub (hq, hr))
 59.1154 +  | numadd (Mul (at, au), Mul (hs, ht)) = Add (Mul (at, au), Mul (hs, ht));
 59.1155 +
 59.1156 +fun numsub s t = (if equal_numa s t then C zero_inta else numadd (s, numneg t));
 59.1157 +
 59.1158 +fun simpnum (C j) = C j
 59.1159 +  | simpnum (Bound n) = Cn (n, Int_of_integer (1 : IntInf.int), C zero_inta)
 59.1160 +  | simpnum (Neg t) = numneg (simpnum t)
 59.1161 +  | simpnum (Add (t, s)) = numadd (simpnum t, simpnum s)
 59.1162 +  | simpnum (Sub (t, s)) = numsub (simpnum t) (simpnum s)
 59.1163 +  | simpnum (Mul (i, t)) =
 59.1164 +    (if equal_inta i zero_inta then C zero_inta else nummul i (simpnum t))
 59.1165 +  | simpnum (Cn (v, va, vb)) = Cn (v, va, vb);
 59.1166 +
 59.1167 +fun less_int k l = integer_of_int k < integer_of_int l;
 59.1168 +
 59.1169 +val equal_int = {equal = equal_inta} : inta equal;
 59.1170 +
 59.1171 +fun abs_int i = (if less_int i zero_inta then uminus_int i else i);
 59.1172 +
 59.1173 +fun nota (Not p) = p
 59.1174 +  | nota T = F
 59.1175 +  | nota F = T
 59.1176 +  | nota (Lt v) = Not (Lt v)
 59.1177 +  | nota (Le v) = Not (Le v)
 59.1178 +  | nota (Gt v) = Not (Gt v)
 59.1179 +  | nota (Ge v) = Not (Ge v)
 59.1180 +  | nota (Eq v) = Not (Eq v)
 59.1181 +  | nota (NEq v) = Not (NEq v)
 59.1182 +  | nota (Dvd (v, va)) = Not (Dvd (v, va))
 59.1183 +  | nota (NDvd (v, va)) = Not (NDvd (v, va))
 59.1184 +  | nota (And (v, va)) = Not (And (v, va))
 59.1185 +  | nota (Or (v, va)) = Not (Or (v, va))
 59.1186 +  | nota (Imp (v, va)) = Not (Imp (v, va))
 59.1187 +  | nota (Iff (v, va)) = Not (Iff (v, va))
 59.1188 +  | nota (E v) = Not (E v)
 59.1189 +  | nota (A v) = Not (A v)
 59.1190 +  | nota (Closed v) = Not (Closed v)
 59.1191 +  | nota (NClosed v) = Not (NClosed v);
 59.1192 +
 59.1193 +fun impa p q =
 59.1194 +  (if equal_fm p F orelse equal_fm q T then T
 59.1195 +    else (if equal_fm p T then q
 59.1196 +           else (if equal_fm q F then nota p else Imp (p, q))));
 59.1197 +
 59.1198 +fun iffa p q =
 59.1199 +  (if equal_fm p q then T
 59.1200 +    else (if equal_fm p (nota q) orelse equal_fm (nota p) q then F
 59.1201 +           else (if equal_fm p F then nota q
 59.1202 +                  else (if equal_fm q F then nota p
 59.1203 +                         else (if equal_fm p T then q
 59.1204 +                                else (if equal_fm q T then p
 59.1205 +                                       else Iff (p, q)))))));
 59.1206 +
 59.1207 +fun disj p q =
 59.1208 +  (if equal_fm p T orelse equal_fm q T then T
 59.1209 +    else (if equal_fm p F then q else (if equal_fm q F then p else Or (p, q))));
 59.1210 +
 59.1211 +fun conj p q =
 59.1212 +  (if equal_fm p F orelse equal_fm q F then F
 59.1213 +    else (if equal_fm p T then q
 59.1214 +           else (if equal_fm q T then p else And (p, q))));
 59.1215 +
 59.1216 +fun dvd (A1_, A2_) a b =
 59.1217 +  eq A2_ (moda (div_semiring_div A1_) b a)
 59.1218 +    (zero ((zero_mult_zero o mult_zero_semiring_0 o semiring_0_semiring_1 o
 59.1219 +             semiring_1_comm_semiring_1 o
 59.1220 +             comm_semiring_1_comm_semiring_1_cancel o
 59.1221 +             comm_semiring_1_cancel_semiring_div)
 59.1222 +            A1_));
 59.1223  
 59.1224 -fun dj f p = evaldjf f (disjuncts p);
 59.1225 +fun simpfm (And (p, q)) = conj (simpfm p) (simpfm q)
 59.1226 +  | simpfm (Or (p, q)) = disj (simpfm p) (simpfm q)
 59.1227 +  | simpfm (Imp (p, q)) = impa (simpfm p) (simpfm q)
 59.1228 +  | simpfm (Iff (p, q)) = iffa (simpfm p) (simpfm q)
 59.1229 +  | simpfm (Not p) = nota (simpfm p)
 59.1230 +  | simpfm (Lt a) =
 59.1231 +    let
 59.1232 +      val aa = simpnum a;
 59.1233 +    in
 59.1234 +      (case aa of C v => (if less_int v zero_inta then T else F)
 59.1235 +        | Bound _ => Lt aa | Cn (_, _, _) => Lt aa | Neg _ => Lt aa
 59.1236 +        | Add (_, _) => Lt aa | Sub (_, _) => Lt aa | Mul (_, _) => Lt aa)
 59.1237 +    end
 59.1238 +  | simpfm (Le a) =
 59.1239 +    let
 59.1240 +      val aa = simpnum a;
 59.1241 +    in
 59.1242 +      (case aa of C v => (if less_eq_int v zero_inta then T else F)
 59.1243 +        | Bound _ => Le aa | Cn (_, _, _) => Le aa | Neg _ => Le aa
 59.1244 +        | Add (_, _) => Le aa | Sub (_, _) => Le aa | Mul (_, _) => Le aa)
 59.1245 +    end
 59.1246 +  | simpfm (Gt a) =
 59.1247 +    let
 59.1248 +      val aa = simpnum a;
 59.1249 +    in
 59.1250 +      (case aa of C v => (if less_int zero_inta v then T else F)
 59.1251 +        | Bound _ => Gt aa | Cn (_, _, _) => Gt aa | Neg _ => Gt aa
 59.1252 +        | Add (_, _) => Gt aa | Sub (_, _) => Gt aa | Mul (_, _) => Gt aa)
 59.1253 +    end
 59.1254 +  | simpfm (Ge a) =
 59.1255 +    let
 59.1256 +      val aa = simpnum a;
 59.1257 +    in
 59.1258 +      (case aa of C v => (if less_eq_int zero_inta v then T else F)
 59.1259 +        | Bound _ => Ge aa | Cn (_, _, _) => Ge aa | Neg _ => Ge aa
 59.1260 +        | Add (_, _) => Ge aa | Sub (_, _) => Ge aa | Mul (_, _) => Ge aa)
 59.1261 +    end
 59.1262 +  | simpfm (Eq a) =
 59.1263 +    let
 59.1264 +      val aa = simpnum a;
 59.1265 +    in
 59.1266 +      (case aa of C v => (if equal_inta v zero_inta then T else F)
 59.1267 +        | Bound _ => Eq aa | Cn (_, _, _) => Eq aa | Neg _ => Eq aa
 59.1268 +        | Add (_, _) => Eq aa | Sub (_, _) => Eq aa | Mul (_, _) => Eq aa)
 59.1269 +    end
 59.1270 +  | simpfm (NEq a) =
 59.1271 +    let
 59.1272 +      val aa = simpnum a;
 59.1273 +    in
 59.1274 +      (case aa of C v => (if not (equal_inta v zero_inta) then T else F)
 59.1275 +        | Bound _ => NEq aa | Cn (_, _, _) => NEq aa | Neg _ => NEq aa
 59.1276 +        | Add (_, _) => NEq aa | Sub (_, _) => NEq aa | Mul (_, _) => NEq aa)
 59.1277 +    end
 59.1278 +  | simpfm (Dvd (i, a)) =
 59.1279 +    (if equal_inta i zero_inta then simpfm (Eq a)
 59.1280 +      else (if equal_inta (abs_int i) (Int_of_integer (1 : IntInf.int)) then T
 59.1281 +             else let
 59.1282 +                    val aa = simpnum a;
 59.1283 +                  in
 59.1284 +                    (case aa
 59.1285 +                      of C v =>
 59.1286 +                        (if dvd (semiring_div_int, equal_int) i v then T else F)
 59.1287 +                      | Bound _ => Dvd (i, aa) | Cn (_, _, _) => Dvd (i, aa)
 59.1288 +                      | Neg _ => Dvd (i, aa) | Add (_, _) => Dvd (i, aa)
 59.1289 +                      | Sub (_, _) => Dvd (i, aa) | Mul (_, _) => Dvd (i, aa))
 59.1290 +                  end))
 59.1291 +  | simpfm (NDvd (i, a)) =
 59.1292 +    (if equal_inta i zero_inta then simpfm (NEq a)
 59.1293 +      else (if equal_inta (abs_int i) (Int_of_integer (1 : IntInf.int)) then F
 59.1294 +             else let
 59.1295 +                    val aa = simpnum a;
 59.1296 +                  in
 59.1297 +                    (case aa
 59.1298 +                      of C v =>
 59.1299 +                        (if not (dvd (semiring_div_int, equal_int) i v) then T
 59.1300 +                          else F)
 59.1301 +                      | Bound _ => NDvd (i, aa) | Cn (_, _, _) => NDvd (i, aa)
 59.1302 +                      | Neg _ => NDvd (i, aa) | Add (_, _) => NDvd (i, aa)
 59.1303 +                      | Sub (_, _) => NDvd (i, aa) | Mul (_, _) => NDvd (i, aa))
 59.1304 +                  end))
 59.1305 +  | simpfm T = T
 59.1306 +  | simpfm F = F
 59.1307 +  | simpfm (E v) = E v
 59.1308 +  | simpfm (A v) = A v
 59.1309 +  | simpfm (Closed v) = Closed v
 59.1310 +  | simpfm (NClosed v) = NClosed v;
 59.1311 +
 59.1312 +val equal_num = {equal = equal_numa} : numa equal;
 59.1313 +
 59.1314 +fun gen_length n (x :: xs) = gen_length (suc n) xs
 59.1315 +  | gen_length n [] = n;
 59.1316 +
 59.1317 +fun size_list x = gen_length zero_nat x;
 59.1318 +
 59.1319 +fun mirror (And (p, q)) = And (mirror p, mirror q)
 59.1320 +  | mirror (Or (p, q)) = Or (mirror p, mirror q)
 59.1321 +  | mirror T = T
 59.1322 +  | mirror F = F
 59.1323 +  | mirror (Lt (C bo)) = Lt (C bo)
 59.1324 +  | mirror (Lt (Bound bp)) = Lt (Bound bp)
 59.1325 +  | mirror (Lt (Neg bt)) = Lt (Neg bt)
 59.1326 +  | mirror (Lt (Add (bu, bv))) = Lt (Add (bu, bv))
 59.1327 +  | mirror (Lt (Sub (bw, bx))) = Lt (Sub (bw, bx))
 59.1328 +  | mirror (Lt (Mul (by, bz))) = Lt (Mul (by, bz))
 59.1329 +  | mirror (Le (C co)) = Le (C co)
 59.1330 +  | mirror (Le (Bound cp)) = Le (Bound cp)
 59.1331 +  | mirror (Le (Neg ct)) = Le (Neg ct)
 59.1332 +  | mirror (Le (Add (cu, cv))) = Le (Add (cu, cv))
 59.1333 +  | mirror (Le (Sub (cw, cx))) = Le (Sub (cw, cx))
 59.1334 +  | mirror (Le (Mul (cy, cz))) = Le (Mul (cy, cz))
 59.1335 +  | mirror (Gt (C doa)) = Gt (C doa)
 59.1336 +  | mirror (Gt (Bound dp)) = Gt (Bound dp)
 59.1337 +  | mirror (Gt (Neg dt)) = Gt (Neg dt)
 59.1338 +  | mirror (Gt (Add (du, dv))) = Gt (Add (du, dv))
 59.1339 +  | mirror (Gt (Sub (dw, dx))) = Gt (Sub (dw, dx))
 59.1340 +  | mirror (Gt (Mul (dy, dz))) = Gt (Mul (dy, dz))
 59.1341 +  | mirror (Ge (C eo)) = Ge (C eo)
 59.1342 +  | mirror (Ge (Bound ep)) = Ge (Bound ep)
 59.1343 +  | mirror (Ge (Neg et)) = Ge (Neg et)
 59.1344 +  | mirror (Ge (Add (eu, ev))) = Ge (Add (eu, ev))
 59.1345 +  | mirror (Ge (Sub (ew, ex))) = Ge (Sub (ew, ex))
 59.1346 +  | mirror (Ge (Mul (ey, ez))) = Ge (Mul (ey, ez))
 59.1347 +  | mirror (Eq (C fo)) = Eq (C fo)
 59.1348 +  | mirror (Eq (Bound fp)) = Eq (Bound fp)
 59.1349 +  | mirror (Eq (Neg ft)) = Eq (Neg ft)
 59.1350 +  | mirror (Eq (Add (fu, fv))) = Eq (Add (fu, fv))
 59.1351 +  | mirror (Eq (Sub (fw, fx))) = Eq (Sub (fw, fx))
 59.1352 +  | mirror (Eq (Mul (fy, fz))) = Eq (Mul (fy, fz))
 59.1353 +  | mirror (NEq (C go)) = NEq (C go)
 59.1354 +  | mirror (NEq (Bound gp)) = NEq (Bound gp)
 59.1355 +  | mirror (NEq (Neg gt)) = NEq (Neg gt)
 59.1356 +  | mirror (NEq (Add (gu, gv))) = NEq (Add (gu, gv))
 59.1357 +  | mirror (NEq (Sub (gw, gx))) = NEq (Sub (gw, gx))
 59.1358 +  | mirror (NEq (Mul (gy, gz))) = NEq (Mul (gy, gz))
 59.1359 +  | mirror (Dvd (aa, C ho)) = Dvd (aa, C ho)
 59.1360 +  | mirror (Dvd (aa, Bound hp)) = Dvd (aa, Bound hp)
 59.1361 +  | mirror (Dvd (aa, Neg ht)) = Dvd (aa, Neg ht)
 59.1362 +  | mirror (Dvd (aa, Add (hu, hv))) = Dvd (aa, Add (hu, hv))
 59.1363 +  | mirror (Dvd (aa, Sub (hw, hx))) = Dvd (aa, Sub (hw, hx))
 59.1364 +  | mirror (Dvd (aa, Mul (hy, hz))) = Dvd (aa, Mul (hy, hz))
 59.1365 +  | mirror (NDvd (ac, C io)) = NDvd (ac, C io)
 59.1366 +  | mirror (NDvd (ac, Bound ip)) = NDvd (ac, Bound ip)
 59.1367 +  | mirror (NDvd (ac, Neg it)) = NDvd (ac, Neg it)
 59.1368 +  | mirror (NDvd (ac, Add (iu, iv))) = NDvd (ac, Add (iu, iv))
 59.1369 +  | mirror (NDvd (ac, Sub (iw, ix))) = NDvd (ac, Sub (iw, ix))
 59.1370 +  | mirror (NDvd (ac, Mul (iy, iz))) = NDvd (ac, Mul (iy, iz))
 59.1371 +  | mirror (Not ae) = Not ae
 59.1372 +  | mirror (Imp (aj, ak)) = Imp (aj, ak)
 59.1373 +  | mirror (Iff (al, am)) = Iff (al, am)
 59.1374 +  | mirror (E an) = E an
 59.1375 +  | mirror (A ao) = A ao
 59.1376 +  | mirror (Closed ap) = Closed ap
 59.1377 +  | mirror (NClosed aq) = NClosed aq
 59.1378 +  | mirror (Lt (Cn (cm, c, e))) =
 59.1379 +    (if equal_nat cm zero_nat then Gt (Cn (zero_nat, c, Neg e))
 59.1380 +      else Lt (Cn (suc (minus_nat cm (nat_of_integer (1 : IntInf.int))), c, e)))
 59.1381 +  | mirror (Le (Cn (dm, c, e))) =
 59.1382 +    (if equal_nat dm zero_nat then Ge (Cn (zero_nat, c, Neg e))
 59.1383 +      else Le (Cn (suc (minus_nat dm (nat_of_integer (1 : IntInf.int))), c, e)))
 59.1384 +  | mirror (Gt (Cn (em, c, e))) =
 59.1385 +    (if equal_nat em zero_nat then Lt (Cn (zero_nat, c, Neg e))
 59.1386 +      else Gt (Cn (suc (minus_nat em (nat_of_integer (1 : IntInf.int))), c, e)))
 59.1387 +  | mirror (Ge (Cn (fm, c, e))) =
 59.1388 +    (if equal_nat fm zero_nat then Le (Cn (zero_nat, c, Neg e))
 59.1389 +      else Ge (Cn (suc (minus_nat fm (nat_of_integer (1 : IntInf.int))), c, e)))
 59.1390 +  | mirror (Eq (Cn (gm, c, e))) =
 59.1391 +    (if equal_nat gm zero_nat then Eq (Cn (zero_nat, c, Neg e))