src/HOL/Numeral.thy

Polymorphic treatment of binary arithmetic using axclasses

(*  Title:      HOL/Numeral.thy
    ID:         $Id$
    Author:     Larry Paulson and Markus Wenzel

Generic numerals represented as twos-complement bit strings.
*)

theory Numeral = Datatype
files "Tools/numeral_syntax.ML":

text{* The file @{text numeral_syntax.ML} hides the constructors Pls and Min.
   Only qualified access bin.Pls and bin.Min is allowed.
   We do not hide Bit because we need the BIT infix syntax.*}

text{*A number can have multiple representations, namely leading Falses with
sign @{term Pls} and leading Trues with sign @{term Min}.
See @{text "ZF/Integ/twos-compl.ML"}, function @{text int_of_binary},
for the numerical interpretation.

The representation expects that @{text "(m mod 2)"} is 0 or 1,
even if m is negative;
For instance, @{text "-5 div 2 = -3"} and @{text "-5 mod 2 = 1"}; thus
@{text "-5 = (-3)*2 + 1"}.
*}

datatype
  bin = Pls  --{*Plus: Stands for an infinite string of leading Falses*}
      | Min --{*Minus: Stands for an infinite string of leading Trues*}
      | Bit bin bool    (infixl "BIT" 90)

axclass
  number < type  -- {* for numeric types: nat, int, real, \dots *}

consts
  number_of :: "bin => 'a::number"

syntax
  "_Numeral" :: "num_const => 'a"    ("_")
  Numeral0 :: 'a
  Numeral1 :: 'a

translations
  "Numeral0" == "number_of bin.Pls"
  "Numeral1" == "number_of (bin.Pls BIT True)"


setup NumeralSyntax.setup

syntax (xsymbols)
  "_square" :: "'a => 'a"  ("(_\<twosuperior>)" [1000] 999)
syntax (HTML output)
  "_square" :: "'a => 'a"  ("(_\<twosuperior>)" [1000] 999)
syntax (output)
  "_square" :: "'a => 'a"  ("(_ ^/ 2)" [81] 80)
translations
  "x\<twosuperior>" == "x^2"
  "x\<twosuperior>" <= "x^(2::nat)"


lemma Let_number_of [simp]: "Let (number_of v) f == f (number_of v)"
  -- {* Unfold all @{text let}s involving constants *}
  by (simp add: Let_def)

lemma Let_0 [simp]: "Let 0 f == f 0"
  by (simp add: Let_def)

lemma Let_1 [simp]: "Let 1 f == f 1"
  by (simp add: Let_def)


consts
  ring_of :: "bin => 'a::ring"

  NCons     :: "[bin,bool]=>bin"
  bin_succ  :: "bin=>bin"
  bin_pred  :: "bin=>bin"
  bin_minus :: "bin=>bin"
  bin_add   :: "[bin,bin]=>bin"
  bin_mult  :: "[bin,bin]=>bin"

text{*@{term NCons} inserts a bit, suppressing leading 0s and 1s*}
primrec
  NCons_Pls:  "NCons bin.Pls b = (if b then (bin.Pls BIT b) else bin.Pls)"
  NCons_Min:  "NCons bin.Min b = (if b then bin.Min else (bin.Min BIT b))"
  NCons_BIT:  "NCons (w BIT x) b = (w BIT x) BIT b"


primrec 
  ring_of_Pls: "ring_of bin.Pls = 0"
  ring_of_Min: "ring_of bin.Min = - (1::'a::ring)"
  ring_of_BIT: "ring_of(w BIT x) = (if x then 1 else 0) +
	                               (ring_of w) + (ring_of w)"

primrec
  bin_succ_Pls: "bin_succ bin.Pls = bin.Pls BIT True"
  bin_succ_Min: "bin_succ bin.Min = bin.Pls"
  bin_succ_BIT: "bin_succ(w BIT x) =
  	            (if x then bin_succ w BIT False
	                  else NCons w True)"

