forked from idris-lang/Idris-dev
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Deal with shadowing better in patterns
Variable names in patterns should override global names, as long as they are not applied to anything. If the global name is desired (e.g. if it is the result of a dependency elsewhere, either use a _ or give the qualified version of the name)
- Loading branch information
Showing
10 changed files
with
205 additions
and
8 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,4 +1,4 @@ | ||
#!/bin/bash | ||
idris test014.idr -o test014 | ||
./test014 | ||
rm -f test014 test014.ibc | ||
rm -f test014 resimp.ibc test014.ibc |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,3 @@ | ||
00101010 | ||
01011001 | ||
010000011 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,28 @@ | ||
module parity | ||
|
||
data Parity : Nat -> Set where | ||
even : Parity (n + n) | ||
odd : Parity (S (n + n)) | ||
|
||
parity : (n:Nat) -> Parity n | ||
parity O = even {n=O} | ||
parity (S O) = odd {n=O} | ||
parity (S (S k)) with (parity k) | ||
parity (S (S (j + j))) | even ?= even {n=S j} | ||
parity (S (S (S (j + j)))) | odd ?= odd {n=S j} | ||
|
||
|
||
parity_lemma_2 = proof { | ||
intro; | ||
intro; | ||
rewrite sym (plusSuccRightSucc j j); | ||
trivial; | ||
} | ||
|
||
parity_lemma_1 = proof { | ||
intro j; | ||
intro; | ||
rewrite sym (plusSuccRightSucc j j); | ||
trivial; | ||
} | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,4 @@ | ||
#!/bin/bash | ||
idris test015.idr -o test015 | ||
./test015 | ||
rm -f test015 parity.ibc test015.ibc |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,141 @@ | ||
module main | ||
|
||
import parity | ||
import system | ||
|
||
data Bit : Nat -> Set where | ||
b0 : Bit 0 | ||
b1 : Bit 1 | ||
|
||
instance Show (Bit n) where | ||
show b0 = "0" | ||
show b1 = "1" | ||
|
||
infixl 5 # | ||
|
||
data Binary : (width : Nat) -> (value : Nat) -> Set where | ||
zero : Binary O O | ||
(#) : Binary w v -> Bit bit -> Binary (S w) (bit + 2 * v) | ||
|
||
instance Show (Binary w k) where | ||
show zero = "" | ||
show (bin # bit) = show bin ++ show bit | ||
|
||
pad : Binary w n -> Binary (S w) n | ||
pad zero = zero # b0 | ||
pad (num # x) = pad num # x | ||
|
||
natToBin : (width : Nat) -> (n : Nat) -> | ||
Maybe (Binary width n) | ||
natToBin O (S k) = Nothing | ||
natToBin O O = Just zero | ||
natToBin (S k) O = do x <- natToBin k O | ||
Just (pad x) | ||
natToBin (S w) (S k) with (parity k) | ||
natToBin (S w) (S (plus j j)) | even = do jbin <- natToBin w j | ||
let value = jbin # b1 | ||
?ntbEven | ||
natToBin (S w) (S (S (plus j j))) | odd = do jbin <- natToBin w (S j) | ||
let value = jbin # b0 | ||
?ntbOdd | ||
|
||
testBin : Maybe (Binary 8 42) | ||
testBin = natToBin _ _ | ||
|
||
pattern syntax bitpair [x] [y] = (_ ** (_ ** (x, y, _))) | ||
term syntax bitpair [x] [y] = (_ ** (_ ** (x, y, refl))) | ||
|
||
addBit : Bit x -> Bit y -> Bit c -> | ||
(bx ** (by ** (Bit bx, Bit by, c + x + y = by + 2 * bx))) | ||
addBit b0 b0 b0 = bitpair b0 b0 | ||
addBit b0 b0 b1 = bitpair b0 b1 | ||
addBit b0 b1 b0 = bitpair b0 b1 | ||
addBit b0 b1 b1 = bitpair b1 b0 | ||
addBit b1 b0 b0 = bitpair b0 b1 | ||
addBit b1 b0 b1 = bitpair b1 b0 | ||
addBit b1 b1 b0 = bitpair b1 b0 | ||
addBit b1 b1 b1 = bitpair b1 b1 | ||
|
||
adc : Binary w x -> Binary w y -> Bit c -> Binary (S w) (c + x + y) | ||
adc zero zero carry ?= zero # carry | ||
adc (numx # bx) (numy # by) carry | ||
?= let (bitpair carry0 lsb) = addBit bx by carry in | ||
adc numx numy carry0 # lsb | ||
|
||
readNum : IO Nat | ||
readNum = do putStr "Enter a number:" | ||
i <- getLine | ||
let n : Int = cast i | ||
return (fromInteger n) | ||
|
||
main : IO () | ||
main = do let Just bin1 = natToBin 8 42 | ||
print bin1 | ||
let Just bin2 = natToBin 8 89 | ||
print bin2 | ||
print (adc bin1 bin2 b0) | ||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
---------- Proofs ---------- | ||
|
||
main.ntbOdd = proof { | ||
intro w,j; | ||
rewrite sym (plusZeroRightNeutral j); | ||
rewrite plusSuccRightSucc j j; | ||
intros; | ||
refine Just; | ||
trivial; | ||
} | ||
|
||
main.ntbEven = proof { | ||
compute; | ||
intro w,j; | ||
rewrite sym (plusZeroRightNeutral j); | ||
intros; | ||
refine Just; | ||
trivial; | ||
} | ||
|
||
-- There is almost certainly an easier proof. I don't care, for now :) | ||
|
||
main.adc_lemma_2 = proof { | ||
intro c,w,v,bit0,num0; | ||
intro b0,v1,bit1,num1,b1; | ||
intro bc,x,x1,bx,bx1; | ||
rewrite sym (plusZeroRightNeutral x); | ||
rewrite sym (plusZeroRightNeutral v1); | ||
rewrite sym (plusZeroRightNeutral (plus (plus x v) v1)); | ||
rewrite sym (plusZeroRightNeutral v); | ||
intros; | ||
rewrite sym (plusAssociative (plus c (plus bit0 (plus v v))) bit1 (plus v1 v1)); | ||
rewrite (plusAssociative c (plus bit0 (plus v v)) bit1); | ||
rewrite (plusAssociative bit0 (plus v v) bit1); | ||
rewrite plusCommutative bit1 (plus v v); | ||
rewrite sym (plusAssociative c bit0 (plus bit1 (plus v v))); | ||
rewrite sym (plusAssociative (plus c bit0) bit1 (plus v v)); | ||
rewrite sym b; | ||
rewrite plusAssociative x1 (plus x x) (plus v v); | ||
rewrite plusAssociative x x (plus v v); | ||
rewrite sym (plusAssociative x v v); | ||
rewrite plusCommutative v (plus x v); | ||
rewrite sym (plusAssociative x v (plus x v)); | ||
rewrite (plusAssociative x1 (plus (plus x v) (plus x v)) (plus v1 v1)); | ||
rewrite sym (plusAssociative (plus (plus x v) (plus x v)) v1 v1); | ||
rewrite (plusAssociative (plus x v) (plus x v) v1); | ||
rewrite (plusCommutative v1 (plus x v)); | ||
rewrite sym (plusAssociative (plus x v) v1 (plus x v)); | ||
rewrite (plusAssociative (plus (plus x v) v1) (plus x v) v1); | ||
trivial; | ||
} | ||
|
||
main.adc_lemma_1 = proof { | ||
intros; | ||
rewrite sym (plusZeroRightNeutral c) ; | ||
trivial; | ||
} | ||
|