mirror of
https://github.com/idris-lang/Idris2.git
synced 2024-09-11 21:37:48 +03:00
[ refactor ] introduce NonZero
This has a much better behaviour with respect to proof search and the coverage checker realising we don't need to consider the Z case than the `Not (x = Z)` we used earlier.
This commit is contained in:
parent
09d8e25441
commit
5af1efb56e
@ -241,9 +241,18 @@ export
|
||||
succInjective : (0 left, right : Nat) -> S left = S right -> left = right
|
||||
succInjective _ _ Refl = Refl
|
||||
|
||||
export total
|
||||
SIsNotZ : (S x = Z) -> Void
|
||||
SIsNotZ Refl impossible
|
||||
||| A definition of non-zero with a better behaviour than `Not (x = Z)`
|
||||
||| This is amenable to proof search and `NonZero Z` is more readily
|
||||
||| detected as impossible by Idris
|
||||
public export
|
||||
data NonZero : Nat -> Type where
|
||||
SIsNonZero : NonZero (S x)
|
||||
|
||||
export Uninhabited (NonZero Z) where uninhabited SIsNonZero impossible
|
||||
|
||||
export
|
||||
SIsNotZ : Not (S x = Z)
|
||||
SIsNotZ = absurd
|
||||
|
||||
||| Auxiliary function:
|
||||
||| mod' fuel a b = a `mod` (S b)
|
||||
@ -258,13 +267,13 @@ mod' (S fuel) centre right =
|
||||
mod' fuel (minus centre (S right)) right
|
||||
|
||||
public export
|
||||
modNatNZ : Nat -> (y: Nat) -> Not (y = Z) -> Nat
|
||||
modNatNZ left Z p = void (p Refl)
|
||||
modNatNZ : Nat -> (y: Nat) -> (0 _ : NonZero y) -> Nat
|
||||
modNatNZ left Z p = void (absurd p)
|
||||
modNatNZ left (S right) _ = mod' left left right
|
||||
|
||||
export partial
|
||||
modNat : Nat -> Nat -> Nat
|
||||
modNat left (S right) = modNatNZ left (S right) SIsNotZ
|
||||
modNat left (S right) = modNatNZ left (S right) SIsNonZero
|
||||
|
||||
||| Auxiliary function:
|
||||
||| div' fuel a b = a `div` (S b)
|
||||
@ -280,23 +289,22 @@ div' (S fuel) centre right =
|
||||
|
||||
-- 'public' to allow type-level division
|
||||
public export
|
||||
divNatNZ : Nat -> (y: Nat) -> Not (y = Z) -> Nat
|
||||
divNatNZ left Z p = void (p Refl)
|
||||
divNatNZ : Nat -> (y: Nat) -> (0 _ : NonZero y) -> Nat
|
||||
divNatNZ left (S right) _ = div' left left right
|
||||
|
||||
export partial
|
||||
divNat : Nat -> Nat -> Nat
|
||||
divNat left (S right) = divNatNZ left (S right) SIsNotZ
|
||||
divNat left (S right) = divNatNZ left (S right) SIsNonZero
|
||||
|
||||
export partial
|
||||
divCeilNZ : Nat -> (y: Nat) -> Not (y = Z) -> Nat
|
||||
divCeilNZ : Nat -> (y: Nat) -> (0 _ : NonZero y) -> Nat
|
||||
divCeilNZ x y p = case (modNatNZ x y p) of
|
||||
Z => divNatNZ x y p
|
||||
S _ => S (divNatNZ x y p)
|
||||
|
||||
export partial
|
||||
divCeil : Nat -> Nat -> Nat
|
||||
divCeil x (S y) = divCeilNZ x (S y) SIsNotZ
|
||||
divCeil x (S y) = divCeilNZ x (S y) SIsNonZero
|
||||
|
||||
|
||||
public export
|
||||
@ -310,8 +318,7 @@ divmod' (S fuel) centre right =
|
||||
in (S (fst qr), snd qr)
|
||||
|
||||
public export
|
||||
divmodNatNZ : Nat -> (y: Nat) -> Not (y = Z) -> (Nat, Nat)
|
||||
divmodNatNZ left Z p = void (p Refl)
|
||||
divmodNatNZ : Nat -> (y: Nat) -> (0 _ : NonZero y) -> (Nat, Nat)
|
||||
divmodNatNZ left (S right) _ = divmod' left left right
|
||||
|
||||
|
||||
@ -324,7 +331,7 @@ export partial
|
||||
gcd : (a: Nat) -> (b: Nat) -> {auto ok: NotBothZero a b} -> Nat
|
||||
gcd a Z = a
|
||||
gcd Z b = b
|
||||
gcd a (S b) = gcd (S b) (modNatNZ a (S b) SIsNotZ)
|
||||
gcd a (S b) = gcd (S b) (modNatNZ a (S b) SIsNonZero)
|
||||
|
||||
export partial
|
||||
lcm : Nat -> Nat -> Nat
|
||||
|
@ -74,20 +74,19 @@ mod''_eq_mod' fuel numer denom = cong snd $
|
||||
divmod'_eq_div'_mod' fuel numer denom
|
||||
|
||||
export
|
||||
divmodNatNZeqDivMod : (numer, denom : Nat) -> (prf1, prf2, prf3 : Not (denom = 0))
|
||||
divmodNatNZeqDivMod : (numer, denom : Nat) -> (0 prf1, prf2, prf3 : NonZero denom)
|
||||
-> (divmodNatNZ numer denom prf1) = (divNatNZ numer denom prf2, modNatNZ numer denom prf3)
|
||||
divmodNatNZeqDivMod numer 0 prf1 prf2 prf3 = void $ prf1 Refl
|
||||
divmodNatNZeqDivMod numer (S denom) prf1 prf2 prf3 = divmod'_eq_div'_mod' numer numer denom
|
||||
|
||||
export
|
||||
fstDivmodNatNZeqDiv : (numer, denom : Nat) -> (prf1, prf2 : Not (denom = 0))
|
||||
fstDivmodNatNZeqDiv : (numer, denom : Nat) -> (0 prf1, prf2 : NonZero denom)
|
||||
-> (fst $ divmodNatNZ numer denom prf1) = divNatNZ numer denom prf2
|
||||
fstDivmodNatNZeqDiv numer denom prf1 prf2 =
|
||||
rewrite divmodNatNZeqDivMod numer denom prf1 prf2 prf2 in
|
||||
Refl
|
||||
|
||||
export
|
||||
sndDivmodNatNZeqMod : (numer, denom : Nat) -> (prf1, prf2 : Not (denom = 0))
|
||||
sndDivmodNatNZeqMod : (numer, denom : Nat) -> (0 prf1, prf2 : NonZero denom)
|
||||
-> (snd $ divmodNatNZ numer denom prf1) = modNatNZ numer denom prf2
|
||||
sndDivmodNatNZeqMod numer denom prf1 prf2 =
|
||||
rewrite divmodNatNZeqDivMod numer denom prf1 prf2 prf2 in
|
||||
@ -106,9 +105,8 @@ bound_mod'' (S fuel) numer predDenom enough = case @@(Data.Nat.lte numer predDe
|
||||
(fuelLemma numer predDenom fuel enough numer_gte_n)
|
||||
|
||||
export
|
||||
boundModNatNZ : (numer, denom : Nat) -> (denom_nz : Not (denom = 0))
|
||||
boundModNatNZ : (numer, denom : Nat) -> (0 denom_nz : NonZero denom)
|
||||
-> (modNatNZ numer denom denom_nz) `LT` denom
|
||||
boundModNatNZ numer 0 denom_nz = void $ denom_nz Refl
|
||||
boundModNatNZ numer (S predDenom) denom_nz = LTESucc $
|
||||
rewrite sym $ mod''_eq_mod' numer numer predDenom in
|
||||
bound_mod'' numer numer predDenom (reflexive numer)
|
||||
@ -152,15 +150,14 @@ divisionTheorem' numer predDenom (S fuel) enough with (@@(Data.Nat.lte numer pr
|
||||
|
||||
|
||||
export
|
||||
DivisionTheoremDivMod : (numer, denom : Nat) -> (prf : Not (denom = Z))
|
||||
DivisionTheoremDivMod : (numer, denom : Nat) -> (0 prf : NonZero denom)
|
||||
-> numer = snd ( divmodNatNZ numer denom prf)
|
||||
+ (fst $ divmodNatNZ numer denom prf)*denom
|
||||
DivisionTheoremDivMod numer 0 prf = void (prf Refl)
|
||||
DivisionTheoremDivMod numer (S predDenom) prf
|
||||
= divisionTheorem' numer predDenom numer (reflexive numer)
|
||||
|
||||
export
|
||||
DivisionTheorem : (numer, denom : Nat) -> (prf1, prf2 : Not (denom = Z))
|
||||
DivisionTheorem : (numer, denom : Nat) -> (0 prf1, prf2 : NonZero denom)
|
||||
-> numer = (modNatNZ numer denom prf1) + (divNatNZ numer denom prf2)*denom
|
||||
DivisionTheorem numer denom prf1 prf2
|
||||
= rewrite sym $ fstDivmodNatNZeqDiv numer denom prf1 prf2 in
|
||||
@ -299,13 +296,12 @@ addMultipleMod' (S fuel1) fuel2 predn a (S k) enough1 enough2 =
|
||||
fuelLemma ((1+k)*n + a) predn fuel1 enough1 prf1)
|
||||
enough2
|
||||
|
||||
addMultipleMod : (a, b, n : Nat) -> (n_neq_z1, n_neq_z2 : Not (n = 0))
|
||||
addMultipleMod : (a, b, n : Nat) -> (0 n_neq_z1, n_neq_z2 : NonZero n)
|
||||
-> snd (divmodNatNZ (a*n + b) n n_neq_z1) = snd (divmodNatNZ b n n_neq_z2)
|
||||
addMultipleMod a b 0 n_neq_z1 n_neq_z2 = void (n_neq_z1 Refl)
|
||||
addMultipleMod a b n@(S predn) n_neq_z1 n_neq_z2 =
|
||||
addMultipleMod' (a*n + b) b predn b a (reflexive {po = LTE} _) (reflexive {po = LTE} _)
|
||||
|
||||
modBelowDenom : (r, n : Nat) -> (n_neq_z : Not (n = 0))
|
||||
modBelowDenom : (r, n : Nat) -> (0 n_neq_z : NonZero n)
|
||||
-> (r `LT` n)
|
||||
-> snd (divmodNatNZ r n n_neq_z) = r
|
||||
modBelowDenom 0 (S predn) n_neq_0 (LTESucc r_lte_predn) = Refl
|
||||
@ -313,7 +309,7 @@ modBelowDenom r@(S _) (S predn) n_neq_0 (LTESucc r_lte_predn) =
|
||||
rewrite LteIslte r predn r_lte_predn in
|
||||
Refl
|
||||
|
||||
modInjective : (r1, r2, n : Nat) -> (n_neq_z1, n_neq_z2 : Not (n = 0))
|
||||
modInjective : (r1, r2, n : Nat) -> (0 n_neq_z1, n_neq_z2 : NonZero n)
|
||||
-> (r1 `LT` n)
|
||||
-> (r2 `LT` n)
|
||||
-> snd (divmodNatNZ r1 n n_neq_z1) = snd (divmodNatNZ r2 n n_neq_z2)
|
||||
@ -325,7 +321,7 @@ modInjective r1 r2 n n_neq_z1 n_neq_z2 r1_lt_n r2_lt_n ri_mod_eq = Calc $
|
||||
~~ r2 ...( modBelowDenom r2 n n_neq_z2 r2_lt_n)
|
||||
|
||||
|
||||
step1 : (numer : Nat) -> (denom : Nat) -> (denom_nz : Not (denom = 0))
|
||||
step1 : (numer : Nat) -> (denom : Nat) -> (0 denom_nz : NonZero denom)
|
||||
-> (q, r : Nat) -> (r `LT` denom) -> (numer = q * denom + r)
|
||||
-> snd (divmodNatNZ numer denom denom_nz) = r
|
||||
step1 x n n_nz q r r_lt_n x_eq_qnpr = Calc $
|
||||
@ -334,7 +330,7 @@ step1 x n n_nz q r r_lt_n x_eq_qnpr = Calc $
|
||||
~~ snd(divmodNatNZ r n n_nz) ...(addMultipleMod q r n n_nz n_nz)
|
||||
~~ r ...(modBelowDenom r n n_nz r_lt_n)
|
||||
|
||||
step2 : (numer : Nat) -> (denom : Nat) -> (denom_nz : Not (denom = 0))
|
||||
step2 : (numer : Nat) -> (denom : Nat) -> (0 denom_nz : NonZero denom)
|
||||
-> (q, r : Nat) -> (r `LT` denom) -> (numer = q * denom + r)
|
||||
-> fst (divmodNatNZ numer denom denom_nz) = q
|
||||
step2 x n n_nz q r r_lt_n x_eq_qnr =
|
||||
@ -358,7 +354,7 @@ step2 x n n_nz q r r_lt_n x_eq_qnr =
|
||||
$ two_decompositions
|
||||
|
||||
export
|
||||
DivisionTheoremUniquenessDivMod : (numer : Nat) -> (denom : Nat) -> (denom_nz : Not (denom = 0))
|
||||
DivisionTheoremUniquenessDivMod : (numer : Nat) -> (denom : Nat) -> (0 denom_nz : NonZero denom)
|
||||
-> (q, r : Nat) -> (r `LT` denom) -> (numer = q * denom + r)
|
||||
-> divmodNatNZ numer denom denom_nz = (q, r)
|
||||
DivisionTheoremUniquenessDivMod numer denom denom_nz q r x prf =
|
||||
@ -372,7 +368,7 @@ DivisionTheoremUniquenessDivMod numer denom denom_nz q r x prf =
|
||||
pair_eta (x,y) = Refl
|
||||
|
||||
export
|
||||
DivisionTheoremUniqueness : (numer : Nat) -> (denom : Nat) -> (denom_nz : Not (denom = 0))
|
||||
DivisionTheoremUniqueness : (numer : Nat) -> (denom : Nat) -> (0 denom_nz : NonZero denom)
|
||||
-> (q, r : Nat) -> (r `LT` denom) -> (numer = q * denom + r)
|
||||
-> (divNatNZ numer denom denom_nz = q, modNatNZ numer denom denom_nz = r)
|
||||
DivisionTheoremUniqueness numer denom denom_nz q r x prf =
|
||||
|
@ -19,8 +19,8 @@ unfoldDoubleS = irrelevantEq $ Calc $
|
||||
~~ 2 + 2 * n ...( cong (2 +) (sym unfoldDouble) )
|
||||
|
||||
export
|
||||
multRightCancel : (a,b,r : Nat) -> Not (r = 0) -> a*r = b*r -> a = b
|
||||
multRightCancel a b 0 r_nz ar_eq_br = void $ r_nz Refl
|
||||
multRightCancel : (a,b,r : Nat) -> (0 _ : NonZero r) -> a*r = b*r -> a = b
|
||||
multRightCancel a b 0 r_nz ar_eq_br = void (absurd r_nz)
|
||||
multRightCancel 0 0 r@(S predr) r_nz ar_eq_br = Refl
|
||||
multRightCancel 0 (S b) r@(S predr) r_nz ar_eq_br impossible
|
||||
multRightCancel (S a) 0 r@(S predr) r_nz ar_eq_br impossible
|
||||
|
Loading…
Reference in New Issue
Block a user