src/HOL/arith_data.ML
changeset 19233 77ca20b0ed77
parent 19043 6c0fca729f33
child 19277 f7602e74d948
equal deleted inserted replaced
19232:1f5b5dc3f48a 19233:77ca20b0ed77
    15 (** abstract syntax of structure nat: 0, Suc, + **)
    15 (** abstract syntax of structure nat: 0, Suc, + **)
    16 
    16 
    17 (* mk_sum, mk_norm_sum *)
    17 (* mk_sum, mk_norm_sum *)
    18 
    18 
    19 val one = HOLogic.mk_nat 1;
    19 val one = HOLogic.mk_nat 1;
    20 val mk_plus = HOLogic.mk_binop "op +";
    20 val mk_plus = HOLogic.mk_binop "HOL.plus";
    21 
    21 
    22 fun mk_sum [] = HOLogic.zero
    22 fun mk_sum [] = HOLogic.zero
    23   | mk_sum [t] = t
    23   | mk_sum [t] = t
    24   | mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
    24   | mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
    25 
    25 
    30   end;
    30   end;
    31 
    31 
    32 
    32 
    33 (* dest_sum *)
    33 (* dest_sum *)
    34 
    34 
    35 val dest_plus = HOLogic.dest_bin "op +" HOLogic.natT;
    35 val dest_plus = HOLogic.dest_bin "HOL.plus" HOLogic.natT;
    36 
    36 
    37 fun dest_sum tm =
    37 fun dest_sum tm =
    38   if HOLogic.is_zero tm then []
    38   if HOLogic.is_zero tm then []
    39   else
    39   else
    40     (case try HOLogic.dest_Suc tm of
    40     (case try HOLogic.dest_Suc tm of
   135 (* nat diff *)
   135 (* nat diff *)
   136 
   136 
   137 structure DiffCancelSums = CancelSumsFun
   137 structure DiffCancelSums = CancelSumsFun
   138 (struct
   138 (struct
   139   open Sum;
   139   open Sum;
   140   val mk_bal = HOLogic.mk_binop "op -";
   140   val mk_bal = HOLogic.mk_binop "HOL.minus";
   141   val dest_bal = HOLogic.dest_bin "op -" HOLogic.natT;
   141   val dest_bal = HOLogic.dest_bin "HOL.minus" HOLogic.natT;
   142   val uncancel_tac = gen_uncancel_tac diff_cancel;
   142   val uncancel_tac = gen_uncancel_tac diff_cancel;
   143 end);
   143 end);
   144 
   144 
   145 
   145 
   146 
   146 
   265    their coefficients
   265    their coefficients
   266 *)
   266 *)
   267 
   267 
   268 fun demult inj_consts =
   268 fun demult inj_consts =
   269 let
   269 let
   270 fun demult((mC as Const("op *",_)) $ s $ t,m) = ((case s of
   270 fun demult((mC as Const("HOL.times",_)) $ s $ t,m) = ((case s of
   271         Const("Numeral.number_of",_)$n
   271         Const("Numeral.number_of",_)$n
   272         => demult(t,Rat.mult(m,Rat.rat_of_intinf(HOLogic.dest_binum n)))
   272         => demult(t,Rat.mult(m,Rat.rat_of_intinf(HOLogic.dest_binum n)))
   273       | Const("uminus",_)$(Const("Numeral.number_of",_)$n)
   273       | Const("HOL.uminus",_)$(Const("Numeral.number_of",_)$n)
   274         => demult(t,Rat.mult(m,Rat.rat_of_intinf(~(HOLogic.dest_binum n))))
   274         => demult(t,Rat.mult(m,Rat.rat_of_intinf(~(HOLogic.dest_binum n))))
   275       | Const("Suc",_) $ _
   275       | Const("Suc",_) $ _
   276         => demult(t,Rat.mult(m,Rat.rat_of_int(number_of_Sucs s)))
   276         => demult(t,Rat.mult(m,Rat.rat_of_int(number_of_Sucs s)))
   277       | Const("op *",_) $ s1 $ s2 => demult(mC $ s1 $ (mC $ s2 $ t),m)
   277       | Const("HOL.times",_) $ s1 $ s2 => demult(mC $ s1 $ (mC $ s2 $ t),m)
   278       | Const("HOL.divide",_) $ numt $ (Const("Numeral.number_of",_)$dent) =>
   278       | Const("HOL.divide",_) $ numt $ (Const("Numeral.number_of",_)$dent) =>
   279           let val den = HOLogic.dest_binum dent
   279           let val den = HOLogic.dest_binum dent
   280           in if den = 0 then raise Zero
   280           in if den = 0 then raise Zero
   281              else demult(mC $ numt $ t,Rat.mult(m, Rat.inv(Rat.rat_of_intinf den)))
   281              else demult(mC $ numt $ t,Rat.mult(m, Rat.inv(Rat.rat_of_intinf den)))
   282           end
   282           end
   289   | demult(Const("0",_),m) = (NONE, Rat.rat_of_int 0)
   289   | demult(Const("0",_),m) = (NONE, Rat.rat_of_int 0)
   290   | demult(Const("1",_),m) = (NONE, m)
   290   | demult(Const("1",_),m) = (NONE, m)
   291   | demult(t as Const("Numeral.number_of",_)$n,m) =
   291   | demult(t as Const("Numeral.number_of",_)$n,m) =
   292       ((NONE,Rat.mult(m,Rat.rat_of_intinf(HOLogic.dest_binum n)))
   292       ((NONE,Rat.mult(m,Rat.rat_of_intinf(HOLogic.dest_binum n)))
   293        handle TERM _ => (SOME t,m))
   293        handle TERM _ => (SOME t,m))
   294   | demult(Const("uminus",_)$t, m) = demult(t,Rat.mult(m,Rat.rat_of_int(~1)))
   294   | demult(Const("HOL.uminus",_)$t, m) = demult(t,Rat.mult(m,Rat.rat_of_int(~1)))
   295   | demult(t as Const f $ x, m) =
   295   | demult(t as Const f $ x, m) =
   296       (if f mem inj_consts then SOME x else SOME t,m)
   296       (if f mem inj_consts then SOME x else SOME t,m)
   297   | demult(atom,m) = (SOME atom,m)
   297   | demult(atom,m) = (SOME atom,m)
   298 
   298 
   299 and atomult(mC,atom,t,m) = (case demult(t,m) of (NONE,m') => (SOME atom,m')
   299 and atomult(mC,atom,t,m) = (case demult(t,m) of (NONE,m') => (SOME atom,m')
   301 in demult end;
   301 in demult end;
   302 
   302 
   303 fun decomp2 inj_consts (rel,lhs,rhs) =
   303 fun decomp2 inj_consts (rel,lhs,rhs) =
   304 let
   304 let
   305 (* Turn term into list of summand * multiplicity plus a constant *)
   305 (* Turn term into list of summand * multiplicity plus a constant *)
   306 fun poly(Const("op +",_) $ s $ t, m, pi) = poly(s,m,poly(t,m,pi))
   306 fun poly(Const("HOL.plus",_) $ s $ t, m, pi) = poly(s,m,poly(t,m,pi))
   307   | poly(all as Const("op -",T) $ s $ t, m, pi) =
   307   | poly(all as Const("HOL.minus",T) $ s $ t, m, pi) =
   308       if nT T then add_atom(all,m,pi) else poly(s,m,poly(t,Rat.neg m,pi))
   308       if nT T then add_atom(all,m,pi) else poly(s,m,poly(t,Rat.neg m,pi))
   309   | poly(all as Const("uminus",T) $ t, m, pi) =
   309   | poly(all as Const("HOL.uminus",T) $ t, m, pi) =
   310       if nT T then add_atom(all,m,pi) else poly(t,Rat.neg m,pi)
   310       if nT T then add_atom(all,m,pi) else poly(t,Rat.neg m,pi)
   311   | poly(Const("0",_), _, pi) = pi
   311   | poly(Const("0",_), _, pi) = pi
   312   | poly(Const("1",_), m, (p,i)) = (p,Rat.add(i,m))
   312   | poly(Const("1",_), m, (p,i)) = (p,Rat.add(i,m))
   313   | poly(Const("Suc",_)$t, m, (p,i)) = poly(t, m, (p,Rat.add(i,m)))
   313   | poly(Const("Suc",_)$t, m, (p,i)) = poly(t, m, (p,Rat.add(i,m)))
   314   | poly(t as Const("op *",_) $ _ $ _, m, pi as (p,i)) =
   314   | poly(t as Const("HOL.times",_) $ _ $ _, m, pi as (p,i)) =
   315       (case demult inj_consts (t,m) of
   315       (case demult inj_consts (t,m) of
   316          (NONE,m') => (p,Rat.add(i,m))
   316          (NONE,m') => (p,Rat.add(i,m))
   317        | (SOME u,m') => add_atom(u,m',pi))
   317        | (SOME u,m') => add_atom(u,m',pi))
   318   | poly(t as Const("HOL.divide",_) $ _ $ _, m, pi as (p,i)) =
   318   | poly(t as Const("HOL.divide",_) $ _ $ _, m, pi as (p,i)) =
   319       (case demult inj_consts (t,m) of
   319       (case demult inj_consts (t,m) of