primrec
  bin_pred_Pls: "bin_pred bin.Pls = bin.Min"
  bin_pred_Min: "bin_pred bin.Min = bin.Min BIT False"
  bin_pred_BIT: "bin_pred(w BIT x) =
	            (if x then NCons w False
		          else (bin_pred w) BIT True)"

primrec
  bin_minus_Pls: "bin_minus bin.Pls = bin.Pls"
  bin_minus_Min: "bin_minus bin.Min = bin.Pls BIT True"
  bin_minus_BIT: "bin_minus(w BIT x) =
	             (if x then bin_pred (NCons (bin_minus w) False)
		           else bin_minus w BIT False)"

primrec
  bin_add_Pls: "bin_add bin.Pls w = w"
  bin_add_Min: "bin_add bin.Min w = bin_pred w"
  bin_add_BIT:
    "bin_add (v BIT x) w =
       (case w of Pls => v BIT x
                | Min => bin_pred (v BIT x)
                | (w BIT y) =>
      	            NCons (bin_add v (if (x & y) then bin_succ w else w))
	                  (x~=y))"

primrec
  bin_mult_Pls: "bin_mult bin.Pls w = bin.Pls"
  bin_mult_Min: "bin_mult bin.Min w = bin_minus w"
  bin_mult_BIT: "bin_mult (v BIT x) w =
	            (if x then (bin_add (NCons (bin_mult v w) False) w)
	                  else (NCons (bin_mult v w) False))"


subsection{*Extra rules for @{term bin_succ}, @{term bin_pred}, 
  @{term bin_add} and @{term bin_mult}*}

lemma NCons_Pls_0: "NCons bin.Pls False = bin.Pls"
by simp

lemma NCons_Pls_1: "NCons bin.Pls True = bin.Pls BIT True"
by simp

lemma NCons_Min_0: "NCons bin.Min False = bin.Min BIT False"
by simp

lemma NCons_Min_1: "NCons bin.Min True = bin.Min"
by simp

lemma bin_succ_1: "bin_succ(w BIT True) = (bin_succ w) BIT False"
by simp

lemma bin_succ_0: "bin_succ(w BIT False) =  NCons w True"
by simp

lemma bin_pred_1: "bin_pred(w BIT True) = NCons w False"
by simp

lemma bin_pred_0: "bin_pred(w BIT False) = (bin_pred w) BIT True"
by simp

lemma bin_minus_1: "bin_minus(w BIT True) = bin_pred (NCons (bin_minus w) False)"
by simp

lemma bin_minus_0: "bin_minus(w BIT False) = (bin_minus w) BIT False"
by simp


subsection{*Binary Addition and Multiplication:
         @{term bin_add} and @{term bin_mult}*}

lemma bin_add_BIT_11:
     "bin_add (v BIT True) (w BIT True) =
     NCons (bin_add v (bin_succ w)) False"
by simp

lemma bin_add_BIT_10:
     "bin_add (v BIT True) (w BIT False) = NCons (bin_add v w) True"
by simp

lemma bin_add_BIT_0:
     "bin_add (v BIT False) (w BIT y) = NCons (bin_add v w) y"
by auto

lemma bin_add_Pls_right: "bin_add w bin.Pls = w"
by (induct_tac "w", auto)

lemma bin_add_Min_right: "bin_add w bin.Min = bin_pred w"
by (induct_tac "w", auto)

lemma bin_add_BIT_BIT:
     "bin_add (v BIT x) (w BIT y) =
     NCons(bin_add v (if x & y then (bin_succ w) else w)) (x~= y)"
by simp

lemma bin_mult_1:
     "bin_mult (v BIT True) w = bin_add (NCons (bin_mult v w) False) w"
by simp

lemma bin_mult_0: "bin_mult (v BIT False) w = NCons (bin_mult v w) False"
by simp


end