@@ -0,0 +1,61 @@
1+module Main
2+
3+data Binary : Nat -> Type where
4+ bEnd : Binary Z
5+ bO : Binary n -> Binary (n + n)
6+ bI : Binary n -> Binary (S (n + n))
7+
8+instance Show (Binary n) where
9+ show (bO x) = show x ++ "0"
10+ show (bI x) = show x ++ "1"
11+ show bEnd = ""
12+
13+data Parity : Nat -> Type where
14+ even : Parity (n + n)
15+ odd : Parity (S (n + n))
16+
17+parity : (n:Nat) -> Parity n
18+parity Z = even {n=Z}
19+parity (S Z) = odd {n=Z}
20+parity (S (S k)) with (parity k)
21+ parity (S (S (j + j))) | even ?= even {n=S j}
22+ parity (S (S (S (j + j)))) | odd ?= odd {n=S j}
23+
24+natToBin : (n:Nat) -> Binary n
25+natToBin Z = bEnd
26+natToBin (S k) with (parity k)
27+ natToBin (S (j + j)) | even = bI (natToBin j)
28+ natToBin (S (S (j + j))) | odd ?= bO (natToBin (S j))
29+
30+intToNat : Int -> Nat
31+intToNat 0 = Z
32+intToNat x = if (x>0) then (S (intToNat (x-1))) else Z
33+
34+main : IO ()
35+main = do putStr "Enter a number: "
36+ x <- getLine
37+ print (natToBin (fromInteger (cast x)))
38+
39+---------- Proofs ----------
40+
41+Main.natToBin_lemma_1 = proof
42+ intros
43+ rewrite plusSuccRightSucc j j
44+ rewrite sym (plusSuccRightSucc j j)
45+ trivial
46+
47+
48+parity_lemma_1 = proof
49+ intros
50+ rewrite sym (plusSuccRightSucc j j)
51+ trivial
52+
53+
54+parity_lemma_2 = proof {
55+ intro;
56+ intro;
57+ rewrite sym (plusSuccRightSucc j j);
58+ trivial;
59+}
60+
61+