slight cleanup in hologic.ML
authorhaftmann
Fri, 01 Dec 2006 17:22:31 +0100
changeset 21621 f9fd69d96c4e
parent 21620 3d4bfc7f6363
child 21622 5825a59785f4
slight cleanup in hologic.ML
src/HOL/Tools/datatype_abs_proofs.ML
src/HOL/Tools/datatype_prop.ML
src/HOL/arith_data.ML
src/HOL/ex/reflection.ML
src/HOL/hologic.ML
--- a/src/HOL/Tools/datatype_abs_proofs.ML	Fri Dec 01 17:22:30 2006 +0100
+++ b/src/HOL/Tools/datatype_abs_proofs.ML	Fri Dec 01 17:22:31 2006 +0100
@@ -414,7 +414,7 @@
         val Ts = map (typ_of_dtyp descr' sorts) cargs;
         val k = length (filter is_rec_type cargs);
         val t = if k = 0 then HOLogic.zero else
-          foldl1 plus (map Bound (k - 1 downto 0) @ [HOLogic.mk_nat 1])
+          foldl1 plus (map Bound (k - 1 downto 0) @ [HOLogic.Suc_zero])
       in
         foldr (fn (T, t') => Abs ("x", T, t')) t (Ts @ replicate k HOLogic.natT)
       end;
--- a/src/HOL/Tools/datatype_prop.ML	Fri Dec 01 17:22:30 2006 +0100
+++ b/src/HOL/Tools/datatype_prop.ML	Fri Dec 01 17:22:31 2006 +0100
@@ -377,7 +377,7 @@
         val ts = map (fn ((r, s), T) => List.nth (size_consts, dest_DtRec r) $
           Free (s, T)) (recs ~~ rec_tnames ~~ recTs);
         val t = if ts = [] then HOLogic.zero else
-          foldl1 plus (ts @ [HOLogic.mk_nat 1])
+          foldl1 plus (ts @ [HOLogic.Suc_zero])
       in
         HOLogic.mk_Trueprop (HOLogic.mk_eq (size_const $
           list_comb (Const (cname, Ts ---> T), map Free (tnames ~~ Ts)), t))
--- a/src/HOL/arith_data.ML	Fri Dec 01 17:22:30 2006 +0100
+++ b/src/HOL/arith_data.ML	Fri Dec 01 17:22:31 2006 +0100
@@ -16,7 +16,6 @@
 
 (* mk_sum, mk_norm_sum *)
 
-val one = HOLogic.mk_nat 1;
 val mk_plus = HOLogic.mk_binop "HOL.plus";
 
 fun mk_sum [] = HOLogic.zero
@@ -25,7 +24,7 @@
 
 (*normal form of sums: Suc (... (Suc (a + (b + ...))))*)
 fun mk_norm_sum ts =
-  let val (ones, sums) = List.partition (equal one) ts in
+  let val (ones, sums) = List.partition (equal HOLogic.Suc_zero) ts in
     funpow (length ones) HOLogic.mk_Suc (mk_sum sums)
   end;
 
@@ -37,7 +36,7 @@
   if HOLogic.is_zero tm then []
   else
     (case try HOLogic.dest_Suc tm of
-      SOME t => one :: dest_sum t
+      SOME t => HOLogic.Suc_zero :: dest_sum t
     | NONE =>
         (case try dest_plus tm of
           SOME (t, u) => dest_sum t @ dest_sum u
--- a/src/HOL/ex/reflection.ML	Fri Dec 01 17:22:30 2006 +0100
+++ b/src/HOL/ex/reflection.ML	Fri Dec 01 17:22:31 2006 +0100
@@ -190,7 +190,7 @@
 		     (AList.delete (op =) (xn,0) tml)
        val th = (instantiate 
 		     ([],
-		      [(cert vs, cvs),(cert n, t' |> index_of |> HOLogic.mk_nat |> cert)]
+		      [(cert vs, cvs),(cert n, t' |> index_of |> IntInf.fromInt |> HOLogic.mk_nat |> cert)]
 		      @cts) eq) RS sym
       in hd (Variable.export ctxt' ctxt [th])
       end)
--- a/src/HOL/hologic.ML	Fri Dec 01 17:22:30 2006 +0100
+++ b/src/HOL/hologic.ML	Fri Dec 01 17:22:31 2006 +0100
@@ -43,13 +43,13 @@
   val list_all: (string * typ) list * term -> term
   val mk_exists: string * typ * term -> term
   val mk_Collect: string * typ * term -> term
-  val class_eq: string
   val mk_mem: term * term -> term
   val dest_mem: term -> term * term
   val mk_UNIV: typ -> term
   val mk_binop: string -> term * term -> term
   val mk_binrel: string -> term * term -> term
   val dest_bin: string -> typ -> term -> term * term
+  val class_eq: string
   val unitT: typ
   val is_unitT: typ -> bool
   val unit: term
@@ -70,8 +70,9 @@
   val is_zero: term -> bool
   val mk_Suc: term -> term
   val dest_Suc: term -> term
-  val mk_nat: int -> term
-  val dest_nat: term -> int
+  val Suc_zero: term
+  val mk_nat: IntInf.int -> term
+  val dest_nat: term -> IntInf.int
   val intT: typ
   val mk_int: IntInf.int -> term
   val realT: typ
@@ -288,11 +289,13 @@
 fun dest_Suc (Const ("Suc", _) $ t) = t
   | dest_Suc t = raise TERM ("dest_Suc", [t]);
 
+val Suc_zero = mk_Suc zero;
+
 fun mk_nat 0 = zero
-  | mk_nat n = mk_Suc (mk_nat (n - 1));
+  | mk_nat n = mk_Suc (mk_nat (IntInf.- (n, 1)));
 
 fun dest_nat (Const ("HOL.zero", _)) = 0
-  | dest_nat (Const ("Suc", _) $ t) = dest_nat t + 1
+  | dest_nat (Const ("Suc", _) $ t) = IntInf.+ (dest_nat t, 1)
   | dest_nat t = raise TERM ("dest_nat", [t]);