nat.idr

module prelude.nat

import builtins
import prelude.cast

%access public

data Nat = O | S Nat

instance Cast Nat Int where
    cast O = 0
    cast (S k) = 1 + cast k

plus : Nat -> Nat -> Nat
plus O     y = y
plus (S k) y = S (plus k y)

eqRespS : m = n -> S m = S n
eqRespS refl = refl

eqRespS' : S m = S n -> m = n
eqRespS' refl = refl

sub : Nat -> Nat -> Nat
sub O      y    = O
sub (S k) (S y) = sub k y
sub x      O    = x

mult : Nat -> Nat -> Nat
mult O     y = O
mult (S k) y = plus y (mult k y)

instance Eq Nat where 
    O     == O     = True
    (S x) == (S y) = x == y
    O     == (S y) = False
    (S x) == O     = False

instance Ord Nat where
    compare O O     = EQ
    compare O (S k) = LT
    compare (S k) O = GT
    compare (S x) (S y) = compare x y

instance Num Nat where
    (+) = plus
    (-) = sub
    (*) = mult

    fromInteger 0 = O
    fromInteger n = if (n > 0) then (S (fromInteger (n-1))) else O

plusnO : (m : Nat) -> m + O = m
plusnO O     = refl
plusnO (S k) = eqRespS (plusnO k)

plusn_Sm : (n, m : Nat) -> (plus n (S m)) = S (plus n m)
plusn_Sm O     m = refl
plusn_Sm (S j) m = eqRespS (plusn_Sm _ _)

plus_commutes : (n : Nat) -> (m : Nat) -> n + m = m + n
plus_commutes O     m = sym (plusnO m)
plus_commutes (S k) m = let ih = plus_commutes k m in ?plus_commutes_Sk

plus_commutes_Sk = proof {
    intros;
    refine sym;
    rewrite sym ih;
    rewrite plusn_Sm m k;
    trivial;
}

plus_assoc : (n, m, p : Nat) -> n + (m + p) = (n + m) + p
plus_assoc O     m p = refl
plus_assoc (S k) m p = let ih = plus_assoc k m p in eqRespS ih

data Cmp : Nat -> Nat -> Set where
    cmpLT : (y : Nat) -> Cmp x (x + S y)
    cmpEQ : Cmp x x
    cmpGT : (x : Nat) -> Cmp (y + S x) y
  
cmp : (n, m : Nat) -> Cmp n m
cmp O     O     = cmpEQ
cmp (S n) O     = cmpGT _
cmp O     (S n) = cmpLT _
cmp (S x) (S y) with (cmp x y)
    cmp (S x) (S x)         | cmpEQ = cmpEQ
    cmp (S (y + S x)) (S y) | cmpGT _ = cmpGT _
    cmp (S x) (S (x + S y)) | cmpLT _ = cmpLT _
  
multnO : (n : Nat) -> (n * O) = O
multnO O     = refl
multnO (S k) = multnO k

multn_Sm : (n, m : Nat) -> n * S m = n + n * m
multn_Sm O     m = refl
multn_Sm (S k) m = let ih = multn_Sm k m in ?multnSmSk

mult_commutes : (n, m : Nat) -> n * m = m * n
mult_commutes O     m = ?mult_commO
mult_commutes (S k) m = let ih = mult_commutes k m in ?mult_commSk

mult_commSk = proof {
    intros;
    rewrite sym ih;
    rewrite multn_Sm m k;
    trivial;
}

mult_commO = proof {
    intro;
    rewrite multnO m;
    trivial;
}

multnSmSk = proof {
    intros;
    rewrite plus_commutes (mult k m) m;
    rewrite sym (plus_assoc k (mult k m) m);
    rewrite ih;
    rewrite plus_commutes m (mult k (S m));
    trivial;
}