leancheck 0.9.10 → 0.9.12
raw patch · 50 files changed
+1461/−1496 lines, 50 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Test.LeanCheck.Core: tiersFloating :: Fractional a => [[a]]
- Test.LeanCheck.Core: tiersFractional :: Fractional a => [[a]]
+ Test.LeanCheck: listFloating :: (Ord a, Fractional a) => [a]
+ Test.LeanCheck: listFractional :: (Ord a, Fractional a) => [a]
+ Test.LeanCheck.Core: listFloating :: (Ord a, Fractional a) => [a]
+ Test.LeanCheck.Core: listFractional :: (Ord a, Fractional a) => [a]
+ Test.LeanCheck.Error: listFloating :: (Ord a, Fractional a) => [a]
+ Test.LeanCheck.Error: listFractional :: (Ord a, Fractional a) => [a]
- Test.LeanCheck: tiersFloating :: Fractional a => [[a]]
+ Test.LeanCheck: tiersFloating :: (Ord a, Fractional a) => [[a]]
- Test.LeanCheck: tiersFractional :: Fractional a => [[a]]
+ Test.LeanCheck: tiersFractional :: (Ord a, Fractional a) => [[a]]
- Test.LeanCheck.Error: tiersFloating :: Fractional a => [[a]]
+ Test.LeanCheck.Error: tiersFloating :: (Ord a, Fractional a) => [[a]]
- Test.LeanCheck.Error: tiersFractional :: Fractional a => [[a]]
+ Test.LeanCheck.Error: tiersFractional :: (Ord a, Fractional a) => [[a]]
Files
- .github/workflows/build.yml +16/−7
- Makefile +24/−4
- README.md +13/−12
- bench/dets.hs +18/−17
- bench/memory-usage.hs +1/−1
- bench/pick.hs +1/−1
- bench/tiers.hs +27/−25
- changelog.md +106/−40
- eg/higher-order.hs +4/−4
- eg/overflow.hs +5/−5
- eg/test-bool.hs +1/−1
- eg/test-float.hs +2/−2
- eg/test-list.hs +1/−1
- eg/test-sort.hs +4/−4
- etc/hugs-backports/Data/Function.hs +4/−3
- leancheck.cabal +8/−5
- src/Test/LeanCheck.hs +23/−0
- src/Test/LeanCheck/Basic.hs +7/−6
- src/Test/LeanCheck/Core.hs +40/−50
- src/Test/LeanCheck/Derive.hs +9/−9
- src/Test/LeanCheck/Error.hs +5/−7
- src/Test/LeanCheck/Function/Listable/ListsOfPairs.hs +1/−1
- src/Test/LeanCheck/Function/ListsOfPairs.hs +9/−9
- src/Test/LeanCheck/Function/Show.hs +1/−1
- src/Test/LeanCheck/Function/Show/EightLines.hs +2/−2
- src/Test/LeanCheck/Function/Show/FourCases.hs +1/−1
- src/Test/LeanCheck/Function/ShowFunction.hs +193/−182
- src/Test/LeanCheck/IO.hs +13/−5
- src/Test/LeanCheck/Stats.hs +11/−8
- src/Test/LeanCheck/Tiers.hs +23/−15
- src/Test/LeanCheck/Utils/Operators.hs +17/−6
- src/Test/LeanCheck/Utils/TypeBinding.hs +71/−63
- src/Test/LeanCheck/Utils/Types.hs +528/−463
- stack.yaml +1/−1
- test/Test.hs +53/−49
- test/derive.hs +34/−33
- test/diff/eg/test-float.out +9/−9
- test/diff/tiers-ComplexDouble.out +37/−228
- test/diff/tiers-Double.out +11/−40
- test/diff/tiers-Float.out +11/−40
- test/diff/tiers-Rational.out +10/−36
- test/error.hs +16/−16
- test/fun.hs +2/−2
- test/funshow.hs +5/−4
- test/generic.hs +31/−31
- test/main.hs +12/−13
- test/operators.hs +2/−2
- test/stats.hs +7/−6
- test/tiers.hs +24/−19
- test/types.hs +7/−7
.github/workflows/build.yml view
@@ -30,8 +30,10 @@ - run: du -hd3 ~/.cabal ~/.ghc || true - run: haddock --version || sudo apt-get install ghc-haddock- - run: ghc --version- - run: cabal --version+ - run: ghc --version+ - run: cabal --version+ - run: haddock --version+ - run: ghc-pkg list - name: Check out repository uses: actions/checkout@v2@@ -50,6 +52,8 @@ strategy: matrix: ghc:+ - '9.4'+ - '9.2' - '9.0' - '8.10' - '8.8'@@ -86,8 +90,10 @@ - run: make --version || apt-get update - run: make --version || apt-get install make - - run: ghc --version- - run: cabal --version+ - run: ghc --version+ - run: cabal --version+ - run: haddock --version+ - run: ghc-pkg list - name: Check out repository uses: actions/checkout@v2@@ -107,9 +113,9 @@ steps: - name: Setup Haskell's GHC and Cabal as required by current Stackage LTS uses: haskell/actions/setup@v1- with: # lts-17.9- ghc-version: '8.10.4'- cabal-version: '3.2'+ with: # lts-19.19+ ghc-version: '9.0.2'+ cabal-version: '3.4' - uses: actions/cache@v2 with:@@ -117,6 +123,8 @@ key: v1-${{ runner.os }}-stack-${{ hashFiles('stack.yaml') }} restore-keys: v1-${{ runner.os }}-stack- + - run: stack --version+ - name: Check out repository uses: actions/checkout@v2 - run: make test-via-stack@@ -125,6 +133,7 @@ runs-on: ubuntu-latest needs: build-and-test steps:+ - run: sudo apt-get update - run: sudo apt-get install hugs - name: Check out repository uses: actions/checkout@v2
Makefile view
@@ -29,7 +29,7 @@ bench/tiers-4cases \ bench/tiers GHCIMPORTDIRS = src:test-GHCFLAGS = -O2 $(shell grep -q "Arch Linux" /etc/lsb-release && echo -dynamic) \+GHCFLAGS = -v0 -O2 $(shell grep -q "Arch Linux" /etc/lsb-release && echo -dynamic) \ -W -fno-warn-unused-matches -Werror HUGSIMPORTDIRS = .:./src:./test:./etc/hugs-backports:/usr/lib/hugs/packages/* HUGSFLAGS = -98 -h32M@@ -62,11 +62,12 @@ # Evaluation order changed from GHC 8.4 to GHC 8.6, so we need to skip the # contents of the exception for test-list.diff-test.+# Exception is multiline starting with GHC 9.4, hence the 'tr' trick eg/test-list.diff-test: eg/test-list- ./$< | sed -e "s/Exception '[^']*'/Exception '...'/" | diff -rud test/diff/$<.out -+ ./$< | tr '\n' '\0' | sed -e "s/Exception '[^']*'/Exception '...'/" | tr '\0' '\n' | diff -rud test/diff/$<.out - eg/test-list.update-diff-test: eg/test-list- ./$< | sed -e "s/Exception '[^']*'/Exception '...'/" > test/diff/$<.out+ ./$< | tr '\n' '\0' | sed -e "s/Exception '[^']*'/Exception '...'/" | tr '\0' '\n' > test/diff/$<.out clean: clean-hi-o clean-haddock rm -f bench/tiers-default.hs@@ -105,7 +106,10 @@ test-via-stack: stack test leancheck:test:main --ghc-options="$(GHCFLAGS) -O0" --system-ghc --no-install-ghc --no-terminal -legacy-test: # needs ghc-8.8 .. ghc-7.8 installed as such+legacy-test: # needs ghc-9.4 .. ghc-7.8 installed as such+ make clean && make test -j GHC=ghc-9.4+ make clean && make test -j GHC=ghc-9.2+ make clean && make test -j GHC=ghc-9.0 make clean && make test -j GHC=ghc-8.8 make clean && make test -j GHC=ghc-8.6 make clean && make test -j GHC=ghc-8.4@@ -116,6 +120,9 @@ make clean && make test -j legacy-test-via-cabal: # needs similarly named cabal wrappers+ cabal clean && cabal-ghc-9.4 configure && cabal-ghc-9.4 test+ cabal clean && cabal-ghc-9.2 configure && cabal-ghc-9.2 test+ cabal clean && cabal-ghc-9.0 configure && cabal-ghc-9.0 test cabal clean && cabal-ghc-8.8 configure && cabal-ghc-8.8 test cabal clean && cabal-ghc-8.6 configure && cabal-ghc-8.6 test cabal clean && cabal-ghc-8.4 configure && cabal-ghc-8.4 test@@ -146,6 +153,19 @@ # actual Haskell source files mk/toplibs: mk/Toplibs.o touch mk/toplibs++# list lines that are longer than 80 characters+d=..........+e=$d$d$d$d$d$d$d$d+list-80:+ find src test bench eg -name "*.hs" | xargs grep -n --color -R "^$e." || true++# list = definitions surrounded by a single space+list-single-space-equals:+ find src test bench eg -name "*.hs" | xargs grep -n --color -R "[^ ] = [^ ]" || true++list-missing-copyright:+ find src test bench eg -name "*.hs" | xargs grep -LR Copyright || true include mk/haskell.mk
README.md view
@@ -24,27 +24,27 @@ expression is then printed on the following line. LeanCheck implementation is easy to understand.-[LeanCheck's core] is under 190 lines of code.+[LeanCheck's core] is under 200 lines of code. Installing ---------- -To install the latest LeanCheck version from Hackage using Cabal v3.0 or later, just run:-- $ cabal v1-update- $ cabal v1-install leancheck--If you are using a cabal earlier than v3.0, just run:+To install the [latest LeanCheck version from Hackage] just run: $ cabal update $ cabal install leancheck -With Cabal v3.0 or later,-[using `v1-install` is preferred for the time being.](https://github.com/haskell/cabal/issues/7373)-If all fails, you can start over by resetting your user's cabal installation-with:+Starting from Cabal v3.0, you need to pass `--lib` as an argument to+`cabal install` to install packages globally on the `default` user environment: + $ cabal install leancheck --lib++If you already have LeanCheck installed+[Cabal may refuse to update](https://github.com/haskell/cabal/issues/7373)+to the latest version.+To update, you need to reset your user's cabal installation with:+ rm -rf ~/.cabal/{bin,lib,logs,share,store} ~/.ghc/*/ WARNING: the above command will erase all user-local packages.@@ -249,6 +249,7 @@ [tutorial on property-based testing with LeanCheck]: https://github.com/rudymatela/leancheck/blob/master/doc/tutorial.md [LeanCheck memory usage]: https://github.com/rudymatela/leancheck/blob/master/doc/memory-usage.md [frequently asked questions]: https://github.com/rudymatela/leancheck/blob/master/doc/faq.md+[latest LeanCheck version from Hackage]: https://hackage.haskell.org/package/leancheck [`Listable`]: https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html#t:Listable [`holds`]: https://hackage.haskell.org/package/leancheck/docs/Test-LeanCheck.html#v:holds@@ -266,7 +267,7 @@ [Feat]: https://hackage.haskell.org/package/testing-feat [SmallCheck]: https://hackage.haskell.org/package/smallcheck [QuickCheck]: https://hackage.haskell.org/package/QuickCheck-[PhD Thesis (2017)]: https://matela.com.br/paper/rudy-phd-thesis-2017.pdf+[PhD Thesis (2017)]: https://matela.com.br/thesis-rudy.pdf [symbol `>`]: https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810780208 [Template Haskell]: https://wiki.haskell.org/Template_Haskell
bench/dets.hs view
@@ -71,8 +71,9 @@ | GetContents Name -- get_contents(Name) -> Objects deriving (Eq, Ord, Show, Read) --- NOTE: I couldn't find get_contents on the dets documentation, but it is listed on Hughes paper--- as one of the operations. Perhaps he implemented it using first and next.+-- NOTE: I couldn't find get_contents on the dets documentation, but it is+-- listed on Hughes paper as one of the operations.+-- Perhaps he implemented it using first and next. -- NOTE (2): I am admittedly cheating a bit -- by ommiting First and Next in@@ -82,7 +83,7 @@ data Program = Program [Op] [[Op]] deriving (Eq, Ord, Show, Read) -instance Listable Name where list = [A, B, C]+instance Listable Name where list = [A, B, C] -- This is an unoptimized generator as it will generate invalid programs like: --@@ -108,7 +109,7 @@ -- -------------|----------------- -- insert(a,[]) | insert_new(a,[]) bug1 :: Program-bug1 = Program+bug1 = Program [Open A] -- initialization [ [Insert A []] -- thread 1 , [InsertNew A []] -- thread 2@@ -118,7 +119,7 @@ -- ----------------|--------------------- -- insert(a,{0,0}) | insert_new(a,{0,0}) bug2 :: Program-bug2 = Program+bug2 = Program [Open A] [ [Insert A [(0,0)]] , [InsertNew A [(0,0)]]@@ -129,7 +130,7 @@ -- open(a) | insert(a,{0,0}) -- | get_contents(a) bug3 :: Program-bug3 = Program+bug3 = Program [Open A] [ [Open A] , [ Insert A [(0,0)]@@ -141,7 +142,7 @@ -- challenged me to find using LeanCheck -- after my PhD examination. (Rudy, 2017) bug4 :: Program-bug4 = Program+bug4 = Program [ Open A , Close A , Open A@@ -152,7 +153,7 @@ ] bug5 :: Program-bug5 = Program+bug5 = Program [ Open A , Insert A [(1,0)] ]@@ -164,19 +165,19 @@ prop1, prop2, prop3, prop4, prop5 :: Program -> Bool-prop1 p = p /= bug1-prop2 p = p /= bug2-prop3 p = p /= bug3-prop4 p = p /= bug4-prop5 p = p /= bug5+prop1 p = p /= bug1+prop2 p = p /= bug2+prop3 p = p /= bug3+prop4 p = p /= bug4+prop5 p = p /= bug5 main :: IO ()-main = do+main = do checkFor 200000 prop1 -- bug found after 88 410 tests checkFor 4000000 prop2 -- bug found after 2 044 950 tests- checkFor 2000000 prop3 -- bug not found, more tests and we go out of memory...- checkFor 2000000 prop4 -- bug not found, more tests and we go out of memory...- checkFor 2000000 prop5 -- bug not found, more tests and we go out of memory...+ checkFor 2000000 prop3 -- bug not found, more tests and we go out of memory+ checkFor 2000000 prop4 -- bug not found, more tests and we go out of memory+ checkFor 2000000 prop5 -- bug not found, more tests and we go out of memory -- If I recall correcly, John Hughes mentioned that each test took 3 seconds to -- run. That means LeanCheck would find the first bug after 3 days, and the
bench/memory-usage.hs view
@@ -18,7 +18,7 @@ evenOrOdd xs = all (\x -> odd x || even x) xs main :: IO ()-main = do+main = do -- With just the following 10 lines -- this program consumes around 500 Mb of memory.
bench/pick.hs view
@@ -33,7 +33,7 @@ ++ show ((list `asTypeOf` [u]) !! n) pick :: String -> Int -> IO ()-pick t n = case t of+pick t n = case t of "()" -> put t n (u :: () ) "Int" -> put t n (u :: Int ) "Nat" -> put t n (u :: Nat )
bench/tiers.hs view
@@ -15,44 +15,46 @@ import Data.Complex dropEmptyTiersTail :: [[a]] -> [[a]]-dropEmptyTiersTail ([]:[]:[]: []:[]:[]: _) = []-dropEmptyTiersTail (xs:xss) = xs:dropEmptyTiersTail xss-dropEmptyTiersTail [] = []+dropEmptyTiersTail ([]:[]:[]: []:[]:[]: _) = []+dropEmptyTiersTail (xs:xss) = xs:dropEmptyTiersTail xss+dropEmptyTiersTail [] = [] lengthT :: [[a]] -> Maybe Int-lengthT xss | finite xss' = Just . length $ concat xss'- | otherwise = Nothing- where xss' = dropEmptyTiersTail xss+lengthT xss | finite xss' = Just . length $ concat xss'+ | otherwise = Nothing+ where+ xss' = dropEmptyTiersTail xss allUnique :: Eq a => [a] -> Bool-allUnique [] = True-allUnique (x:xs) = x `notElem` xs- && allUnique (filter (/= x) xs)+allUnique [] = True+allUnique (x:xs) = x `notElem` xs+ && allUnique (filter (/= x) xs) countRepetitions :: Eq a => [a] -> Int-countRepetitions xs = length xs - length (nub xs)+countRepetitions xs = length xs - length (nub xs) ratioRepetitions :: Eq a => [a] -> Rational-ratioRepetitions [] = 0-ratioRepetitions xs = fromIntegral (countRepetitions xs) % fromIntegral (length xs)+ratioRepetitions [] = 0+ratioRepetitions xs = fromIntegral (countRepetitions xs)+ % fromIntegral (length xs) showLengthT :: [[a]] -> String-showLengthT xss = case lengthT xss of+showLengthT xss = case lengthT xss of Nothing -> "Infinity" Just x -> show x showDotsLongerThan :: Show a => Int -> [a] -> String-showDotsLongerThan n xs = "["- ++ intercalate "," (dotsLongerThan n $ map show xs)- ++ "]"+showDotsLongerThan n xs = "["+ ++ intercalate "," (dotsLongerThan n $ map show xs)+ ++ "]" where- dotsLongerThan n xs = take n xs ++ ["..." | not . null $ drop n xs]+ dotsLongerThan n xs = take n xs ++ ["..." | not . null $ drop n xs] printTiers :: Show a => Int -> [[a]] -> IO ()-printTiers n = putStrLn . init . unlines . map (" " ++) . lines . showTiers n+printTiers n = putStrLn . init . unlines . map (" " ++) . lines . showTiers n put :: (Show a, Eq a, Listable a) => String -> Int -> a -> IO ()-put t n a = do+put t n a = do putStrLn $ "map length (tiers :: [[ " ++ t ++ " ]]) = " ++ showDotsLongerThan n (map length $ tiers `asTypeOf` [[a]]) putStrLn $ ""@@ -69,15 +71,15 @@ printTiers n $ tiers `asTypeOf` [[a]] u :: a-u = undefined+u = undefined main :: IO ()-main = do+main = do as <- getArgs- let (t,n) = case as of- [] -> ("Int", 12)- [t] -> (t, 12)- (t:n:_) -> (t, read n)+ let (t,n) = case as of+ [] -> ("Int", 12)+ [t] -> (t, 12)+ (t:n:_) -> (t, read n) case t of -- simple types "()" -> put t n (u :: () )
changelog.md view
@@ -1,34 +1,51 @@ Changelog for LeanCheck ======================= -v0.9.10-------- +v0.9.12 (August 2022)+---------------------++* replace enumeration of `Fractional` and `Floating` types+ by the Calkin-Wilf sequence:+ - add `listFloating` and `listFractional`;+ - deprecate `tiersFloating` and `tiersFractional`;+* improve the changelog with timestamps and history down to v0.5.0;+* normalize code formatting throughout: indentation, spacing and width;+* improve testing of LeanCheck itself;+* test on GHC 9.2 and 9.4 (works with no changes).+++v0.9.10 (June 2021)+-------------------+ * `Test.LeanCheck.Utils.Type`: derive Typeable instances on GHC 7.8. Behaviour on newer GHCs (>= 7.10) versions is unaffected as they automatically derive Typeable instances for all types. -v0.9.8------- +v0.9.8 (June 2021)+------------------+ * `Test.LeanCheck.Utils.Type`: ~Typeable instances on GHC 7.10.~ ~Behaviour on newer GHCs (>= 8.0) versions is unaffected~ ~as they automatically derive Typeable instances for all types.~ _Update:_ these instances were already present on v0.9.6. LeanCheck v0.9.8 is essentially the same as v0.9.6. -v0.9.6------- +v0.9.6 (May 2021)+-----------------+ * no code changes in what is exported by `Test.LeanCheck` * `Test.LeanCheck.Utils.Types`: export the `A`, `B`, `C`, `D`, `E` and `F` types * slightly improve README * improve Makefile and tests * replace Travis by GitHub Actions as the CI system -v0.9.4------- +v0.9.4 (April 2021)+-------------------+ * no code changes in what is exported by `Test.LeanCheck` * add `errorToLeft` and `anyErrorToLeft` on `Test.LeanCheck.Error` * add `?==?` and `!==!` on `Test.LeanCheck.Error`@@ -38,16 +55,18 @@ * add FAQ * improve Makefile and test scripts -v0.9.3------- +v0.9.3 (March 2020)+-------------------+ * improve Haddock documentation * use consistent code format * improve CI scripts and Makefile -v0.9.2------- +v0.9.2 (March 2020)+-------------------+ * rename most functions on `Test.LeanCheck.Utils.Operators`; deprecated names are provided; * improve documentation:@@ -61,16 +80,16 @@ * update tests scripts to support the new cabal (`test/sdist`). -v0.9.1-------+v0.9.1 (February 2019)+---------------------- * fix bug in `genericTiers` where using it bound to a recursive datatype could cause an infinite loop; * minor improvements in documentation and tests. -v0.9.0-------+v0.9.0 (January 2019)+--------------------- * logo for LeanCheck; * `Listable` instances to most types in the Haskell 2010 Language Report:@@ -81,8 +100,8 @@ * minor improvements in documentation and README. -v0.8.0-------+v0.8.0 (November 2018)+---------------------- * export `tiersFractional` from `Core` and main module; * improve `Listable` instance for `Float`s and `Double`s;@@ -97,23 +116,23 @@ * improve tests of LeanCheck itself. -v0.7.7-------+v0.7.7 (October 2018)+--------------------- * Add a `changelog.md` file with the contents of git tag annotations: `git tag -ln99`. -v0.7.6-------+v0.7.6 (October 2018)+--------------------- * Add experimental `Test.LeanCheck.Generic` module with automatic derivation of Listable instances through `GHC.Generics`; * Improve Haddock documentation. -v0.7.5-------+v0.7.5 (September 2018)+----------------------- * Fix tests on systems with case-insensitive filesystems, like: - Windows;@@ -124,15 +143,15 @@ is otherwise unaffected. -v0.7.4-------+v0.7.4 (September 2018)+----------------------- * Add list of providers on README; * Minor fix in haddock. -v0.7.3-------+v0.7.3 (August 2018)+-------------------- * Fix bug: add missing Hugs backport file to source distribution (GHC users were not affected by this);@@ -140,15 +159,15 @@ (cabal sdist) again. -v0.7.2-------+v0.7.2 (August 2018)+-------------------- * Significantly improve documentation; * Slightly improve tests. -v0.7.1-------+v0.7.1 (July 2018)+------------------ * LeanCheck now works on Hugs-200607 (only minor changes were needed); * Implement functions that calculate statistics: `Test.LeanCheck.Stats`;@@ -158,8 +177,8 @@ * Minor assorted fixes. -v0.7.0-------+v0.7.0 (December 2017)+---------------------- * Improved cabal file; * Cabal package now has all files checked in on git repo;@@ -168,25 +187,72 @@ * Code improvements (refactoring). -v0.6.7-------+v0.6.7 (September 2017)+----------------------- The only change in relation to v0.6.6 is a fixed build on Travis (the reference output files were outdated). The code of the tool is otherwise unchanged. -v0.6.6-------+v0.6.6 (September 2017)+----------------------- * Improve showing of functional counter-examples. -v0.6.5-------+v0.6.5 (August 2017)+-------------------- * Export ordering from 'Test.LeanCheck.TypeBinding'; * Improve documentation; * Improve tests.+++v0.6.4 (August 2017)+--------------------++* Add and export the `Xs` constructor in `Utils`;+* Add type binding operators for up to 12 arguments.+++v0.6.3 (July 2017)+------------------++* `Test.LeanCheck`: Add the `delay` and `reset` functions;+* `Test.LeanCheck.Tiers`: `normalizeT` stripping up to 12 empty tiers;+* Some refactoring;+* Add lots of new tests for LeanCheck itself.+++v0.6.2 (March 2017)+-------------------++* Improve documentation;+* Improve tests of LeanCheck itself (including putting LeanCheck on CI).+++v0.6.1 (March 2017)+-------------------++* `Test.LeanCheck.Error`: export `fromError`;+* `Test.LeanCheck.Tiers`: export `mapMaybeT`, `maybeConsN` and `catMaybesT`;+* Some code refactoring and internal experiments with function enumeration.+++v0.6.0 (October 2016)+---------------------++* Add `deriveListableCascading`;+* Add `Listable` instances for `Word` and `Ordering`;+* Improve tests of LeanCheck itself.+++v0.5.0 (July 2016)+------------------++* Improve documentation;+* Rename several functions;+* Add several utilities in `Utils`. Earlier versions
eg/higher-order.hs view
@@ -5,7 +5,7 @@ import Test.LeanCheck import Test.LeanCheck.Function () -type A = Int+type A = Int prop_foldlr :: (A -> A -> A) -> A -> [A] -> Bool prop_foldlr f z xs = foldr f z xs == foldl f z xs@@ -18,13 +18,13 @@ prop_mapFilter f p xs = filter p (map f xs) == map f (filter p xs) prop_false :: (A -> A) -> (A -> A) -> Bool-prop_false _ _ = False+prop_false _ _ = False prop_false' :: (A -> A) -> (A,A) -> Bool-prop_false' _ _ = False+prop_false' _ _ = False main :: IO ()-main = do+main = do check prop_foldlr check prop_foldlr' check prop_mapFilter
eg/overflow.hs view
@@ -21,7 +21,7 @@ deriving Show toList :: T -> [[Int16]]-toList (T i j k l m) = [i,j,k,l,m]+toList (T i j k l m) = [i,j,k,l,m] pre :: T -> Bool pre t = all ((< 256) . sum) (toList t)@@ -33,10 +33,10 @@ prop t = pre t ==> post t instance Listable T where- tiers = cons5 makeT+ tiers = cons5 makeT where- makeT (Xs i) (Xs j) (Xs k) (Xs l) (Xs m) = T i j k l m+ makeT (Xs i) (Xs j) (Xs k) (Xs l) (Xs m) = T i j k l m main :: IO ()-main = do- checkFor 10000 $ prop+main = do+ checkFor 10000 prop
eg/test-bool.hs view
@@ -7,7 +7,7 @@ import Test.LeanCheck.Utils main :: IO ()-main = do+main = do putStrLn "not . not === id"; check $ isIdentity (not . not) putStrLn "(&&) commutes"; check $ isCommutative (&&) putStrLn "(||) commutes"; check $ isCommutative (||)
eg/test-float.hs view
@@ -5,7 +5,7 @@ import Test.LeanCheck main :: IO ()-main = do+main = do -- identities on floats -- some of these properties fail due to rounding errors checkFor n $ \x y -> not (isInfinite y) ==> x - y + y == (x::Float)@@ -21,4 +21,4 @@ checkFor n $ \x -> x >= 0 ==> (x ** 2) ** 0.5 == (x::Float) checkFor n $ \x -> x >= 0 ==> (x ** 0.5) ** 2 == (x::Float) where- n = 10000+ n = 10000
eg/test-list.hs view
@@ -6,7 +6,7 @@ import Data.List main :: IO ()-main = do+main = do -- three wrong properties about Data.List: check $ \xs ys -> xs `union` ys == ys `union` (xs :: [Int]) check $ \xs -> [head xs] == take 1 (xs :: [Int])
eg/test-sort.hs view
@@ -13,18 +13,18 @@ -- some properties about it -- prop_sortOrdered :: Ord a => [a] -> Bool-prop_sortOrdered xs = ordered (sort xs)+prop_sortOrdered xs = ordered (sort xs) where ordered (x:y:xs) = x <= y && ordered (y:xs) ordered _ = True prop_sortCount :: Ord a => a -> [a] -> Bool-prop_sortCount x xs = count x (sort xs) == count x xs+prop_sortCount x xs = count x (sort xs) == count x xs where- count x = length . filter (== x)+ count x = length . filter (== x) main :: IO ()-main = do+main = do check $ (prop_sortOrdered :: [Int] -> Bool) check $ (prop_sortCount :: Int -> [Int] -> Bool) check $ \xs -> sort (sort xs :: [Int]) == sort xs
etc/hugs-backports/Data/Function.hs view
@@ -1,12 +1,13 @@--- Copyright 2018-2020 Rudy Matela--- -- Backport of Data.Function for Hugs 2006-09. -- Only exports `on`+--+-- Copyright (c) 2018-2021 Rudy Matela.+-- Distributed under the 3-Clause BSD licence (see the file LICENSE). module Data.Function ( on ) where on :: (b -> b -> c) -> (a -> b) -> a -> a -> c-(.*.) `on` f = \x y -> f x .*. f y+(?) `on` f = \x y -> f x ? f y infixl 0 `on`
leancheck.cabal view
@@ -11,7 +11,7 @@ -- this cabal file too complicated. -- Rudy name: leancheck-version: 0.9.10+version: 0.9.12 synopsis: Enumerative property-based testing description: LeanCheck is a simple enumerative property-based testing library.@@ -24,7 +24,7 @@ LeanCheck works by producing tiers of test values: a possibly infinite list of finite sublists of same-and-increasingly-sized values. .- LeanCheck has lean core with only 180 lines of Haskell code.+ LeanCheck has lean core with only 200 lines of Haskell code. homepage: https://github.com/rudymatela/leancheck#readme license: BSD3@@ -70,7 +70,10 @@ , test/diff/*.out , test/diff/eg/*.out , test/sdist-tested-with: GHC==8.10+tested-with: GHC==9.4+ , GHC==9.2+ , GHC==9.0+ , GHC==8.10 , GHC==8.8 , GHC==8.6 , GHC==8.4@@ -80,7 +83,7 @@ , GHC==7.8 , GHC==7.6 , GHC==7.4-+ , Hugs==2006.9 source-repository head type: git@@ -89,7 +92,7 @@ source-repository this type: git location: https://github.com/rudymatela/leancheck- tag: v0.9.10+ tag: v0.9.12 library exposed-modules: Test.LeanCheck
src/Test/LeanCheck.hs view
@@ -138,6 +138,8 @@ -- ** Listing values , tiersFloating , tiersFractional+ , listFloating+ , listFractional , listIntegral , (+|) @@ -151,3 +153,24 @@ import Test.LeanCheck.Tiers import Test.LeanCheck.Derive import Test.LeanCheck.IO++-- | Tiers of 'Fractional' values.+-- This can be used as the implementation of 'tiers' for 'Fractional' types.+--+-- This function is deprecated. Please consider using 'listFractional' instead+-- or use 'toTiers' 'listFractional'.+tiersFractional :: (Ord a, Fractional a) => [[a]]+tiersFractional = toTiers listFractional++-- | Tiers of 'Floating' values.+-- This can be used as the implementation of 'tiers' for 'Floating' types.+--+-- This function is equivalent to 'tiersFractional'+-- with positive and negative infinities included: 1/0 and -1/0.+--+-- @NaN@ and @-0@ are excluded from this enumeration.+--+-- This function is deprecated. Please consider using 'listFloating' instead+-- or use 'toTiers' 'listFloating'.+tiersFloating :: (Ord a, Fractional a) => [[a]]+tiersFloating = toTiers listFloating
src/Test/LeanCheck/Basic.hs view
@@ -100,7 +100,8 @@ tiers tiers -- | Returns tiers of applications of a 6-argument constructor.-cons6 :: (Listable a, Listable b, Listable c, Listable d, Listable e, Listable f)+cons6 :: (Listable a, Listable b, Listable c,+ Listable d, Listable e, Listable f) => (a -> b -> c -> d -> e -> f -> g) -> [[g]] cons6 f = delay $ mapT (uncurry6 f) tiers @@ -180,8 +181,7 @@ -- > , ... -- > ] instance (Integral a, Listable a) => Listable (Ratio a) where- tiers = mapT (uncurry (%)) . reset- $ tiers `suchThat` (\(n,d) -> d > 0 && n `gcd` d == 1)+ list = listFractional instance (RealFloat a, Listable a) => Listable (Complex a) where tiers = cons2 (:+)@@ -243,8 +243,8 @@ instance Listable CUIntMax where list = listIntegral instance Listable CClock where list = listIntegral instance Listable CTime where list = listIntegral-instance Listable CFloat where tiers = tiersFloating-instance Listable CDouble where tiers = tiersFloating+instance Listable CFloat where list = listFloating+instance Listable CDouble where list = listFloating #if __GLASGOW_HASKELL__ >= 802 instance Listable CBool where list = listIntegral #endif@@ -257,7 +257,8 @@ -- -- > > list :: [ExitCode] -- > [ExitSuccess, ExitFailure 1, ExitFailure 2, ..., ExitFailure 255]-instance Listable ExitCode where list = ExitSuccess : map ExitFailure [1..255]+instance Listable ExitCode where+ list = ExitSuccess : map ExitFailure [1..255] instance Listable GeneralCategory where list = [minBound..maxBound]
src/Test/LeanCheck/Core.hs view
@@ -76,8 +76,8 @@ -- ** Misc utilities , (+|) , listIntegral- , tiersFractional- , tiersFloating+ , listFractional+ , listFloating ) where @@ -129,8 +129,9 @@ -- In this case, each sub-list in 'tiers' is a singleton list -- (each succeeding element of 'list' has +1 size). ----- The function 'Test.LeanCheck.Derive.deriveListable' from "Test.LeanCheck.Derive"--- can automatically derive instances of this typeclass.+-- The function 'Test.LeanCheck.Derive.deriveListable'+-- from "Test.LeanCheck.Derive" can automatically derive+-- instances of this typeclass. -- -- A 'Listable' instance for functions is also available but is not exported by -- default. Import "Test.LeanCheck.Function" if you need to test higher-order@@ -251,55 +252,44 @@ tiers = cons0 [] \/ cons2 (:) --- | Tiers of 'Fractional' values.--- This can be used as the implementation of 'tiers' for 'Fractional' types.+-- | Listing of 'Fractional' values.+-- This can be used as the implementation of 'list' for 'Fractional' types. ----- > tiersFractional :: [[Rational]] =--- > [ [ 0 % 1]--- > , [ 1 % 1]--- > , [(-1) % 1]--- > , [ 1 % 2, 2 % 1]--- > , [(-1) % 2, (-2) % 1]--- > , [ 1 % 3, 3 % 1]--- > , [(-1) % 3, (-3) % 1]--- > , [ 1 % 4, 2 % 3, 3 % 2, 4 % 1]--- > , [(-1) % 4, (-2) % 3, (-3) % 2, (-4) % 1]--- > , [ 1 % 5, 5 % 1]--- > , [(-1) % 5, (-5) % 1]--- > , [ 1 % 6, 2 % 5, 3 % 4, 4 % 3, 5 % 2, 6 % 1]--- > , [(-1) % 6, (-2) % 5, (-3) % 4, (-4) % 3, (-5) % 2, (-6) % 1]--- > , ...--- > ]-tiersFractional :: Fractional a => [[a]]-tiersFractional = mapT (\(x,y) -> fromInteger x / fromInteger y) . reset- $ tiers `suchThat` \(n,d) -> d > 0 && n `gcd` d == 1+-- > listFractional :: [[Rational]] =+-- > [0 % 1, 1 % 1, (-1) % 1, 1 % 2, (-1) % 2, 2 % 1, (-2) % 1, 1 % 3, ...]+--+-- All rationals are included without repetition in their most simple form.+-- This is the Calkin-Wilf sequence+-- computed with the help of the @fusc@ function (EWD 570).+--+-- This also works for unsigned types that wrap around zero, yielding:+--+-- > listFractional :: [Ratio Word] =+-- > [0 % 1, 1 % 1, 1 % 2, 2 % 1, 1 % 3, 3 % 2, 2 % 3, 3 % 1, 1 % 4, ...]+listFractional :: (Ord a, Fractional a) => [a]+listFractional = 0 : positives +| negatives+ where+ stern = map (fromInteger . fusc) [1..]+ positives = takeWhile (>0) $ zipWith (/) stern (tail stern)+ negatives = takeWhile (<0) $ map negate positives+ fusc = fu 1 0 where fu a b 0 = b+ fu a b n | even n = fu (a + b) b (n `div` 2)+ | otherwise = fu a (a + b) ((n-1) `div` 2) --- | Tiers of 'Floating' values.--- This can be used as the implementation of 'tiers' for 'Floating' types.+-- | Listing of 'Floating' values.+-- This can be used as the implementation of 'list' for 'Floating' types. ----- This function is equivalent to 'tiersFractional'--- with positive and negative infinities included: 1/0 and -1/0.+-- > listFloating :: [Double] =+-- > [0.0, 1.0, -1.0, 0.5, -0.5, 2.0, Infinity, -Infinity, -2.0, 0.333, ...] ----- > tiersFloating :: [[Float]] =--- > [ [0.0]--- > , [1.0]--- > , [-1.0, Infinity]--- > , [ 0.5, 2.0, -Infinity]--- > , [-0.5, -2.0]--- > , [ 0.33333334, 3.0]--- > , [-0.33333334, -3.0]--- > , [ 0.25, 0.6666667, 1.5, 4.0]--- > , [-0.25, -0.6666667, -1.5, -4.0]--- > , [ 0.2, 5.0]--- > , [-0.2, -5.0]--- > , [ 0.16666667, 0.4, 0.75, 1.3333334, 2.5, 6.0]--- > , [-0.16666667, -0.4, -0.75, -1.3333334, -2.5, -6.0]--- > , ...--- > ]+-- This follow the same Calkin-Wilf sequence of 'listFractional'+-- but positive and negative infinities are artificially included after two. ----- @NaN@ and @-0@ are excluded from this enumeration.-tiersFloating :: Fractional a => [[a]]-tiersFloating = tiersFractional \/ [ [], [], [1/0], [-1/0] {- , [-0], [0/0] -} ]+-- @NaN@ and @-0@ are excluded from this enumeration.+listFloating :: (Ord a, Fractional a) => [a]+listFloating = heading ++ [two, 1/0, -1/0] ++ etc+ where+ (heading,two:etc) = span (< 2) listFractional -- | @NaN@ and @-0@ are not included in the list of 'Float's. --@@ -312,13 +302,13 @@ -- > , ... -- > ] instance Listable Float where- tiers = tiersFloating+ list = listFloating -- | @NaN@ and @-0@ are not included in the list of 'Double's. -- -- > list :: [Double] = [0.0, 1.0, -1.0, Infinity, 0.5, 2.0, ...] instance Listable Double where- tiers = tiersFloating+ list = listFloating -- | > list :: [Ordering] = [LT, EQ, GT] instance Listable Ordering where
src/Test/LeanCheck/Derive.hs view
@@ -175,8 +175,8 @@ typeConArgs t = do is <- isTypeSynonym t if is- then liftM typeConTs $ typeSynonymType t- else liftM (nubMerges . map typeConTs . concat . map snd) $ typeConstructors t+ then liftM typeConTs $ typeSynonymType t+ else liftM (nubMerges . map typeConTs . concat . map snd) $ typeConstructors t where typeConTs :: Type -> [Name] typeConTs (AppT t1 t2) = typeConTs t1 `nubMerge` typeConTs t2@@ -225,7 +225,7 @@ newNames = mapM newName newVarTs :: Int -> Q [Type] newVarTs n = liftM (map VarT)- $ newNames (take n . map (:[]) $ cycle ['a'..'z'])+ $ newNames (take n . map (:[]) $ cycle ['a'..'z']) -- Normalizes a type by applying it to units (`()`) while possible. --@@ -276,17 +276,17 @@ -- Given a type name, returns a list of its type constructor names paired with -- the type arguments they take. ----- > typeConstructors ''() === Q [('(),[])]+-- > typeConstructors ''() = Q [('(),[])] ----- > typeConstructors ''(,) === Q [('(,),[VarT a, VarT b])]+-- > typeConstructors ''(,) = Q [('(,),[VarT a, VarT b])] ----- > typeConstructors ''[] === Q [('[],[]),('(:),[VarT a,AppT ListT (VarT a)])]+-- > typeConstructors ''[] = Q [('[],[]),('(:),[VarT a,AppT ListT (VarT a)])] -- -- > data Pair a = P a a--- > typeConstructors ''Pair === Q [('P,[VarT a, VarT a])]+-- > typeConstructors ''Pair = Q [('P,[VarT a, VarT a])] -- -- > data Point = Pt Int Int--- > typeConstructors ''Point === Q [('Pt,[ConT Int, ConT Int])]+-- > typeConstructors ''Point = Q [('Pt,[ConT Int, ConT Int])] typeConstructors :: Name -> Q [(Name,[Type])] typeConstructors t = do ti <- reify t@@ -304,7 +304,7 @@ simplify (NormalC n ts) = (n,map snd ts) simplify (RecC n ts) = (n,map trd ts) simplify (InfixC t1 n t2) = (n,[snd t1,snd t2])- simplify _ = error "Test.LeanCheck.Derive.typeConstructors: unhandled case (see source)"+ simplify _ = error "typeConstructors: unexpected unhandled case" trd (x,y,z) = z isTypeSynonym :: Name -> Q Bool
src/Test/LeanCheck/Error.hs view
@@ -139,9 +139,6 @@ #else (Right `liftM` evaluate x) `catch` (return . Left . show1st) #endif- where- show1st :: Show a => a -> String- show1st = concat . take 1 . lines . show -- | Transforms a value into 'Right' that value or 'Left String' on error. --@@ -151,13 +148,14 @@ anyErrorToLeft :: a -> Either String a anyErrorToLeft x = unsafePerformIO $ #if __GLASGOW_HASKELL__- (Right `liftM` evaluate x) `catch` (\e -> return . Left $ show1st (e :: SomeException))+ (Right `liftM` evaluate x)+ `catch` (\e -> return . Left $ show1st (e :: SomeException)) #else (Right `liftM` evaluate x) `catch` (return . Left . show1st) #endif- where- show1st :: Show a => a -> String- show1st = concat . take 1 . lines . show++show1st :: Show a => a -> String+show1st = concat . take 1 . lines . show -- | Transforms errors into 'False' values. --
src/Test/LeanCheck/Function/Listable/ListsOfPairs.hs view
@@ -18,4 +18,4 @@ import Test.LeanCheck.Function.ListsOfPairs instance (Eq a, Listable a, Listable b) => Listable (a -> b) where- tiers = tiers -->> tiers+ tiers = tiers -->> tiers
src/Test/LeanCheck/Function/ListsOfPairs.hs view
@@ -24,17 +24,17 @@ -- return tiers of functional values. (-->>) :: Eq a => [[a]] -> [[b]] -> [[a->b]] xss -->> yss- | finite xss = mapT ((undefined `mutate`) . zip (concat xss))- (products $ replicate (length $ concat xss) yss)- | otherwise = concatMapT- (\(r,yss) -> mapT (const r `mutate`) (exceptionPairs xss yss))- (choices yss)+ | finite xss = mapT ((undefined `mutate`) . zip (concat xss))+ (products $ replicate (length $ concat xss) yss)+ | otherwise = concatMapT (\(r,yss) -> mapT (const r `mutate`)+ (exceptionPairs xss yss))+ (choices yss) mutate :: Eq a => (a -> b) -> [(a,b)] -> (a -> b)-mutate f ms = foldr mut f ms+mutate f ms = foldr mut f ms where- mut (x',fx') f x = if x == x' then fx' else f x+ mut (x',fx') f x = if x == x' then fx' else f x -- | Given tiers of input values and tiers of output values,@@ -44,10 +44,10 @@ -- they represent exceptions to a constant function, -- hence the name 'exceptionPairs'. exceptionPairs :: [[a]] -> [[b]] -> [[ [(a,b)] ]]-exceptionPairs xss yss = concatMapT exceptionsFor (incompleteSetsOf xss)+exceptionPairs xss yss = concatMapT exceptionsFor (incompleteSetsOf xss) where --exceptionsFor :: [a] -> [[ [(a,b)] ]]- exceptionsFor xs = zip xs `mapT` products (const yss `map` xs)+ exceptionsFor xs = zip xs `mapT` products (const yss `map` xs) -- incompleteSetsOf is needed, instead of setsOf, because mutating *all* values -- of a constant function makes no sense (we would have already enumerated that -- function anyway). As of 2c23c1a, it makes no difference whether
src/Test/LeanCheck/Function/Show.hs view
@@ -70,7 +70,7 @@ -- > import Test.LeanCheck.Function.ShowFunction -- > -- > instance ShowFunction Ty where--- > bindtiers = bindtiersShow+-- > bindtiers = bindtiersShow module Test.LeanCheck.Function.Show () where import Test.LeanCheck.Function.Show.EightLines ()
src/Test/LeanCheck/Function/Show/EightLines.hs view
@@ -69,6 +69,6 @@ -- > (1,-1) -> 0 -- > ... instance (Show a, Listable a, ShowFunction b) => Show (a->b) where- showsPrec d f = showParen (d > 0 && '\n' `notElem` s) (s ++)+ showsPrec d f = showParen (d > 0 && '\n' `notElem` s) (s ++) where- s = showFunction 8 f+ s = showFunction 8 f
src/Test/LeanCheck/Function/Show/FourCases.hs view
@@ -50,4 +50,4 @@ -- > > print (+) -- > \x y -> case (x,y) of (0,0) -> 0; (0,1) -> 1; (1,0) -> 1; (0,-1) -> -1; ... instance (Show a, Listable a, ShowFunction b) => Show (a->b) where- showsPrec d = showParen (d>0) . (++) . showFunctionLine 4+ showsPrec d = showParen (d>0) . (++) . showFunctionLine 4
src/Test/LeanCheck/Function/ShowFunction.hs view
@@ -16,7 +16,7 @@ -- -- > import Test.LeanCheck.ShowFunction -- > instance (Show a, Listable a, ShowFunction b) => Show (a->b) where--- > show = showFunction 8+-- > show = showFunction 8 -- -- This shows functions as a case pattern with up to 8 cases. --@@ -76,22 +76,22 @@ import Data.List (sortBy) intercalate :: [a] -> [[a]] -> [a]-intercalate xs xss = concat (intersperse xs xss)+intercalate xs xss = concat (intersperse xs xss) where intersperse :: a -> [a] -> [a] intersperse _ [] = [] intersperse sep (x:xs) = x : prependToAll sep xs where- prependToAll :: a -> [a] -> [a]- prependToAll _ [] = []- prependToAll sep (x:xs) = sep : x : prependToAll sep xs+ prependToAll :: a -> [a] -> [a]+ prependToAll _ [] = []+ prependToAll sep (x:xs) = sep : x : prependToAll sep xs #endif -- | A functional binding in a showable format. -- Argument values are represented as a list of strings. -- The result value is represented by 'Just' a 'String' when defined -- or by 'Nothing' when 'undefined'.-type Binding = ([String], Maybe String)+type Binding = ([String], Maybe String) -- | 'ShowFunction' values are those for which -- we can return a list of functional bindings.@@ -99,7 +99,7 @@ -- Instances for 'show'able algebraic datatypes are defined using -- 'bindtiersShow': ----- > instance ShowFunction Ty where bindtiers = bindtiersShow+-- > instance ShowFunction Ty where bindtiers = bindtiersShow class ShowFunction a where bindtiers :: a -> [[Binding]] @@ -181,39 +181,43 @@ -- > , ... -- > ] bindings :: ShowFunction a => a -> [Binding]-bindings = concat . bindtiers+bindings = concat . bindtiers -- | A drop-in implementation of 'bindtiers' for 'show'able types. -- -- Define instances for 'show'able algebraic datatypes as: ----- > instance ShowFunction Ty where bindtiers = bindtiersShow+-- > instance ShowFunction Ty where bindtiers = bindtiersShow bindtiersShow :: Show a => a -> [[Binding]]-bindtiersShow x = [[([],errorToNothing $ show x)]]+bindtiersShow x = [[([],errorToNothing $ show x)]] -instance ShowFunction () where bindtiers = bindtiersShow-instance ShowFunction Bool where bindtiers = bindtiersShow-instance ShowFunction Int where bindtiers = bindtiersShow-instance ShowFunction Word where bindtiers = bindtiersShow-instance ShowFunction Integer where bindtiers = bindtiersShow-instance ShowFunction Char where bindtiers = bindtiersShow-instance ShowFunction Float where bindtiers = bindtiersShow-instance ShowFunction Double where bindtiers = bindtiersShow-instance ShowFunction Ordering where bindtiers = bindtiersShow-instance Show a => ShowFunction [a] where bindtiers = bindtiersShow-instance Show a => ShowFunction (Maybe a) where bindtiers = bindtiersShow-instance (Show a, Show b) => ShowFunction (Either a b) where bindtiers = bindtiersShow-instance (Show a, Show b) => ShowFunction (a,b) where bindtiers = bindtiersShow+instance ShowFunction () where bindtiers = bindtiersShow+instance ShowFunction Bool where bindtiers = bindtiersShow+instance ShowFunction Int where bindtiers = bindtiersShow+instance ShowFunction Word where bindtiers = bindtiersShow+instance ShowFunction Integer where bindtiers = bindtiersShow+instance ShowFunction Char where bindtiers = bindtiersShow+instance ShowFunction Float where bindtiers = bindtiersShow+instance ShowFunction Double where bindtiers = bindtiersShow+instance ShowFunction Ordering where bindtiers = bindtiersShow+instance Show a => ShowFunction [a] where bindtiers = bindtiersShow+instance Show a => ShowFunction (Maybe a) where bindtiers = bindtiersShow +instance (Show a, Show b) => ShowFunction (Either a b) where+ bindtiers = bindtiersShow++instance (Show a, Show b) => ShowFunction (a,b) where+ bindtiers = bindtiersShow+ -- instance for functional value type -- instance (Show a, Listable a, ShowFunction b) => ShowFunction (a->b) where- bindtiers f = concatMapT bindtiersFor tiers- where bindtiersFor x = mapFst (show x:) `mapT` bindtiers (f x)- mapFst f (x,y) = (f x, y)+ bindtiers f = concatMapT bindtiersFor tiers+ where bindtiersFor x = mapFst (show x:) `mapT` bindtiers (f x)+ mapFst f (x,y) = (f x, y) paren :: String -> String-paren s = "(" ++ s ++ ")"+paren s = "(" ++ s ++ ")" showTuple :: [String] -> String showTuple [x] = x@@ -221,20 +225,21 @@ | otherwise = paren $ intercalate "," xs showBindings :: [Binding] -> [String]-showBindings bs = [ showTuple as ++ " -> " ++ r | (as, Just r) <- bs ]+showBindings bs = [ showTuple as ++ " -> " ++ r | (as, Just r) <- bs ] showNBindings :: Bool -> Int -> [Binding] -> [String]-showNBindings infinite n bs' = take n bs ++ ["..." | infinite || length bs > n]+showNBindings infinite n bs' = take n bs+ ++ ["..." | infinite || length bs > n] where- bs = showBindings bs'+ bs = showBindings bs' isValue :: ShowFunction a => a -> Bool-isValue f = case bindings f of+isValue f = case bindings f of [([],_)] -> True _ -> False showValueOf :: ShowFunction a => a -> String-showValueOf x = case snd . head . bindings $ x of+showValueOf x = case snd . head . bindings $ x of Nothing -> "undefined" Just x' -> x' @@ -261,11 +266,11 @@ -- This can be used as an implementation of 'show' for functions: -- -- > instance (Show a, Listable a, ShowFunction b) => Show (a->b) where--- > show = showFunction 8+-- > show = showFunction 8 -- -- See 'showFunctionLine' for an alternative without line breaks. showFunction :: ShowFunction a => Int -> a -> String-showFunction n = showFunctionL False (n*n+1) n+showFunction n = showFunctionL False (n*n+1) n -- | Same as 'showFunction', but has no line breaks. --@@ -277,178 +282,182 @@ -- This can be used as an implementation of 'show' for functions: -- -- > instance (Show a, Listable a, ShowFunction b) => Show (a->b) where--- > show = showFunction 8+-- > show = showFunction 8 showFunctionLine :: ShowFunction a => Int -> a -> String-showFunctionLine n = showFunctionL True (n*n+1) n+showFunctionLine n = showFunctionL True (n*n+1) n -- | isUndefined checks if a function is totally undefined -- for the given maximum number of values isUndefined :: ShowFunction a => Int -> a -> Bool-isUndefined m = all (isNothing . snd) . take m . bindings+isUndefined m = all (isNothing . snd) . take m . bindings -- | checks if a function is constant -- for the given maximum number of values isConstant :: ShowFunction a => Int -> a -> Bool-isConstant m f = case take m $ bindings f of- [] -> False -- uninhabited type?- ((_,r'):bs) -> all (\(_,r) -> r == r') bs+isConstant m f = case take m $ bindings f of+ [] -> False -- uninhabited type?+ ((_,r'):bs) -> all (\(_,r) -> r == r') bs -- | shows a constant function showConstant :: ShowFunction a => Int -> a -> String-showConstant m f = "\\" ++ unwords vs ++ " -> " ++ fromMaybe "undefined" r+showConstant m f = "\\" ++ unwords vs ++ " -> " ++ fromMaybe "undefined" r where- (as,r) = head $ bindings f- vs = replicate (length as) "_"+ (as,r) = head $ bindings f+ vs = replicate (length as) "_" -- The first boolean parameter tells if we are showing -- the function on a single line showFunctionL :: ShowFunction a => Bool -> Int -> Int -> a -> String-showFunctionL singleLine m n f | isValue f = showValueOf f-showFunctionL singleLine m n f | isConstant m f = showConstant m f---showFunctionL singleLine m n f | canName m f = showName m f-showFunctionL singleLine m n f | otherwise = lambdaPat ++ caseExp+showFunctionL singleLine m n f | isValue f = showValueOf f+showFunctionL singleLine m n f | isConstant m f = showConstant m f+--showFunctionL singleLine m n f | canName m f = showName m f+showFunctionL singleLine m n f | otherwise = lambdaPat ++ caseExp where- lambdaPat = "\\" ++ unwords vs ++ " -> "- casePat = "case " ++ showTuple (filter (/= "_") vs) ++ " of"- (vs, bindings) = clarifiedBindings m n f- bs = showNBindings (length bindings >= m) n bindings- sep | singleLine = " "- | otherwise = "\n"- cases | singleLine = intercalate "; " bs- | otherwise = unlines+ lambdaPat = "\\" ++ unwords vs ++ " -> "+ casePat = "case " ++ showTuple (filter (/= "_") vs) ++ " of"+ (vs, bindings) = clarifiedBindings m n f+ bs = showNBindings (length bindings >= m) n bindings+ sep | singleLine = " "+ | otherwise = "\n"+ cases | singleLine = intercalate "; " bs+ | otherwise = unlines $ (replicate (length lambdaPat) ' ' ++) `map` bs- caseExp = if isUndefined m f+ caseExp = if isUndefined m f then "undefined" else casePat ++ sep ++ cases -- instances for further tuple arities -- instance (Show a, Show b, Show c)- => ShowFunction (a,b,c) where bindtiers = bindtiersShow+ => ShowFunction (a,b,c) where bindtiers = bindtiersShow instance (Show a, Show b, Show c, Show d)- => ShowFunction (a,b,c,d) where bindtiers = bindtiersShow+ => ShowFunction (a,b,c,d) where bindtiers = bindtiersShow instance (Show a, Show b, Show c, Show d, Show e)- => ShowFunction (a,b,c,d,e) where bindtiers = bindtiersShow+ => ShowFunction (a,b,c,d,e) where bindtiers = bindtiersShow #ifndef __HUGS__ instance (Show a, Show b, Show c, Show d, Show e, Show f)- => ShowFunction (a,b,c,d,e,f) where bindtiers = bindtiersShow+ => ShowFunction (a,b,c,d,e,f) where bindtiers = bindtiersShow instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g)- => ShowFunction (a,b,c,d,e,f,g) where bindtiers = bindtiersShow+ => ShowFunction (a,b,c,d,e,f,g) where bindtiers = bindtiersShow instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h)- => ShowFunction (a,b,c,d,e,f,g,h) where bindtiers = bindtiersShow+ => ShowFunction (a,b,c,d,e,f,g,h) where bindtiers = bindtiersShow instance ( Show a, Show b, Show c, Show d , Show e, Show f, Show g, Show h , Show i )- => ShowFunction (a,b,c,d,e,f,g,h,i) where bindtiers = bindtiersShow+ => ShowFunction (a,b,c,d,e,f,g,h,i) where bindtiers = bindtiersShow instance ( Show a, Show b, Show c, Show d , Show e, Show f, Show g, Show h , Show i, Show j )- => ShowFunction (a,b,c,d,e,f,g,h,i,j) where bindtiers = bindtiersShow+ => ShowFunction (a,b,c,d,e,f,g,h,i,j) where bindtiers = bindtiersShow instance ( Show a, Show b, Show c, Show d , Show e, Show f, Show g, Show h , Show i, Show j, Show k )- => ShowFunction (a,b,c,d,e,f,g,h,i,j,k) where bindtiers = bindtiersShow+ => ShowFunction (a,b,c,d,e,f,g,h,i,j,k) where bindtiers = bindtiersShow instance ( Show a, Show b, Show c, Show d , Show e, Show f, Show g, Show h , Show i, Show j, Show k, Show l )- => ShowFunction (a,b,c,d,e,f,g,h,i,j,k,l) where bindtiers = bindtiersShow+ => ShowFunction (a,b,c,d,e,f,g,h,i,j,k,l) where+ bindtiers = bindtiersShow #endif -- Data.Ratio-instance (Integral a, Show a) => ShowFunction (Ratio a) where bindtiers = bindtiersShow+instance (Integral a, Show a) => ShowFunction (Ratio a) where+ bindtiers = bindtiersShow -- Data.Complex-instance (RealFloat a, Show a) => ShowFunction (Complex a) where bindtiers = bindtiersShow+instance (RealFloat a, Show a) => ShowFunction (Complex a) where+ bindtiers = bindtiersShow -- instance for types from Data.Int and Data.Word-instance ShowFunction Int8 where bindtiers = bindtiersShow-instance ShowFunction Int16 where bindtiers = bindtiersShow-instance ShowFunction Int32 where bindtiers = bindtiersShow-instance ShowFunction Int64 where bindtiers = bindtiersShow-instance ShowFunction Word8 where bindtiers = bindtiersShow-instance ShowFunction Word16 where bindtiers = bindtiersShow-instance ShowFunction Word32 where bindtiers = bindtiersShow-instance ShowFunction Word64 where bindtiers = bindtiersShow+instance ShowFunction Int8 where bindtiers = bindtiersShow+instance ShowFunction Int16 where bindtiers = bindtiersShow+instance ShowFunction Int32 where bindtiers = bindtiersShow+instance ShowFunction Int64 where bindtiers = bindtiersShow+instance ShowFunction Word8 where bindtiers = bindtiersShow+instance ShowFunction Word16 where bindtiers = bindtiersShow+instance ShowFunction Word32 where bindtiers = bindtiersShow+instance ShowFunction Word64 where bindtiers = bindtiersShow -- instance for types from Test.LeanCheck.Utils.Types-instance ShowFunction Nat where bindtiers = bindtiersShow-instance ShowFunction Nat1 where bindtiers = bindtiersShow-instance ShowFunction Nat2 where bindtiers = bindtiersShow-instance ShowFunction Nat3 where bindtiers = bindtiersShow-instance ShowFunction Nat4 where bindtiers = bindtiersShow-instance ShowFunction Nat5 where bindtiers = bindtiersShow-instance ShowFunction Nat6 where bindtiers = bindtiersShow-instance ShowFunction Nat7 where bindtiers = bindtiersShow-instance ShowFunction Int1 where bindtiers = bindtiersShow-instance ShowFunction Int2 where bindtiers = bindtiersShow-instance ShowFunction Int3 where bindtiers = bindtiersShow-instance ShowFunction Int4 where bindtiers = bindtiersShow-instance ShowFunction Word1 where bindtiers = bindtiersShow-instance ShowFunction Word2 where bindtiers = bindtiersShow-instance ShowFunction Word3 where bindtiers = bindtiersShow-instance ShowFunction Word4 where bindtiers = bindtiersShow+instance ShowFunction Nat where bindtiers = bindtiersShow+instance ShowFunction Nat1 where bindtiers = bindtiersShow+instance ShowFunction Nat2 where bindtiers = bindtiersShow+instance ShowFunction Nat3 where bindtiers = bindtiersShow+instance ShowFunction Nat4 where bindtiers = bindtiersShow+instance ShowFunction Nat5 where bindtiers = bindtiersShow+instance ShowFunction Nat6 where bindtiers = bindtiersShow+instance ShowFunction Nat7 where bindtiers = bindtiersShow+instance ShowFunction Int1 where bindtiers = bindtiersShow+instance ShowFunction Int2 where bindtiers = bindtiersShow+instance ShowFunction Int3 where bindtiers = bindtiersShow+instance ShowFunction Int4 where bindtiers = bindtiersShow+instance ShowFunction Word1 where bindtiers = bindtiersShow+instance ShowFunction Word2 where bindtiers = bindtiersShow+instance ShowFunction Word3 where bindtiers = bindtiersShow+instance ShowFunction Word4 where bindtiers = bindtiersShow -instance ShowFunction Natural where bindtiers = bindtiersShow+instance ShowFunction Natural where bindtiers = bindtiersShow -instance ShowFunction Letter where bindtiers = bindtiersShow-instance ShowFunction AlphaNum where bindtiers = bindtiersShow-instance ShowFunction Digit where bindtiers = bindtiersShow-instance ShowFunction Alpha where bindtiers = bindtiersShow-instance ShowFunction Upper where bindtiers = bindtiersShow-instance ShowFunction Lower where bindtiers = bindtiersShow-instance ShowFunction Space where bindtiers = bindtiersShow+instance ShowFunction Letter where bindtiers = bindtiersShow+instance ShowFunction AlphaNum where bindtiers = bindtiersShow+instance ShowFunction Digit where bindtiers = bindtiersShow+instance ShowFunction Alpha where bindtiers = bindtiersShow+instance ShowFunction Upper where bindtiers = bindtiersShow+instance ShowFunction Lower where bindtiers = bindtiersShow+instance ShowFunction Space where bindtiers = bindtiersShow -instance ShowFunction Spaces where bindtiers = bindtiersShow-instance ShowFunction Lowers where bindtiers = bindtiersShow-instance ShowFunction Uppers where bindtiers = bindtiersShow-instance ShowFunction Alphas where bindtiers = bindtiersShow-instance ShowFunction Digits where bindtiers = bindtiersShow-instance ShowFunction AlphaNums where bindtiers = bindtiersShow-instance ShowFunction Letters where bindtiers = bindtiersShow+instance ShowFunction Spaces where bindtiers = bindtiersShow+instance ShowFunction Lowers where bindtiers = bindtiersShow+instance ShowFunction Uppers where bindtiers = bindtiersShow+instance ShowFunction Alphas where bindtiers = bindtiersShow+instance ShowFunction Digits where bindtiers = bindtiersShow+instance ShowFunction AlphaNums where bindtiers = bindtiersShow+instance ShowFunction Letters where bindtiers = bindtiersShow -instance Show a => ShowFunction (X a) where bindtiers = bindtiersShow-instance Show a => ShowFunction (Xs a) where bindtiers = bindtiersShow-instance Show a => ShowFunction (Set a) where bindtiers = bindtiersShow-instance Show a => ShowFunction (Bag a) where bindtiers = bindtiersShow-instance Show a => ShowFunction (NoDup a) where bindtiers = bindtiersShow-instance (Show a, Show b) => ShowFunction (Map a b) where bindtiers = bindtiersShow+instance Show a => ShowFunction (X a) where bindtiers = bindtiersShow+instance Show a => ShowFunction (Xs a) where bindtiers = bindtiersShow+instance Show a => ShowFunction (Set a) where bindtiers = bindtiersShow+instance Show a => ShowFunction (Bag a) where bindtiers = bindtiersShow+instance Show a => ShowFunction (NoDup a) where bindtiers = bindtiersShow+instance (Show a, Show b) => ShowFunction (Map a b) where+ bindtiers = bindtiersShow -- misc instances-instance ShowFunction ExitCode where bindtiers = bindtiersShow-instance ShowFunction SeekMode where bindtiers = bindtiersShow-instance ShowFunction IOMode where bindtiers = bindtiersShow-instance ShowFunction BufferMode where bindtiers = bindtiersShow-instance ShowFunction GeneralCategory where bindtiers = bindtiersShow+instance ShowFunction ExitCode where bindtiers = bindtiersShow+instance ShowFunction SeekMode where bindtiers = bindtiersShow+instance ShowFunction IOMode where bindtiers = bindtiersShow+instance ShowFunction BufferMode where bindtiers = bindtiersShow+instance ShowFunction GeneralCategory where bindtiers = bindtiersShow -- instances for Foreign.C types-instance ShowFunction CChar where bindtiers = bindtiersShow-instance ShowFunction CSChar where bindtiers = bindtiersShow-instance ShowFunction CUChar where bindtiers = bindtiersShow-instance ShowFunction CShort where bindtiers = bindtiersShow-instance ShowFunction CUShort where bindtiers = bindtiersShow-instance ShowFunction CInt where bindtiers = bindtiersShow-instance ShowFunction CUInt where bindtiers = bindtiersShow-instance ShowFunction CLong where bindtiers = bindtiersShow-instance ShowFunction CULong where bindtiers = bindtiersShow-instance ShowFunction CPtrdiff where bindtiers = bindtiersShow-instance ShowFunction CSize where bindtiers = bindtiersShow-instance ShowFunction CWchar where bindtiers = bindtiersShow-instance ShowFunction CSigAtomic where bindtiers = bindtiersShow-instance ShowFunction CLLong where bindtiers = bindtiersShow-instance ShowFunction CULLong where bindtiers = bindtiersShow-instance ShowFunction CIntPtr where bindtiers = bindtiersShow-instance ShowFunction CUIntPtr where bindtiers = bindtiersShow-instance ShowFunction CIntMax where bindtiers = bindtiersShow-instance ShowFunction CUIntMax where bindtiers = bindtiersShow-instance ShowFunction CClock where bindtiers = bindtiersShow-instance ShowFunction CTime where bindtiers = bindtiersShow-instance ShowFunction CFloat where bindtiers = bindtiersShow-instance ShowFunction CDouble where bindtiers = bindtiersShow+instance ShowFunction CChar where bindtiers = bindtiersShow+instance ShowFunction CSChar where bindtiers = bindtiersShow+instance ShowFunction CUChar where bindtiers = bindtiersShow+instance ShowFunction CShort where bindtiers = bindtiersShow+instance ShowFunction CUShort where bindtiers = bindtiersShow+instance ShowFunction CInt where bindtiers = bindtiersShow+instance ShowFunction CUInt where bindtiers = bindtiersShow+instance ShowFunction CLong where bindtiers = bindtiersShow+instance ShowFunction CULong where bindtiers = bindtiersShow+instance ShowFunction CPtrdiff where bindtiers = bindtiersShow+instance ShowFunction CSize where bindtiers = bindtiersShow+instance ShowFunction CWchar where bindtiers = bindtiersShow+instance ShowFunction CSigAtomic where bindtiers = bindtiersShow+instance ShowFunction CLLong where bindtiers = bindtiersShow+instance ShowFunction CULLong where bindtiers = bindtiersShow+instance ShowFunction CIntPtr where bindtiers = bindtiersShow+instance ShowFunction CUIntPtr where bindtiers = bindtiersShow+instance ShowFunction CIntMax where bindtiers = bindtiersShow+instance ShowFunction CUIntMax where bindtiers = bindtiersShow+instance ShowFunction CClock where bindtiers = bindtiersShow+instance ShowFunction CTime where bindtiers = bindtiersShow+instance ShowFunction CFloat where bindtiers = bindtiersShow+instance ShowFunction CDouble where bindtiers = bindtiersShow #if __GLASGOW_HASKELL__ >= 802-instance ShowFunction CBool where bindtiers = bindtiersShow+instance ShowFunction CBool where bindtiers = bindtiersShow #endif #if __GLASGOW_HASKELL__-instance ShowFunction CUSeconds where bindtiers = bindtiersShow-instance ShowFunction CSUSeconds where bindtiers = bindtiersShow+instance ShowFunction CUSeconds where bindtiers = bindtiersShow+instance ShowFunction CSUSeconds where bindtiers = bindtiersShow #endif -- | Returns a set of variables and a set of bindings@@ -475,31 +484,31 @@ -- > ( ["x"], [ (["1"],Just "True"), -- > , (["_"],Just "False") ] ) ----- * When some arguments are unused, they are omitted in the list of bindings and--- appear as @"_"@ in the list of variables.+-- * When some arguments are unused, they are omitted in the list of bindings+-- and appear as @"_"@ in the list of variables. -- -- > > clarifiedBindings 100 10 (\_ y -> y == 1) -- > ( ["_", "y"], [ (["1"],Just "True") -- > , (["_"],Just "False") ] ) clarifiedBindings :: ShowFunction a => Int -> Int -> a -> ([String],[Binding])-clarifiedBindings m n = clarifyBindings . describedBindings m n+clarifiedBindings m n = clarifyBindings . describedBindings m n clarifyBindings :: [Binding] -> ([String],[Binding]) clarifyBindings bs = (varnamesByUsage used, map (mapFst $ select used) bs) where- mapFst f (x,y) = (f x, y)- used = usedArgs bs+ mapFst f (x,y) = (f x, y)+ used = usedArgs bs varnamesByUsage :: [Bool] -> [String]-varnamesByUsage = zipWith used varnames+varnamesByUsage = zipWith used varnames where- used s False = "_"- used s True = s- varnames = ["x","y","z","w"] ++ map (++"'") varnames+ used s False = "_"+ used s True = s+ varnames = ["x","y","z","w"] ++ map (++"'") varnames usedArgs :: [Binding] -> [Bool]-usedArgs = foldr1 (zipWith (||))- . map (map (/= "_") . fst)+usedArgs = foldr1 (zipWith (||))+ . map (map (/= "_") . fst) -- | Returns a set of bindings describing how a function works. -- Some argument values are generalized to "@_@" when possible.@@ -555,7 +564,7 @@ bs1 = describeBindings bs0 describeBindings :: [Binding] -> [Binding]-describeBindings bs = head $ sortOn length $+describeBindings bs = head $ sortOn length $ [ bs , explainBindings bs , explainBindings . concat . sortOn length $ classifyOn snd bs@@ -601,9 +610,10 @@ -- > [ (["0"],Just "True") -- > , (["_"],Just "False") ] ----- * Generalization for each item is processed in the order they are generated by 'bindings'--- hence explanations are not always the shortest possible (cf. 'describedBindings').--- In the following examples, the first case is redundant.+-- * Generalization for each item is processed in the order they are generated+-- by 'bindings' hence explanations are not always the shortest possible+-- (cf. 'describedBindings'). In the following examples, the first case is+-- redundant. -- -- > > explainedBindings 10 (==1) -- > [ (["0"],Just "False")@@ -615,24 +625,25 @@ -- > , (["_","1"],Just "True") -- > , (["_","_"],Just "False") ] explainedBindings :: ShowFunction a => Int -> a -> [Binding]-explainedBindings m = explainBindings . take m . bindings+explainedBindings m = explainBindings . take m . bindings explainBindings :: [Binding] -> [Binding]-explainBindings = explain []+explainBindings = explain [] where explain :: [Binding] -> [Binding] -> [Binding] explain bs' [] = reverse bs'- explain bs' ((as,r):bs) = explain (bs''++bs') [b | b <- bs, none (b <~~) bs'']+ explain bs' ((as,r):bs) = explain (bs''++bs') [b | b <- bs+ , none (b <~~) bs''] where- bs'' = discardLater (<~~)- [ (gas,r) | gas <- generalizations as- , and [r' == r | (as',r') <- bs, as' <~ gas] ]+ bs'' = discardLater (<~~)+ [ (gas,r) | gas <- generalizations as+ , and [r' == r | (as',r') <- bs, as' <~ gas] ] generalizations :: [String] -> [[String]]-generalizations [] = [[]]-generalizations (v:vs) = map ("_":) gvs ++ map (v:) gvs+generalizations [] = [[]]+generalizations (v:vs) = map ("_":) gvs ++ map (v:) gvs where- gvs = generalizations vs+ gvs = generalizations vs -- | Should be read as "is generalized by": --@@ -645,35 +656,35 @@ -- > > ["_","3"] <~ ["_","4"] -- > False (<~) :: [String] -> [String] -> Bool-[] <~ [] = True-(v:vs) <~ ("_":ws) = vs <~ ws-(v:vs) <~ (w:ws) = v == w && vs <~ ws-_ <~ _ = False+[] <~ [] = True+(v:vs) <~ ("_":ws) = vs <~ ws+(v:vs) <~ (w:ws) = v == w && vs <~ ws+_ <~ _ = False -- | Should be read as "is generalized by". (<~~) :: Binding -> Binding -> Bool-(as,r) <~~ (as',r') = as <~ as' && r == r'+(as,r) <~~ (as',r') = as <~ as' && r == r' -- general auxiliary functions discard :: (a -> Bool) -> [a] -> [a]-discard p = filter (not . p)+discard p = filter (not . p) discardLater :: (a -> a -> Bool) -> [a] -> [a]-discardLater (?>) = dl+discardLater (?>) = dl where- dl [] = []- dl (x:xs) = x : discard (?> x) (dl xs)+ dl [] = []+ dl (x:xs) = x : discard (?> x) (dl xs) none :: (a -> Bool) -> [a] -> Bool-none p = not . any p+none p = not . any p -- sortOn is only available on GHC > 7.8 sortOn :: Ord b => (a -> b) -> [a] -> [a]-sortOn f = sortBy (compare `on` f)+sortOn f = sortBy (compare `on` f) select :: [Bool] -> [a] -> [a]-select [] _ = []-select _ [] = []-select (p:ps) (x:xs) = if p then x : xs' else xs' where xs' = select ps xs+select [] _ = []+select _ [] = []+select (p:ps) (x:xs) = if p then x : xs' else xs' where xs' = select ps xs
src/Test/LeanCheck/IO.hs view
@@ -46,6 +46,12 @@ -- -- > > checkFor 1000 $ \xs -> sort (sort xs) == sort (xs::[Int]) -- > +++ OK, passed 1000 tests.+--+-- Test exhaustion is reported when the configured number of tests+-- is larger than the number of available test values:+--+-- > > checkFor 3 $ \p -> p == not (not p)+-- > +++ OK, passed 2 tests (exhausted). checkFor :: Testable a => Int -> a -> IO () checkFor n p = checkResultFor n p >> return () @@ -66,7 +72,7 @@ -- There is no option to silence this function: -- for silence, you should use 'Test.LeanCheck.holds'. checkResult :: Testable a => a -> IO Bool-checkResult p = checkResultFor 200 p+checkResult = checkResultFor 200 -- | Check a property for a given number of tests -- printing results on 'System.IO.stdout' and@@ -104,7 +110,7 @@ resultIO :: Testable a => Int -> a -> IO Result resultIO n = computeResult . resultsIO n where- computeResult [] = error "resultIO: no results, empty Listable enumeration?"+ computeResult [] = error "resultIO: no results, empty Listable enumeration?" computeResult [r] = r computeResult (r:rs) = r >>= \r -> case r of (OK _) -> computeResult rs@@ -112,11 +118,13 @@ showResult :: Int -> Result -> String showResult m (OK n) = "+++ OK, passed " ++ show n ++ " tests"- ++ takeWhile (\_ -> n < m) " (exhausted)" ++ "."+ ++ takeWhile (\_ -> n < m) " (exhausted)"+ ++ "." showResult m (Falsified i ce) = "*** Failed! Falsifiable (after " ++ show i ++ " tests):\n" ++ joinArgs ce-showResult m (Exception i ce e) = "*** Failed! Exception '" ++ e ++ "' (after "- ++ show i ++ " tests):\n" ++ joinArgs ce+showResult m (Exception i ce e) = "*** Failed! Exception '" ++ e+ ++ "' (after " ++ show i ++ " tests):\n"+ ++ joinArgs ce -- joins the counter-example arguments joinArgs :: [String] -> String
src/Test/LeanCheck/Stats.hs view
@@ -132,10 +132,10 @@ where xs = take n list len = length xs- show1 (s,f) = let c = count f xs- in [ s ++ ":"- , show c ++ "/" ++ show len- , show (100 * c `div` len) ++ "%" ]+ show1 (s,f) = [ s ++ ":"+ , show c ++ "/" ++ show len+ , show (100 * c `div` len) ++ "%"+ ] where c = count f xs count f = length . filter f -- | Same as 'conditionStats' but by tier.@@ -155,7 +155,10 @@ -- > total: 1 1 2 4 8 16 32 64 128 256 -- > ordered: 1 1 2 3 5 7 11 15 22 30 conditionStatsT :: Listable a => Int -> [(String,a->Bool)] -> IO ()-conditionStatsT n = putStrLn . table " " . map show1 . (("total", const True):)+conditionStatsT n = putStrLn+ . table " "+ . map show1+ . (("total", const True):) where xss = take n tiers show1 (s,f) = (s ++ ":") : map (show . count f) xss@@ -179,7 +182,7 @@ classifyBy :: (a -> a -> Bool) -> [a] -> [[a]] classifyBy (==) [] = [] classifyBy (==) (x:xs) = (x:filter (== x) xs)- : classifyBy (==) (filter (/= x) xs)+ : classifyBy (==) (filter (/= x) xs) where x /= y = not (x == y) @@ -194,8 +197,8 @@ -- (cf. 'classify', 'classifyBy') classifyOn :: Eq b => (a -> b) -> [a] -> [[a]] classifyOn f xs = map (map fst)- . classifyBy ((==) `on` snd)- $ map (\x -> (x,f x)) xs+ . classifyBy ((==) `on` snd)+ $ map (\x -> (x,f x)) xs -- | Returns the counts of each value in a list. --
src/Test/LeanCheck/Tiers.hs view
@@ -418,11 +418,13 @@ -- | Like 'choices', but allows a custom function. choicesWith :: (a -> [[a]] -> b) -> [[a]] -> [[b]]-choicesWith f [] = []-choicesWith f [[]] = []-choicesWith f ([]:xss) = [] : choicesWith (\y yss -> f y ([]:normalizeT yss)) xss-choicesWith f ((x:xs):xss) = [[f x (xs:xss)]]- \/ choicesWith (\y (ys:yss) -> f y ((x:ys):yss)) (xs:xss)+choicesWith f [] = []+choicesWith f [[]] = []+choicesWith f ([]:xss)+ = [] : choicesWith (\y yss -> f y ([]:normalizeT yss)) xss+choicesWith f ((x:xs):xss)+ = [[f x (xs:xss)]]+ \/ choicesWith (\y (ys:yss) -> f y ((x:ys):yss)) (xs:xss) -- | Like 'choices' but lists tiers of non-decreasing (ascending) choices. -- Used to construct 'bagsOf' values.@@ -442,11 +444,14 @@ -- | Like 'bagChoices' but customized by a function. bagChoicesWith :: (a -> [[a]] -> b) -> [[a]] -> [[b]]-bagChoicesWith f [] = []-bagChoicesWith f [[]] = []-bagChoicesWith f ([]:xss) = [] : bagChoicesWith (\y yss -> f y ([]:yss)) xss-bagChoicesWith f ((x:xs):xss) = [[f x ((x:xs):xss)]]- \/ bagChoicesWith f (xs:xss)+bagChoicesWith f [] = []+bagChoicesWith f [[]] = []+bagChoicesWith f ([]:xss)+ = []+ : bagChoicesWith (\y yss -> f y ([]:yss)) xss+bagChoicesWith f ((x:xs):xss)+ = [[f x ((x:xs):xss)]]+ \/ bagChoicesWith f (xs:xss) -- | Like 'choices' but lists tiers of strictly ascending choices. -- Used to construct 'setsOf' values.@@ -462,11 +467,14 @@ -- | Like 'setChoices' but customized by a function. setChoicesWith :: (a -> [[a]] -> b) -> [[a]] -> [[b]]-setChoicesWith f [] = []-setChoicesWith f [[]] = []-setChoicesWith f ([]:xss) = [] : setChoicesWith (\y yss -> f y ([]:normalizeT yss)) xss-setChoicesWith f ((x:xs):xss) = [[f x (xs:xss)]]- \/ setChoicesWith f (xs:xss)+setChoicesWith f [] = []+setChoicesWith f [[]] = []+setChoicesWith f ([]:xss)+ = []+ : setChoicesWith (\y yss -> f y ([]:normalizeT yss)) xss+setChoicesWith f ((x:xs):xss)+ = [[f x (xs:xss)]]+ \/ setChoicesWith f (xs:xss) -- | Takes as argument an integer length and tiers of element values; -- returns tiers of lists of element values of the given length.
src/Test/LeanCheck/Utils/Operators.hs view
@@ -86,10 +86,15 @@ combine (?) f g = \x -> f x ? g x -- Uneeded, just food for thought:--- > combine2 :: (c -> d -> e) -> (a -> b -> c) -> (a -> b -> d) -> (a -> b -> e)+--+-- > combine2 :: (c -> d -> e)+-- > -> (a -> b -> c)+-- > -> (a -> b -> d)+-- > -> (a -> b -> e)+-- -- Two possible implementations:--- > combine2 op f g = \x y -> f x y `op` g x y--- > combine2 = combine . combine+-- > combine2 op f g = \x y -> f x y `op` g x y+-- > combine2 = combine . combine -- | Allows building equality properties between functions. --@@ -193,7 +198,9 @@ -- | Does the first operator, left-distributes over the second? -- -- This is an alias to 'isLeftDistributiveOver'.-isDistributiveOver :: Eq a => (a -> a -> a) -> (a -> a -> a) -> a -> a -> a -> Bool+isDistributiveOver :: Eq a+ => (a -> a -> a) -> (a -> a -> a)+ -> a -> a -> a -> Bool isDistributiveOver = isLeftDistributiveOver -- | Does the first operator, left-distributes over the second?@@ -205,7 +212,9 @@ -- > > check $ (+) `isLeftDistributiveOver` (*) -- > *** Failed! Falsifiable (after 8 tests): -- > 1 0 1-isLeftDistributiveOver :: Eq a => (a -> a -> a) -> (a -> a -> a) -> a -> a -> a -> Bool+isLeftDistributiveOver :: Eq a+ => (a -> a -> a) -> (a -> a -> a)+ -> a -> a -> a -> Bool (?) `isLeftDistributiveOver` (#) = \x y z -> x ? (y # z) == (x ? y) # (x ? z) -- | Does the first operator, right-distributes over the second?@@ -217,7 +226,9 @@ -- > > check $ (+) `isRightDistributiveOver` (*) -- > *** Failed! Falsifiable (after 8 tests): -- > 1 0 1-isRightDistributiveOver :: Eq a => (a -> a -> a) -> (a -> a -> a) -> a -> a -> a -> Bool+isRightDistributiveOver :: Eq a+ => (a -> a -> a) -> (a -> a -> a)+ -> a -> a -> a -> Bool (?) `isRightDistributiveOver` (#) = \x y z -> (y # z) ? x == (y ? x) # (z ? x) -- | Are two operators 'flip'ped versions of each other?
src/Test/LeanCheck/Utils/TypeBinding.hs view
@@ -39,9 +39,9 @@ -- -- Or even: ----- > testResults n = concat+-- > testResults n = concat -- > [ for int, for uint2, for bool, for (), for char, for string ]--- > where for a = [ holds n $ prop_sortAppend -:> a ]+-- > where for a = [ holds n $ prop_sortAppend -:> a ] -- -- This last form is useful when testing multiple properties for multiple -- types.@@ -117,7 +117,7 @@ import Test.LeanCheck.Utils.Types undefinedOf :: String -> a-undefinedOf fn = error $ "Test.LeanCheck.TypeBinding." ++ fn+undefinedOf fn = error $ "Test.LeanCheck.TypeBinding." ++ fn -- | Type restricted version of const -- that forces its first argument@@ -131,7 +131,7 @@ -- > 10 -: int = 10 :: Int -- > undefined -: 'a' >- 'b' = undefined :: Char -> Char (-:) :: a -> a -> a-(-:) = asTypeOf -- const+(-:) = asTypeOf -- const infixl 1 -: -- | Type restricted version of const@@ -144,7 +144,7 @@ -- -- > abs -:> int = abs -: int >- und = abs :: Int -> Int (-:>) :: (a -> b) -> a -> (a -> b)-(-:>) = const+(-:>) = const infixl 1 -:> -- | Type restricted version of const@@ -153,7 +153,7 @@ -- -- > f ->: ty = f -: und >- ty = f :: a -> Ty (->:) :: (a -> b) -> b -> (a -> b)-(->:) = const+(->:) = const infixl 1 ->: -- | Type restricted version of const@@ -162,7 +162,7 @@ -- -- > f ->:> ty = f -: und -> ty -> und = f :: a -> Ty -> b (->:>) :: (a -> b -> c) -> b -> (a -> b -> c)-(->:>) = const+(->:>) = const infixl 1 ->:> -- | Type restricted version of const@@ -171,111 +171,119 @@ -- -- > f ->>: ty = f -: und -> und -> ty = f :: a -> b -> Ty (->>:) :: (a -> b -> c) -> c -> (a -> b -> c)-(->>:) = const+(->>:) = const infixl 1 ->>: -- | Type restricted version of const -- that forces the third argument of its first argument -- to have the same type as the second. (->>:>) :: (a -> b -> c -> d) -> c -> (a -> b -> c -> d)-(->>:>) = const+(->>:>) = const infixl 1 ->>:> -- | Type restricted version of const -- that forces the result of the result of the result of its first argument -- to have the same type as the second. (->>>:) :: (a -> b -> c -> d) -> d -> (a -> b -> c -> d)-(->>>:) = const+(->>>:) = const infixl 1 ->>>: -- | Forces the 4th argument type. (->>>:>) :: (a -> b -> c -> d -> e) -> d -> (a -> b -> c -> d -> e)-(->>>:>) = const+(->>>:>) = const infixl 1 ->>>:> -- | Forces the result type of a 4-argument function. (->>>>:) :: (a -> b -> c -> d -> e) -> e -> (a -> b -> c -> d -> e)-(->>>>:) = const+(->>>>:) = const infixl 1 ->>>>: -- | Forces the 5th argument type. (->>>>:>) :: (a -> b -> c -> d -> e -> f) -> e -> (a -> b -> c -> d -> e -> f)-(->>>>:>) = const+(->>>>:>) = const infixl 1 ->>>>:> -- | Forces the result type of a 5-argument function. (->>>>>:) :: (a -> b -> c -> d -> e -> f) -> f -> (a -> b -> c -> d -> e -> f)-(->>>>>:) = const+(->>>>>:) = const infixl 1 ->>>>>: -- | Forces the 6th argument type. (->>>>>:>) :: (a->b->c->d->e->f->g) -> f -> (a->b->c->d->e->f->g)-(->>>>>:>) = const+(->>>>>:>) = const infixl 1 ->>>>>:> -- | Forces the result type of a 6-argument function. (->>>>>>:) :: (a->b->c->d->e->f->g) -> g -> (a->b->c->d->e->f->g)-(->>>>>>:) = const+(->>>>>>:) = const infixl 1 ->>>>>>: -- | Forces the 7th argument type. (->>>>>>:>) :: (a->b->c->d->e->f->g->h) -> g -> (a->b->c->d->e->f->g->h)-(->>>>>>:>) = const+(->>>>>>:>) = const infixl 1 ->>>>>>:> -- | Forces the result type of a 7-argument function. (->>>>>>>:) :: (a->b->c->d->e->f->g->h) -> h -> (a->b->c->d->e->f->g->h)-(->>>>>>>:) = const+(->>>>>>>:) = const infixl 1 ->>>>>>>: -- | Forces the 8th argument type. (->>>>>>>:>) :: (a->b->c->d->e->f->g->h->i) -> h -> (a->b->c->d->e->f->g->h->i)-(->>>>>>>:>) = const+(->>>>>>>:>) = const infixl 1 ->>>>>>>:> -- | Forces the result type of a 8-argument function. (->>>>>>>>:) :: (a->b->c->d->e->f->g->h->i) -> i -> (a->b->c->d->e->f->g->h->i)-(->>>>>>>>:) = const+(->>>>>>>>:) = const infixl 1 ->>>>>>>>: -- | Forces the 9th argument type.-(->>>>>>>>:>) :: (a->b->c->d->e->f->g->h->i->j) -> i -> (a->b->c->d->e->f->g->h->i->j)-(->>>>>>>>:>) = const+(->>>>>>>>:>) :: (a->b->c->d->e->f->g->h->i->j) -> i+ -> (a->b->c->d->e->f->g->h->i->j)+(->>>>>>>>:>) = const infixl 1 ->>>>>>>>:> -- | Forces the result type of a 9-argument function.-(->>>>>>>>>:) :: (a->b->c->d->e->f->g->h->i->j) -> j -> (a->b->c->d->e->f->g->h->i->j)-(->>>>>>>>>:) = const+(->>>>>>>>>:) :: (a->b->c->d->e->f->g->h->i->j) -> j+ -> (a->b->c->d->e->f->g->h->i->j)+(->>>>>>>>>:) = const infixl 1 ->>>>>>>>>: -- | Forces the type of the 10th argument.-(->>>>>>>>>:>) :: (a->b->c->d->e->f->g->h->i->j->k) -> j -> (a->b->c->d->e->f->g->h->i->j->k)-(->>>>>>>>>:>) = const+(->>>>>>>>>:>) :: (a->b->c->d->e->f->g->h->i->j->k) -> j+ -> (a->b->c->d->e->f->g->h->i->j->k)+(->>>>>>>>>:>) = const infixl 1 ->>>>>>>>>:> -- | Forces the result type of a 10-argument function.-(->>>>>>>>>>:) :: (a->b->c->d->e->f->g->h->i->j->k) -> k -> (a->b->c->d->e->f->g->h->i->j->k)-(->>>>>>>>>>:) = const+(->>>>>>>>>>:) :: (a->b->c->d->e->f->g->h->i->j->k) -> k+ -> (a->b->c->d->e->f->g->h->i->j->k)+(->>>>>>>>>>:) = const infixl 1 ->>>>>>>>>>: -- | Forces the type of the 11th argument.-(->>>>>>>>>>:>) :: (a->b->c->d->e->f->g->h->i->j->k->l) -> k -> (a->b->c->d->e->f->g->h->i->j->k->l)-(->>>>>>>>>>:>) = const+(->>>>>>>>>>:>) :: (a->b->c->d->e->f->g->h->i->j->k->l) -> k+ -> (a->b->c->d->e->f->g->h->i->j->k->l)+(->>>>>>>>>>:>) = const infixl 1 ->>>>>>>>>>:> -- | Forces the result type of a 11-argument function.-(->>>>>>>>>>>:) :: (a->b->c->d->e->f->g->h->i->j->k->l) -> l -> (a->b->c->d->e->f->g->h->i->j->k->l)-(->>>>>>>>>>>:) = const+(->>>>>>>>>>>:) :: (a->b->c->d->e->f->g->h->i->j->k->l) -> l+ -> (a->b->c->d->e->f->g->h->i->j->k->l)+(->>>>>>>>>>>:) = const infixl 1 ->>>>>>>>>>>: -- | Forces the type of the 12th argument.-(->>>>>>>>>>>:>) :: (a->b->c->d->e->f->g->h->i->j->k->l->m) -> m -> (a->b->c->d->e->f->g->h->i->j->k->l->m)-(->>>>>>>>>>>:>) = const+(->>>>>>>>>>>:>) :: (a->b->c->d->e->f->g->h->i->j->k->l->m) -> m+ -> (a->b->c->d->e->f->g->h->i->j->k->l->m)+(->>>>>>>>>>>:>) = const infixl 1 ->>>>>>>>>>>:> -- | Forces the result type of a 12-argument function.-(->>>>>>>>>>>>:) :: (a->b->c->d->e->f->g->h->i->j->k->l->m) -> m -> (a->b->c->d->e->f->g->h->i->j->k->l->m)-(->>>>>>>>>>>>:) = const+(->>>>>>>>>>>>:) :: (a->b->c->d->e->f->g->h->i->j->k->l->m) -> m+ -> (a->b->c->d->e->f->g->h->i->j->k->l->m)+(->>>>>>>>>>>>:) = const infixl 1 ->>>>>>>>>>>>: -- | Returns an undefined functional value@@ -289,7 +297,7 @@ -- > 'a' >- 'b' = char >- char = (undefined :: Char -> Char) -- > int >- bool >- int = undefined :: Int -> Bool -> Int (>-) :: a -> b -> (a -> b)-(>-) = undefinedOf "(>-): undefined function -- using dummy value?"+(>-) = undefinedOf "(>-): undefined function -- using dummy value?" infixr 9 >- @@ -297,47 +305,47 @@ -- | Shorthand for undefined und :: a-und = undefinedOf "und"+und = undefinedOf "und" -- | Undefined 'Int' value for use with type binding operators. -- -- > check $ (\x y -> x + y == y + x) ->:> int int :: Int-int = undefinedOf "int"+int = undefinedOf "int" -- | Undefined 'Integer' value for use with type binding operators. -- -- > check $ (\x y -> x + y == y + x) ->:> integer integer :: Integer-integer = undefinedOf "integer"+integer = undefinedOf "integer" -- | Undefined 'Float' value for use with type binding operators. float :: Float-float = undefinedOf "float"+float = undefinedOf "float" -- | Undefined 'Double' value for use with type binding operators. double :: Double-double = undefinedOf "double"+double = undefinedOf "double" -- | Undefined 'Rational' value for use with type binding operators. rational :: Rational-rational = undefinedOf "rational"+rational = undefinedOf "rational" -- | Undefined 'Bool' value. bool :: Bool-bool = undefinedOf "bool"+bool = undefinedOf "bool" -- | Undefined 'Char' value. char :: Char-char = undefinedOf "char"+char = undefinedOf "char" -- | Undefined 'String' value. string :: String-string = undefinedOf "string"+string = undefinedOf "string" -- | Undefined 'Ordering' value. ordering :: Ordering-ordering = undefinedOf "ordering"+ordering = undefinedOf "ordering" -- | Undefined 'Maybe' value. Uses the type of the given value as the argument -- type. For use with type binding operators.@@ -346,68 +354,68 @@ -- -- > check $ prop -:> mayb int mayb :: a -> Maybe a-mayb = undefinedOf "mayb"+mayb = undefinedOf "mayb" -- | Undefined 'Either' value. Uses the types of the given values as the -- argument types. For use with type binding operators. eith :: a -> b -> Either a b-eith = undefinedOf "eith"+eith = undefinedOf "eith" -- Dummy values of Test.LeanCheck.Types's types: -- | Undefined 'Natural' value. natural :: Natural-natural = undefinedOf "natural"+natural = undefinedOf "natural" -- | Undefined 'Nat' value. nat :: Nat-nat = undefinedOf "nat"+nat = undefinedOf "nat" -- | Undefined 'Int1' value. int1 :: Int1-int1 = undefinedOf "int1"+int1 = undefinedOf "int1" -- | Undefined 'Int2' value. int2 :: Int2-int2 = undefinedOf "int2"+int2 = undefinedOf "int2" -- | Undefined 'Int3' value. int3 :: Int3-int3 = undefinedOf "int3"+int3 = undefinedOf "int3" -- | Undefined 'Int4' value. int4 :: Int4-int4 = undefinedOf "int4"+int4 = undefinedOf "int4" -- | Undefined 'Word1' value. word1 :: Word1-word1 = undefinedOf "word1"+word1 = undefinedOf "word1" -- | Undefined 'Word2' value. word2 :: Word2-word2 = undefinedOf "word2"+word2 = undefinedOf "word2" -- | Undefined 'Word3' value. word3 :: Word3-word3 = undefinedOf "word3"+word3 = undefinedOf "word3" -- | Undefined 'Word4' value. word4 :: Word4-word4 = undefinedOf "word4"+word4 = undefinedOf "word4" -- | Deprecated. Use 'word1'. uint1 :: UInt1-uint1 = undefinedOf "uint1"+uint1 = undefinedOf "uint1" -- | Deprecated. Use 'word2'. uint2 :: UInt2-uint2 = undefinedOf "uint2"+uint2 = undefinedOf "uint2" -- | Deprecated. Use 'word3'. uint3 :: UInt3-uint3 = undefinedOf "uint3"+uint3 = undefinedOf "uint3" -- | Deprecated. Use 'word4'. uint4 :: UInt4-uint4 = undefinedOf "uint4"+uint4 = undefinedOf "uint4"
src/Test/LeanCheck/Utils/Types.hs view
@@ -98,65 +98,67 @@ #endif narrowU :: Int -> Int -> Int-narrowU w i = i `mod` 2^w+narrowU w i = i `mod` 2^w narrowS :: Int -> Int -> Int-narrowS w i = let l = 2^w- i' = i `mod` l- in if i' < 2^(w-1)- then i'- else i' - l+narrowS w i = if i' < 2^(w-1)+ then i'+ else i' - l+ where+ l = 2^w+ i' = i `mod` l + mapTuple :: (a -> b) -> (a,a) -> (b,b)-mapTuple f (x,y) = (f x, f y)+mapTuple f (x,y) = (f x, f y) mapFst :: (a -> b) -> (a,c) -> (b,c)-mapFst f (x,y) = (f x,y)+mapFst f (x,y) = (f x, y) oNewtype :: (a -> b) -> (b -> a) -> (a -> a -> a) -> (b -> b -> b)-oNewtype con des o = \x y -> con $ des x `o` des y+oNewtype con des o = \x y -> con $ des x `o` des y fNewtype :: (a -> b) -> (b -> a) -> (a -> a) -> (b -> b)-fNewtype con des f = con . f . des+fNewtype con des f = con . f . des otNewtype :: (a -> b) -> (b -> a) -> (a -> a -> (a,a)) -> (b -> b -> (b,b))-otNewtype con des o = \x y -> mapTuple con $ des x `o` des y+otNewtype con des o = \x y -> mapTuple con $ des x `o` des y readsPrecNewtype :: Read a => (a -> b) -> Int -> String -> [(b,String)]-readsPrecNewtype con n = map (mapFst con) . readsPrec n+readsPrecNewtype con n = map (mapFst con) . readsPrec n boundedEnumFrom :: (Ord a,Bounded a,Enum a) => a -> [a]-boundedEnumFrom x = [x..maxBound]+boundedEnumFrom x = [x..maxBound] boundedEnumFromThen :: (Ord a,Bounded a,Enum a) => a -> a -> [a]-boundedEnumFromThen x y | x > y = [x,y..minBound]- | otherwise = [x,y..maxBound]+boundedEnumFromThen x y | x > y = [x,y..minBound]+ | otherwise = [x,y..maxBound] -- | Single-bit signed integers: -1, 0-newtype Int1 = Int1 { unInt1 :: Int } deriving (Eq, Ord)+newtype Int1 = Int1 { unInt1 :: Int } deriving (Eq, Ord) -- | Two-bit signed integers: -2, -1, 0, 1-newtype Int2 = Int2 { unInt2 :: Int } deriving (Eq, Ord)+newtype Int2 = Int2 { unInt2 :: Int } deriving (Eq, Ord) -- | Three-bit signed integers: -4, -3, -2, -1, 0, 1, 2, 3-newtype Int3 = Int3 { unInt3 :: Int } deriving (Eq, Ord)+newtype Int3 = Int3 { unInt3 :: Int } deriving (Eq, Ord) -- | Four-bit signed integers: -- -8, -7, -6, -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6, 7-newtype Int4 = Int4 { unInt4 :: Int } deriving (Eq, Ord)+newtype Int4 = Int4 { unInt4 :: Int } deriving (Eq, Ord) -- | Single-bit unsigned integer: 0, 1-newtype Word1 = Word1 { unWord1 :: Int } deriving (Eq, Ord)+newtype Word1 = Word1 { unWord1 :: Int } deriving (Eq, Ord) -- | Two-bit unsigned integers: 0, 1, 2, 3-newtype Word2 = Word2 { unWord2 :: Int } deriving (Eq, Ord)+newtype Word2 = Word2 { unWord2 :: Int } deriving (Eq, Ord) -- | Three-bit unsigned integers: 0, 1, 2, 3, 4, 5, 6, 7-newtype Word3 = Word3 { unWord3 :: Int } deriving (Eq, Ord)+newtype Word3 = Word3 { unWord3 :: Int } deriving (Eq, Ord) -- | Four-bit unsigned integers: -- 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15-newtype Word4 = Word4 { unWord4 :: Int } deriving (Eq, Ord)+newtype Word4 = Word4 { unWord4 :: Int } deriving (Eq, Ord) -- | Natural numbers (including 0): 0, 1, 2, 3, 4, 5, 6, 7, ... --@@ -165,7 +167,7 @@ -- -- Its 'Enum', 'Listable' and 'Num' instances only produce non-negative values. -- When @x < y@ then @x - y = 0@.-newtype Natural = Natural { unNatural :: Integer } deriving (Eq, Ord)+newtype Natural = Natural { unNatural :: Integer } deriving (Eq, Ord) -- | Natural numbers (including 0): 0, 1, 2, 3, 4, 5, 6, 7, ... --@@ -174,28 +176,28 @@ -- -- Its 'Enum', 'Listable' and 'Num' instances only produce non-negative values. -- When @x < y@ then @x - y = 0@.-newtype Nat = Nat { unNat :: Int } deriving (Eq, Ord)+newtype Nat = Nat { unNat :: Int } deriving (Eq, Ord) -- | Natural numbers modulo 1: 0-newtype Nat1 = Nat1 { unNat1 :: Int } deriving (Eq, Ord)+newtype Nat1 = Nat1 { unNat1 :: Int } deriving (Eq, Ord) -- | Natural numbers modulo 2: 0, 1-newtype Nat2 = Nat2 { unNat2 :: Int } deriving (Eq, Ord)+newtype Nat2 = Nat2 { unNat2 :: Int } deriving (Eq, Ord) -- | Natural numbers modulo 3: 0, 1, 2-newtype Nat3 = Nat3 { unNat3 :: Int } deriving (Eq, Ord)+newtype Nat3 = Nat3 { unNat3 :: Int } deriving (Eq, Ord) -- | Natural numbers modulo 4: 0, 1, 2, 3-newtype Nat4 = Nat4 { unNat4 :: Int } deriving (Eq, Ord)+newtype Nat4 = Nat4 { unNat4 :: Int } deriving (Eq, Ord) -- | Natural numbers modulo 5: 0, 1, 2, 3, 4-newtype Nat5 = Nat5 { unNat5 :: Int } deriving (Eq, Ord)+newtype Nat5 = Nat5 { unNat5 :: Int } deriving (Eq, Ord) -- | Natural numbers modulo 6: 0, 1, 2, 3, 4, 5-newtype Nat6 = Nat6 { unNat6 :: Int } deriving (Eq, Ord)+newtype Nat6 = Nat6 { unNat6 :: Int } deriving (Eq, Ord) -- | Natural numbers modulo 7: 0, 1, 2, 3, 4, 5, 6-newtype Nat7 = Nat7 { unNat7 :: Int } deriving (Eq, Ord)+newtype Nat7 = Nat7 { unNat7 :: Int } deriving (Eq, Ord) -- | Generic type 'A'. --@@ -214,7 +216,7 @@ -- -- It is instance to several typeclasses so that it can be used -- to test functions with type contexts.-newtype A = A Int deriving (Eq, Ord)+newtype A = A Int deriving (Eq, Ord) -- | Generic type 'B'. --@@ -230,7 +232,7 @@ -- > foldr :: (A -> B -> B) -> B -> [A] -> B -- -- This type is homomorphic to 'A', 'Nat6', 'C', 'D', 'E' and 'F'.-newtype B = B Int deriving (Eq, Ord)+newtype B = B Int deriving (Eq, Ord) -- | Generic type 'C'. --@@ -246,28 +248,28 @@ -- > zipWith :: (A -> B -> C) -> [A] -> [B] -> [C] -- -- This type is homomorphic to 'A', 'B', 'Nat6', 'D', 'E' and 'F'.-newtype C = C Int deriving (Eq, Ord)+newtype C = C Int deriving (Eq, Ord) -- | Generic type 'D'. -- -- Can be used to test polymorphic functions with four type variables. -- -- This type is homomorphic to 'A', 'B', 'C', 'Nat6', 'E' and 'F'.-newtype D = D Int deriving (Eq, Ord)+newtype D = D Int deriving (Eq, Ord) -- | Generic type 'E'. -- -- Can be used to test polymorphic functions with five type variables. -- -- This type is homomorphic to 'A', 'B', 'C', 'D', 'Nat6' and 'F'.-newtype E = E Int deriving (Eq, Ord)+newtype E = E Int deriving (Eq, Ord) -- | Generic type 'F'. -- -- Can be used to test polymorphic functions with five type variables. -- -- This type is homomorphic to 'A', 'B', 'C', 'D', 'E' and 'Nat6'.-newtype F = F Int deriving (Eq, Ord)+newtype F = F Int deriving (Eq, Ord) unA :: A -> Int; unA (A n) = n unB :: B -> Int; unB (B n) = n@@ -276,23 +278,27 @@ unE :: E -> Int; unE (E n) = n unF :: F -> Int; unF (F n) = n -int1 :: Int -> Int1; int1 = Int1 . narrowS 1-int2 :: Int -> Int2; int2 = Int2 . narrowS 2-int3 :: Int -> Int3; int3 = Int3 . narrowS 3-int4 :: Int -> Int4; int4 = Int4 . narrowS 4-word1 :: Int -> Word1; word1 = Word1 . narrowU 1-word2 :: Int -> Word2; word2 = Word2 . narrowU 2-word3 :: Int -> Word3; word3 = Word3 . narrowU 3-word4 :: Int -> Word4; word4 = Word4 . narrowU 4-nat1 :: Int -> Nat1; nat1 = Nat1 . (`mod` 1)-nat2 :: Int -> Nat2; nat2 = Nat2 . (`mod` 2)-nat3 :: Int -> Nat3; nat3 = Nat3 . (`mod` 3)-nat4 :: Int -> Nat4; nat4 = Nat4 . (`mod` 4)-nat5 :: Int -> Nat5; nat5 = Nat5 . (`mod` 5)-nat6 :: Int -> Nat6; nat6 = Nat6 . (`mod` 6)-nat7 :: Int -> Nat7; nat7 = Nat7 . (`mod` 7)-nat :: Int -> Nat; nat = Nat . (\x -> if x < 0 then 0 else x)-natural :: Integer -> Natural; natural = Natural . (\x -> if x < 0 then 0 else x)+negativeToZero :: (Ord a, Num a) => a -> a+negativeToZero x | x < 0 = 0+ | otherwise = x++int1 :: Int -> Int1; int1 = Int1 . narrowS 1+int2 :: Int -> Int2; int2 = Int2 . narrowS 2+int3 :: Int -> Int3; int3 = Int3 . narrowS 3+int4 :: Int -> Int4; int4 = Int4 . narrowS 4+word1 :: Int -> Word1; word1 = Word1 . narrowU 1+word2 :: Int -> Word2; word2 = Word2 . narrowU 2+word3 :: Int -> Word3; word3 = Word3 . narrowU 3+word4 :: Int -> Word4; word4 = Word4 . narrowU 4+nat1 :: Int -> Nat1; nat1 = Nat1 . (`mod` 1)+nat2 :: Int -> Nat2; nat2 = Nat2 . (`mod` 2)+nat3 :: Int -> Nat3; nat3 = Nat3 . (`mod` 3)+nat4 :: Int -> Nat4; nat4 = Nat4 . (`mod` 4)+nat5 :: Int -> Nat5; nat5 = Nat5 . (`mod` 5)+nat6 :: Int -> Nat6; nat6 = Nat6 . (`mod` 6)+nat7 :: Int -> Nat7; nat7 = Nat7 . (`mod` 7)+nat :: Int -> Nat; nat = Nat . negativeToZero+natural :: Integer -> Natural; natural = Natural . negativeToZero mkA :: Int -> A; mkA = A . (`mod` 6) mkB :: Int -> B; mkB = B . (`mod` 6) mkC :: Int -> C; mkC = C . (`mod` 6)@@ -300,49 +306,51 @@ mkE :: Int -> E; mkE = E . (`mod` 6) mkF :: Int -> F; mkF = F . (`mod` 6) -oInt1 ::(Int->Int->Int)->(Int1->Int1->Int1) ; oInt1 = oNewtype int1 unInt1-oInt2 ::(Int->Int->Int)->(Int2->Int2->Int2) ; oInt2 = oNewtype int2 unInt2-oInt3 ::(Int->Int->Int)->(Int3->Int3->Int3) ; oInt3 = oNewtype int3 unInt3-oInt4 ::(Int->Int->Int)->(Int4->Int4->Int4) ; oInt4 = oNewtype int4 unInt4-oWord1 ::(Int->Int->Int)->(Word1->Word1->Word1); oWord1 = oNewtype word1 unWord1-oWord2 ::(Int->Int->Int)->(Word2->Word2->Word2); oWord2 = oNewtype word2 unWord2-oWord3 ::(Int->Int->Int)->(Word3->Word3->Word3); oWord3 = oNewtype word3 unWord3-oWord4 ::(Int->Int->Int)->(Word4->Word4->Word4); oWord4 = oNewtype word4 unWord4-oNat ::(Int->Int->Int)->(Nat->Nat->Nat) ; oNat = oNewtype nat unNat-oNat1 ::(Int->Int->Int)->(Nat1->Nat1->Nat1) ; oNat1 = oNewtype nat1 unNat1-oNat2 ::(Int->Int->Int)->(Nat2->Nat2->Nat2) ; oNat2 = oNewtype nat2 unNat2-oNat3 ::(Int->Int->Int)->(Nat3->Nat3->Nat3) ; oNat3 = oNewtype nat3 unNat3-oNat4 ::(Int->Int->Int)->(Nat4->Nat4->Nat4) ; oNat4 = oNewtype nat4 unNat4-oNat5 ::(Int->Int->Int)->(Nat5->Nat5->Nat5) ; oNat5 = oNewtype nat5 unNat5-oNat6 ::(Int->Int->Int)->(Nat6->Nat6->Nat6) ; oNat6 = oNewtype nat6 unNat6-oNat7 ::(Int->Int->Int)->(Nat7->Nat7->Nat7) ; oNat7 = oNewtype nat7 unNat7-oNatural :: (Integer->Integer->Integer) -> (Natural->Natural->Natural)-oNatural = oNewtype natural unNatural-oA :: (Int -> Int -> Int) -> (A -> A -> A); oA = oNewtype mkA unA-oB :: (Int -> Int -> Int) -> (B -> B -> B); oB = oNewtype mkB unB-oC :: (Int -> Int -> Int) -> (C -> C -> C); oC = oNewtype mkC unC-oD :: (Int -> Int -> Int) -> (D -> D -> D); oD = oNewtype mkD unD-oE :: (Int -> Int -> Int) -> (E -> E -> E); oE = oNewtype mkE unE-oF :: (Int -> Int -> Int) -> (F -> F -> F); oF = oNewtype mkF unF+type ONewtype a = (Int -> Int -> Int) -> (a -> a -> a) -fInt1 :: (Int->Int) -> (Int1->Int1) ; fInt1 = fNewtype int1 unInt1-fInt2 :: (Int->Int) -> (Int2->Int2) ; fInt2 = fNewtype int2 unInt2-fInt3 :: (Int->Int) -> (Int3->Int3) ; fInt3 = fNewtype int3 unInt3-fInt4 :: (Int->Int) -> (Int4->Int4) ; fInt4 = fNewtype int4 unInt4-fWord1 :: (Int->Int) -> (Word1->Word1) ; fWord1 = fNewtype word1 unWord1-fWord2 :: (Int->Int) -> (Word2->Word2) ; fWord2 = fNewtype word2 unWord2-fWord3 :: (Int->Int) -> (Word3->Word3) ; fWord3 = fNewtype word3 unWord3-fWord4 :: (Int->Int) -> (Word4->Word4) ; fWord4 = fNewtype word4 unWord4-fNat :: (Int->Int) -> (Nat->Nat) ; fNat = fNewtype Nat unNat-fNat1 :: (Int->Int) -> (Nat1->Nat1) ; fNat1 = fNewtype nat1 unNat1-fNat2 :: (Int->Int) -> (Nat2->Nat2) ; fNat2 = fNewtype nat2 unNat2-fNat3 :: (Int->Int) -> (Nat3->Nat3) ; fNat3 = fNewtype nat3 unNat3-fNat4 :: (Int->Int) -> (Nat4->Nat4) ; fNat4 = fNewtype nat4 unNat4-fNat5 :: (Int->Int) -> (Nat5->Nat5) ; fNat5 = fNewtype nat5 unNat5-fNat6 :: (Int->Int) -> (Nat6->Nat6) ; fNat6 = fNewtype nat6 unNat6-fNat7 :: (Int->Int) -> (Nat7->Nat7) ; fNat7 = fNewtype nat7 unNat7+oInt1 :: ONewtype Int1; oInt1 = oNewtype int1 unInt1+oInt2 :: ONewtype Int2; oInt2 = oNewtype int2 unInt2+oInt3 :: ONewtype Int3; oInt3 = oNewtype int3 unInt3+oInt4 :: ONewtype Int4; oInt4 = oNewtype int4 unInt4+oWord1 :: ONewtype Word1; oWord1 = oNewtype word1 unWord1+oWord2 :: ONewtype Word2; oWord2 = oNewtype word2 unWord2+oWord3 :: ONewtype Word3; oWord3 = oNewtype word3 unWord3+oWord4 :: ONewtype Word4; oWord4 = oNewtype word4 unWord4+oNat :: ONewtype Nat; oNat = oNewtype nat unNat+oNat1 :: ONewtype Nat1; oNat1 = oNewtype nat1 unNat1+oNat2 :: ONewtype Nat2; oNat2 = oNewtype nat2 unNat2+oNat3 :: ONewtype Nat3; oNat3 = oNewtype nat3 unNat3+oNat4 :: ONewtype Nat4; oNat4 = oNewtype nat4 unNat4+oNat5 :: ONewtype Nat5; oNat5 = oNewtype nat5 unNat5+oNat6 :: ONewtype Nat6; oNat6 = oNewtype nat6 unNat6+oNat7 :: ONewtype Nat7; oNat7 = oNewtype nat7 unNat7+oNatural :: (Integer -> Integer -> Integer) -> (Natural -> Natural -> Natural)+oNatural = oNewtype natural unNatural+oA :: ONewtype A; oA = oNewtype mkA unA+oB :: ONewtype B; oB = oNewtype mkB unB+oC :: ONewtype C; oC = oNewtype mkC unC+oD :: ONewtype D; oD = oNewtype mkD unD+oE :: ONewtype E; oE = oNewtype mkE unE+oF :: ONewtype F; oF = oNewtype mkF unF++fInt1 :: (Int->Int) -> (Int1->Int1) ; fInt1 = fNewtype int1 unInt1+fInt2 :: (Int->Int) -> (Int2->Int2) ; fInt2 = fNewtype int2 unInt2+fInt3 :: (Int->Int) -> (Int3->Int3) ; fInt3 = fNewtype int3 unInt3+fInt4 :: (Int->Int) -> (Int4->Int4) ; fInt4 = fNewtype int4 unInt4+fWord1 :: (Int->Int) -> (Word1->Word1); fWord1 = fNewtype word1 unWord1+fWord2 :: (Int->Int) -> (Word2->Word2); fWord2 = fNewtype word2 unWord2+fWord3 :: (Int->Int) -> (Word3->Word3); fWord3 = fNewtype word3 unWord3+fWord4 :: (Int->Int) -> (Word4->Word4); fWord4 = fNewtype word4 unWord4+fNat :: (Int->Int) -> (Nat->Nat) ; fNat = fNewtype Nat unNat+fNat1 :: (Int->Int) -> (Nat1->Nat1) ; fNat1 = fNewtype nat1 unNat1+fNat2 :: (Int->Int) -> (Nat2->Nat2) ; fNat2 = fNewtype nat2 unNat2+fNat3 :: (Int->Int) -> (Nat3->Nat3) ; fNat3 = fNewtype nat3 unNat3+fNat4 :: (Int->Int) -> (Nat4->Nat4) ; fNat4 = fNewtype nat4 unNat4+fNat5 :: (Int->Int) -> (Nat5->Nat5) ; fNat5 = fNewtype nat5 unNat5+fNat6 :: (Int->Int) -> (Nat6->Nat6) ; fNat6 = fNewtype nat6 unNat6+fNat7 :: (Int->Int) -> (Nat7->Nat7) ; fNat7 = fNewtype nat7 unNat7 fNatural :: (Integer->Integer) -> (Natural->Natural)-fNatural = fNewtype Natural unNatural+fNatural = fNewtype Natural unNatural fA :: (Int -> Int) -> (A -> A); fA = fNewtype mkA unA fB :: (Int -> Int) -> (B -> B); fB = fNewtype mkB unB fC :: (Int -> Int) -> (C -> C); fC = fNewtype mkC unC@@ -350,406 +358,449 @@ fE :: (Int -> Int) -> (E -> E); fE = fNewtype mkE unE fF :: (Int -> Int) -> (F -> F); fF = fNewtype mkF unF -instance Show Int1 where show = show . unInt1-instance Show Int2 where show = show . unInt2-instance Show Int3 where show = show . unInt3-instance Show Int4 where show = show . unInt4-instance Show Word1 where show = show . unWord1-instance Show Word2 where show = show . unWord2-instance Show Word3 where show = show . unWord3-instance Show Word4 where show = show . unWord4-instance Show Nat where show (Nat x) = show x-instance Show Nat1 where show = show . unNat1-instance Show Nat2 where show = show . unNat2-instance Show Nat3 where show = show . unNat3-instance Show Nat4 where show = show . unNat4-instance Show Nat5 where show = show . unNat5-instance Show Nat6 where show = show . unNat6-instance Show Nat7 where show = show . unNat7-instance Show Natural where show (Natural x) = show x-instance Show A where show = show . unA-instance Show B where show = show . unB-instance Show C where show = show . unC-instance Show D where show = show . unD-instance Show E where show = show . unE-instance Show F where show = show . unF+instance Show Int1 where show = show . unInt1+instance Show Int2 where show = show . unInt2+instance Show Int3 where show = show . unInt3+instance Show Int4 where show = show . unInt4+instance Show Word1 where show = show . unWord1+instance Show Word2 where show = show . unWord2+instance Show Word3 where show = show . unWord3+instance Show Word4 where show = show . unWord4+instance Show Nat where show (Nat x) = show x+instance Show Nat1 where show = show . unNat1+instance Show Nat2 where show = show . unNat2+instance Show Nat3 where show = show . unNat3+instance Show Nat4 where show = show . unNat4+instance Show Nat5 where show = show . unNat5+instance Show Nat6 where show = show . unNat6+instance Show Nat7 where show = show . unNat7+instance Show Natural where show (Natural x) = show x+instance Show A where show = show . unA+instance Show B where show = show . unB+instance Show C where show = show . unC+instance Show D where show = show . unD+instance Show E where show = show . unE+instance Show F where show = show . unF -instance Read Int1 where readsPrec = readsPrecNewtype int1-instance Read Int2 where readsPrec = readsPrecNewtype int2-instance Read Int3 where readsPrec = readsPrecNewtype int3-instance Read Int4 where readsPrec = readsPrecNewtype int4-instance Read Word1 where readsPrec = readsPrecNewtype word1-instance Read Word2 where readsPrec = readsPrecNewtype word2-instance Read Word3 where readsPrec = readsPrecNewtype word3-instance Read Word4 where readsPrec = readsPrecNewtype word4-instance Read Nat where readsPrec = readsPrecNewtype nat-instance Read Nat1 where readsPrec = readsPrecNewtype nat1-instance Read Nat2 where readsPrec = readsPrecNewtype nat2-instance Read Nat3 where readsPrec = readsPrecNewtype nat3-instance Read Nat4 where readsPrec = readsPrecNewtype nat4-instance Read Nat5 where readsPrec = readsPrecNewtype nat5-instance Read Nat6 where readsPrec = readsPrecNewtype nat6-instance Read Nat7 where readsPrec = readsPrecNewtype nat7-instance Read Natural where readsPrec = readsPrecNewtype natural-instance Read A where readsPrec = readsPrecNewtype mkA-instance Read B where readsPrec = readsPrecNewtype mkB-instance Read C where readsPrec = readsPrecNewtype mkC-instance Read D where readsPrec = readsPrecNewtype mkD-instance Read E where readsPrec = readsPrecNewtype mkE-instance Read F where readsPrec = readsPrecNewtype mkF+instance Read Int1 where readsPrec = readsPrecNewtype int1+instance Read Int2 where readsPrec = readsPrecNewtype int2+instance Read Int3 where readsPrec = readsPrecNewtype int3+instance Read Int4 where readsPrec = readsPrecNewtype int4+instance Read Word1 where readsPrec = readsPrecNewtype word1+instance Read Word2 where readsPrec = readsPrecNewtype word2+instance Read Word3 where readsPrec = readsPrecNewtype word3+instance Read Word4 where readsPrec = readsPrecNewtype word4+instance Read Nat where readsPrec = readsPrecNewtype nat+instance Read Nat1 where readsPrec = readsPrecNewtype nat1+instance Read Nat2 where readsPrec = readsPrecNewtype nat2+instance Read Nat3 where readsPrec = readsPrecNewtype nat3+instance Read Nat4 where readsPrec = readsPrecNewtype nat4+instance Read Nat5 where readsPrec = readsPrecNewtype nat5+instance Read Nat6 where readsPrec = readsPrecNewtype nat6+instance Read Nat7 where readsPrec = readsPrecNewtype nat7+instance Read Natural where readsPrec = readsPrecNewtype natural+instance Read A where readsPrec = readsPrecNewtype mkA+instance Read B where readsPrec = readsPrecNewtype mkB+instance Read C where readsPrec = readsPrecNewtype mkC+instance Read D where readsPrec = readsPrecNewtype mkD+instance Read E where readsPrec = readsPrecNewtype mkE+instance Read F where readsPrec = readsPrecNewtype mkF -instance Num Int1 where (+) = oInt1 (+); abs = fInt1 abs- (-) = oInt1 (-); signum = fInt1 signum- (*) = oInt1 (*); fromInteger = int1 . fromInteger+instance Num Int1 where+ (+) = oInt1 (+); abs = fInt1 abs+ (-) = oInt1 (-); signum = fInt1 signum+ (*) = oInt1 (*); fromInteger = int1 . fromInteger -instance Num Int2 where (+) = oInt2 (+); abs = fInt2 abs- (-) = oInt2 (-); signum = fInt2 signum- (*) = oInt2 (*); fromInteger = int2 . fromInteger+instance Num Int2 where+ (+) = oInt2 (+); abs = fInt2 abs+ (-) = oInt2 (-); signum = fInt2 signum+ (*) = oInt2 (*); fromInteger = int2 . fromInteger -instance Num Int3 where (+) = oInt3 (+); abs = fInt3 abs- (-) = oInt3 (-); signum = fInt3 signum- (*) = oInt3 (*); fromInteger = int3 . fromInteger+instance Num Int3 where+ (+) = oInt3 (+); abs = fInt3 abs+ (-) = oInt3 (-); signum = fInt3 signum+ (*) = oInt3 (*); fromInteger = int3 . fromInteger -instance Num Int4 where (+) = oInt4 (+); abs = fInt4 abs- (-) = oInt4 (-); signum = fInt4 signum- (*) = oInt4 (*); fromInteger = int4 . fromInteger+instance Num Int4 where+ (+) = oInt4 (+); abs = fInt4 abs+ (-) = oInt4 (-); signum = fInt4 signum+ (*) = oInt4 (*); fromInteger = int4 . fromInteger -instance Num Word1 where (+) = oWord1 (+); abs = fWord1 abs- (-) = oWord1 (-); signum = fWord1 signum- (*) = oWord1 (*); fromInteger = word1 . fromInteger+instance Num Word1 where+ (+) = oWord1 (+); abs = fWord1 abs+ (-) = oWord1 (-); signum = fWord1 signum+ (*) = oWord1 (*); fromInteger = word1 . fromInteger -instance Num Word2 where (+) = oWord2 (+); abs = fWord2 abs- (-) = oWord2 (-); signum = fWord2 signum- (*) = oWord2 (*); fromInteger = word2 . fromInteger+instance Num Word2 where+ (+) = oWord2 (+); abs = fWord2 abs+ (-) = oWord2 (-); signum = fWord2 signum+ (*) = oWord2 (*); fromInteger = word2 . fromInteger -instance Num Word3 where (+) = oWord3 (+); abs = fWord3 abs- (-) = oWord3 (-); signum = fWord3 signum- (*) = oWord3 (*); fromInteger = word3 . fromInteger+instance Num Word3 where+ (+) = oWord3 (+); abs = fWord3 abs+ (-) = oWord3 (-); signum = fWord3 signum+ (*) = oWord3 (*); fromInteger = word3 . fromInteger -instance Num Word4 where (+) = oWord4 (+); abs = fWord4 abs- (-) = oWord4 (-); signum = fWord4 signum- (*) = oWord4 (*); fromInteger = word4 . fromInteger+instance Num Word4 where+ (+) = oWord4 (+); abs = fWord4 abs+ (-) = oWord4 (-); signum = fWord4 signum+ (*) = oWord4 (*); fromInteger = word4 . fromInteger -instance Num Nat where (+) = oNat (+); abs = fNat abs- (-) = oNat (-); signum = fNat signum- (*) = oNat (*); fromInteger = nat . fromInteger+instance Num Nat where+ (+) = oNat (+); abs = fNat abs+ (-) = oNat (-); signum = fNat signum+ (*) = oNat (*); fromInteger = nat . fromInteger -instance Num Nat1 where (+) = oNat1 (+); abs = fNat1 abs- (-) = oNat1 (-); signum = fNat1 signum- (*) = oNat1 (*); fromInteger = nat1 . fromInteger+instance Num Nat1 where+ (+) = oNat1 (+); abs = fNat1 abs+ (-) = oNat1 (-); signum = fNat1 signum+ (*) = oNat1 (*); fromInteger = nat1 . fromInteger -instance Num Nat2 where (+) = oNat2 (+); abs = fNat2 abs- (-) = oNat2 (-); signum = fNat2 signum- (*) = oNat2 (*); fromInteger = nat2 . fromInteger+instance Num Nat2 where+ (+) = oNat2 (+); abs = fNat2 abs+ (-) = oNat2 (-); signum = fNat2 signum+ (*) = oNat2 (*); fromInteger = nat2 . fromInteger -instance Num Nat3 where (+) = oNat3 (+); abs = fNat3 abs- (-) = oNat3 (-); signum = fNat3 signum- (*) = oNat3 (*); fromInteger = nat3 . fromInteger+instance Num Nat3 where+ (+) = oNat3 (+); abs = fNat3 abs+ (-) = oNat3 (-); signum = fNat3 signum+ (*) = oNat3 (*); fromInteger = nat3 . fromInteger -instance Num Nat4 where (+) = oNat4 (+); abs = fNat4 abs- (-) = oNat4 (-); signum = fNat4 signum- (*) = oNat4 (*); fromInteger = nat4 . fromInteger+instance Num Nat4 where+ (+) = oNat4 (+); abs = fNat4 abs+ (-) = oNat4 (-); signum = fNat4 signum+ (*) = oNat4 (*); fromInteger = nat4 . fromInteger -instance Num Nat5 where (+) = oNat5 (+); abs = fNat5 abs- (-) = oNat5 (-); signum = fNat5 signum- (*) = oNat5 (*); fromInteger = nat5 . fromInteger+instance Num Nat5 where+ (+) = oNat5 (+); abs = fNat5 abs+ (-) = oNat5 (-); signum = fNat5 signum+ (*) = oNat5 (*); fromInteger = nat5 . fromInteger -instance Num Nat6 where (+) = oNat6 (+); abs = fNat6 abs- (-) = oNat6 (-); signum = fNat6 signum- (*) = oNat6 (*); fromInteger = nat6 . fromInteger+instance Num Nat6 where+ (+) = oNat6 (+); abs = fNat6 abs+ (-) = oNat6 (-); signum = fNat6 signum+ (*) = oNat6 (*); fromInteger = nat6 . fromInteger -instance Num Nat7 where (+) = oNat7 (+); abs = fNat7 abs- (-) = oNat7 (-); signum = fNat7 signum- (*) = oNat7 (*); fromInteger = nat7 . fromInteger+instance Num Nat7 where+ (+) = oNat7 (+); abs = fNat7 abs+ (-) = oNat7 (-); signum = fNat7 signum+ (*) = oNat7 (*); fromInteger = nat7 . fromInteger instance Num Natural where- (+) = oNatural (+); abs = fNatural abs- (-) = oNatural (-); signum = fNatural signum- (*) = oNatural (*); fromInteger = natural . fromInteger+ (+) = oNatural (+); abs = fNatural abs+ (-) = oNatural (-); signum = fNatural signum+ (*) = oNatural (*); fromInteger = natural . fromInteger -instance Num A where (+) = oA (+); abs = fA abs- (-) = oA (-); signum = fA signum- (*) = oA (*); fromInteger = mkA . fromInteger+instance Num A where+ (+) = oA (+); abs = fA abs+ (-) = oA (-); signum = fA signum+ (*) = oA (*); fromInteger = mkA . fromInteger -instance Num B where (+) = oB (+); abs = fB abs- (-) = oB (-); signum = fB signum- (*) = oB (*); fromInteger = mkB . fromInteger+instance Num B where+ (+) = oB (+); abs = fB abs+ (-) = oB (-); signum = fB signum+ (*) = oB (*); fromInteger = mkB . fromInteger -instance Num C where (+) = oC (+); abs = fC abs- (-) = oC (-); signum = fC signum- (*) = oC (*); fromInteger = mkC . fromInteger+instance Num C where+ (+) = oC (+); abs = fC abs+ (-) = oC (-); signum = fC signum+ (*) = oC (*); fromInteger = mkC . fromInteger -instance Num D where (+) = oD (+); abs = fD abs- (-) = oD (-); signum = fD signum- (*) = oD (*); fromInteger = mkD . fromInteger+instance Num D where+ (+) = oD (+); abs = fD abs+ (-) = oD (-); signum = fD signum+ (*) = oD (*); fromInteger = mkD . fromInteger -instance Num E where (+) = oE (+); abs = fE abs- (-) = oE (-); signum = fE signum- (*) = oE (*); fromInteger = mkE . fromInteger+instance Num E where+ (+) = oE (+); abs = fE abs+ (-) = oE (-); signum = fE signum+ (*) = oE (*); fromInteger = mkE . fromInteger -instance Num F where (+) = oF (+); abs = fF abs- (-) = oF (-); signum = fF signum- (*) = oF (*); fromInteger = mkF . fromInteger+instance Num F where+ (+) = oF (+); abs = fF abs+ (-) = oF (-); signum = fF signum+ (*) = oF (*); fromInteger = mkF . fromInteger -instance Real Int1 where toRational (Int1 x) = fromIntegral x % 1-instance Real Int2 where toRational (Int2 x) = fromIntegral x % 1-instance Real Int3 where toRational (Int3 x) = fromIntegral x % 1-instance Real Int4 where toRational (Int4 x) = fromIntegral x % 1-instance Real Word1 where toRational (Word1 x) = fromIntegral x % 1-instance Real Word2 where toRational (Word2 x) = fromIntegral x % 1-instance Real Word3 where toRational (Word3 x) = fromIntegral x % 1-instance Real Word4 where toRational (Word4 x) = fromIntegral x % 1-instance Real Nat where toRational (Nat x) = fromIntegral x % 1-instance Real Nat1 where toRational (Nat1 x) = fromIntegral x % 1-instance Real Nat2 where toRational (Nat2 x) = fromIntegral x % 1-instance Real Nat3 where toRational (Nat3 x) = fromIntegral x % 1-instance Real Nat4 where toRational (Nat4 x) = fromIntegral x % 1-instance Real Nat5 where toRational (Nat5 x) = fromIntegral x % 1-instance Real Nat6 where toRational (Nat6 x) = fromIntegral x % 1-instance Real Nat7 where toRational (Nat7 x) = fromIntegral x % 1-instance Real Natural where toRational (Natural x) = fromIntegral x % 1-instance Real A where toRational (A x) = fromIntegral x % 1-instance Real B where toRational (B x) = fromIntegral x % 1-instance Real C where toRational (C x) = fromIntegral x % 1-instance Real D where toRational (D x) = fromIntegral x % 1-instance Real E where toRational (E x) = fromIntegral x % 1-instance Real F where toRational (F x) = fromIntegral x % 1+instance Real Int1 where toRational (Int1 x) = fromIntegral x % 1+instance Real Int2 where toRational (Int2 x) = fromIntegral x % 1+instance Real Int3 where toRational (Int3 x) = fromIntegral x % 1+instance Real Int4 where toRational (Int4 x) = fromIntegral x % 1+instance Real Word1 where toRational (Word1 x) = fromIntegral x % 1+instance Real Word2 where toRational (Word2 x) = fromIntegral x % 1+instance Real Word3 where toRational (Word3 x) = fromIntegral x % 1+instance Real Word4 where toRational (Word4 x) = fromIntegral x % 1+instance Real Nat where toRational (Nat x) = fromIntegral x % 1+instance Real Nat1 where toRational (Nat1 x) = fromIntegral x % 1+instance Real Nat2 where toRational (Nat2 x) = fromIntegral x % 1+instance Real Nat3 where toRational (Nat3 x) = fromIntegral x % 1+instance Real Nat4 where toRational (Nat4 x) = fromIntegral x % 1+instance Real Nat5 where toRational (Nat5 x) = fromIntegral x % 1+instance Real Nat6 where toRational (Nat6 x) = fromIntegral x % 1+instance Real Nat7 where toRational (Nat7 x) = fromIntegral x % 1+instance Real Natural where toRational (Natural x) = fromIntegral x % 1+instance Real A where toRational (A x) = fromIntegral x % 1+instance Real B where toRational (B x) = fromIntegral x % 1+instance Real C where toRational (C x) = fromIntegral x % 1+instance Real D where toRational (D x) = fromIntegral x % 1+instance Real E where toRational (E x) = fromIntegral x % 1+instance Real F where toRational (F x) = fromIntegral x % 1 -instance Integral Int1 where quotRem = otNewtype int1 unInt1 quotRem- toInteger = toInteger . unInt1+instance Integral Int1 where quotRem = otNewtype int1 unInt1 quotRem+ toInteger = toInteger . unInt1 -instance Integral Int2 where quotRem = otNewtype int2 unInt2 quotRem- toInteger = toInteger . unInt2+instance Integral Int2 where quotRem = otNewtype int2 unInt2 quotRem+ toInteger = toInteger . unInt2 -instance Integral Int3 where quotRem = otNewtype int3 unInt3 quotRem- toInteger = toInteger . unInt3+instance Integral Int3 where quotRem = otNewtype int3 unInt3 quotRem+ toInteger = toInteger . unInt3 -instance Integral Int4 where quotRem = otNewtype int4 unInt4 quotRem- toInteger = toInteger . unInt4+instance Integral Int4 where quotRem = otNewtype int4 unInt4 quotRem+ toInteger = toInteger . unInt4 -instance Integral Word1 where quotRem = otNewtype word1 unWord1 quotRem- toInteger = toInteger . unWord1+instance Integral Word1 where quotRem = otNewtype word1 unWord1 quotRem+ toInteger = toInteger . unWord1 -instance Integral Word2 where quotRem = otNewtype word2 unWord2 quotRem- toInteger = toInteger . unWord2+instance Integral Word2 where quotRem = otNewtype word2 unWord2 quotRem+ toInteger = toInteger . unWord2 -instance Integral Word3 where quotRem = otNewtype word3 unWord3 quotRem- toInteger = toInteger . unWord3+instance Integral Word3 where quotRem = otNewtype word3 unWord3 quotRem+ toInteger = toInteger . unWord3 -instance Integral Word4 where quotRem = otNewtype word4 unWord4 quotRem- toInteger = toInteger . unWord4+instance Integral Word4 where quotRem = otNewtype word4 unWord4 quotRem+ toInteger = toInteger . unWord4 -instance Integral Nat where quotRem = otNewtype Nat unNat quotRem- toInteger = toInteger . unNat+instance Integral Nat where quotRem = otNewtype Nat unNat quotRem+ toInteger = toInteger . unNat -instance Integral Nat1 where quotRem = otNewtype nat1 unNat1 quotRem- toInteger = toInteger . unNat1+instance Integral Nat1 where quotRem = otNewtype nat1 unNat1 quotRem+ toInteger = toInteger . unNat1 -instance Integral Nat2 where quotRem = otNewtype nat2 unNat2 quotRem- toInteger = toInteger . unNat2+instance Integral Nat2 where quotRem = otNewtype nat2 unNat2 quotRem+ toInteger = toInteger . unNat2 -instance Integral Nat3 where quotRem = otNewtype nat3 unNat3 quotRem- toInteger = toInteger . unNat3+instance Integral Nat3 where quotRem = otNewtype nat3 unNat3 quotRem+ toInteger = toInteger . unNat3 -instance Integral Nat4 where quotRem = otNewtype nat4 unNat4 quotRem- toInteger = toInteger . unNat4+instance Integral Nat4 where quotRem = otNewtype nat4 unNat4 quotRem+ toInteger = toInteger . unNat4 -instance Integral Nat5 where quotRem = otNewtype nat5 unNat5 quotRem- toInteger = toInteger . unNat5+instance Integral Nat5 where quotRem = otNewtype nat5 unNat5 quotRem+ toInteger = toInteger . unNat5 -instance Integral Nat6 where quotRem = otNewtype nat6 unNat6 quotRem- toInteger = toInteger . unNat6+instance Integral Nat6 where quotRem = otNewtype nat6 unNat6 quotRem+ toInteger = toInteger . unNat6 -instance Integral Nat7 where quotRem = otNewtype nat7 unNat7 quotRem- toInteger = toInteger . unNat7+instance Integral Nat7 where quotRem = otNewtype nat7 unNat7 quotRem+ toInteger = toInteger . unNat7 -instance Integral Natural where quotRem = otNewtype natural unNatural quotRem- toInteger = toInteger . unNatural+instance Integral Natural where quotRem = otNewtype natural unNatural quotRem+ toInteger = toInteger . unNatural -instance Integral A where quotRem = otNewtype mkA unA quotRem- toInteger = toInteger . unA+instance Integral A where quotRem = otNewtype mkA unA quotRem+ toInteger = toInteger . unA -instance Integral B where quotRem = otNewtype mkB unB quotRem- toInteger = toInteger . unB+instance Integral B where quotRem = otNewtype mkB unB quotRem+ toInteger = toInteger . unB -instance Integral C where quotRem = otNewtype mkC unC quotRem- toInteger = toInteger . unC+instance Integral C where quotRem = otNewtype mkC unC quotRem+ toInteger = toInteger . unC -instance Integral D where quotRem = otNewtype mkD unD quotRem- toInteger = toInteger . unD+instance Integral D where quotRem = otNewtype mkD unD quotRem+ toInteger = toInteger . unD -instance Integral E where quotRem = otNewtype mkE unE quotRem- toInteger = toInteger . unE+instance Integral E where quotRem = otNewtype mkE unE quotRem+ toInteger = toInteger . unE -instance Integral F where quotRem = otNewtype mkF unF quotRem- toInteger = toInteger . unF+instance Integral F where quotRem = otNewtype mkF unF quotRem+ toInteger = toInteger . unF -instance Bounded Int1 where maxBound = Int1 0; minBound = Int1 (-1)-instance Bounded Int2 where maxBound = Int2 1; minBound = Int2 (-2)-instance Bounded Int3 where maxBound = Int3 3; minBound = Int3 (-4)-instance Bounded Int4 where maxBound = Int4 7; minBound = Int4 (-8)-instance Bounded Word1 where maxBound = Word1 1; minBound = Word1 0-instance Bounded Word2 where maxBound = Word2 3; minBound = Word2 0-instance Bounded Word3 where maxBound = Word3 7; minBound = Word3 0-instance Bounded Word4 where maxBound = Word4 15; minBound = Word4 0-instance Bounded Nat where maxBound = Nat maxBound; minBound = Nat 0-instance Bounded Nat1 where maxBound = Nat1 0; minBound = Nat1 0-instance Bounded Nat2 where maxBound = Nat2 1; minBound = Nat2 0-instance Bounded Nat3 where maxBound = Nat3 2; minBound = Nat3 0-instance Bounded Nat4 where maxBound = Nat4 3; minBound = Nat4 0-instance Bounded Nat5 where maxBound = Nat5 4; minBound = Nat5 0-instance Bounded Nat6 where maxBound = Nat6 5; minBound = Nat6 0-instance Bounded Nat7 where maxBound = Nat7 6; minBound = Nat7 0-instance Bounded A where maxBound = A 5; minBound = A 0-instance Bounded B where maxBound = B 5; minBound = B 0-instance Bounded C where maxBound = C 5; minBound = C 0-instance Bounded D where maxBound = D 5; minBound = D 0-instance Bounded E where maxBound = E 5; minBound = E 0-instance Bounded F where maxBound = F 5; minBound = F 0+instance Bounded Int1 where maxBound = Int1 0; minBound = Int1 (-1)+instance Bounded Int2 where maxBound = Int2 1; minBound = Int2 (-2)+instance Bounded Int3 where maxBound = Int3 3; minBound = Int3 (-4)+instance Bounded Int4 where maxBound = Int4 7; minBound = Int4 (-8)+instance Bounded Word1 where maxBound = Word1 1; minBound = Word1 0+instance Bounded Word2 where maxBound = Word2 3; minBound = Word2 0+instance Bounded Word3 where maxBound = Word3 7; minBound = Word3 0+instance Bounded Word4 where maxBound = Word4 15; minBound = Word4 0+instance Bounded Nat where maxBound = Nat maxBound; minBound = Nat 0+instance Bounded Nat1 where maxBound = Nat1 0; minBound = Nat1 0+instance Bounded Nat2 where maxBound = Nat2 1; minBound = Nat2 0+instance Bounded Nat3 where maxBound = Nat3 2; minBound = Nat3 0+instance Bounded Nat4 where maxBound = Nat4 3; minBound = Nat4 0+instance Bounded Nat5 where maxBound = Nat5 4; minBound = Nat5 0+instance Bounded Nat6 where maxBound = Nat6 5; minBound = Nat6 0+instance Bounded Nat7 where maxBound = Nat7 6; minBound = Nat7 0+instance Bounded A where maxBound = A 5; minBound = A 0+instance Bounded B where maxBound = B 5; minBound = B 0+instance Bounded C where maxBound = C 5; minBound = C 0+instance Bounded D where maxBound = D 5; minBound = D 0+instance Bounded E where maxBound = E 5; minBound = E 0+instance Bounded F where maxBound = F 5; minBound = F 0 -instance Enum Int1 where toEnum = int1; enumFrom = boundedEnumFrom- fromEnum = unInt1; enumFromThen = boundedEnumFromThen+instance Enum Int1 where+ toEnum = int1; enumFrom = boundedEnumFrom+ fromEnum = unInt1; enumFromThen = boundedEnumFromThen -instance Enum Int2 where toEnum = int2; enumFrom = boundedEnumFrom- fromEnum = unInt2; enumFromThen = boundedEnumFromThen+instance Enum Int2 where+ toEnum = int2; enumFrom = boundedEnumFrom+ fromEnum = unInt2; enumFromThen = boundedEnumFromThen -instance Enum Int3 where toEnum = int3; enumFrom = boundedEnumFrom- fromEnum = unInt3; enumFromThen = boundedEnumFromThen+instance Enum Int3 where+ toEnum = int3; enumFrom = boundedEnumFrom+ fromEnum = unInt3; enumFromThen = boundedEnumFromThen -instance Enum Int4 where toEnum = int4; enumFrom = boundedEnumFrom- fromEnum = unInt4; enumFromThen = boundedEnumFromThen+instance Enum Int4 where+ toEnum = int4; enumFrom = boundedEnumFrom+ fromEnum = unInt4; enumFromThen = boundedEnumFromThen -instance Enum Word1 where toEnum = word1; enumFrom = boundedEnumFrom- fromEnum = unWord1; enumFromThen = boundedEnumFromThen+instance Enum Word1 where+ toEnum = word1; enumFrom = boundedEnumFrom+ fromEnum = unWord1; enumFromThen = boundedEnumFromThen -instance Enum Word2 where toEnum = word2; enumFrom = boundedEnumFrom- fromEnum = unWord2; enumFromThen = boundedEnumFromThen+instance Enum Word2 where+ toEnum = word2; enumFrom = boundedEnumFrom+ fromEnum = unWord2; enumFromThen = boundedEnumFromThen -instance Enum Word3 where toEnum = word3; enumFrom = boundedEnumFrom- fromEnum = unWord3; enumFromThen = boundedEnumFromThen+instance Enum Word3 where+ toEnum = word3; enumFrom = boundedEnumFrom+ fromEnum = unWord3; enumFromThen = boundedEnumFromThen -instance Enum Word4 where toEnum = word4; enumFrom = boundedEnumFrom- fromEnum = unWord4; enumFromThen = boundedEnumFromThen+instance Enum Word4 where+ toEnum = word4; enumFrom = boundedEnumFrom+ fromEnum = unWord4; enumFromThen = boundedEnumFromThen -instance Enum Nat where toEnum = nat; enumFrom = boundedEnumFrom- fromEnum = unNat; enumFromThen = boundedEnumFromThen+instance Enum Nat where+ toEnum = nat; enumFrom = boundedEnumFrom+ fromEnum = unNat; enumFromThen = boundedEnumFromThen -instance Enum Nat1 where toEnum = nat1; enumFrom = boundedEnumFrom- fromEnum = unNat1; enumFromThen = boundedEnumFromThen+instance Enum Nat1 where+ toEnum = nat1; enumFrom = boundedEnumFrom+ fromEnum = unNat1; enumFromThen = boundedEnumFromThen -instance Enum Nat2 where toEnum = nat2; enumFrom = boundedEnumFrom- fromEnum = unNat2; enumFromThen = boundedEnumFromThen+instance Enum Nat2 where+ toEnum = nat2; enumFrom = boundedEnumFrom+ fromEnum = unNat2; enumFromThen = boundedEnumFromThen -instance Enum Nat3 where toEnum = nat3; enumFrom = boundedEnumFrom- fromEnum = unNat3; enumFromThen = boundedEnumFromThen+instance Enum Nat3 where+ toEnum = nat3; enumFrom = boundedEnumFrom+ fromEnum = unNat3; enumFromThen = boundedEnumFromThen -instance Enum Nat4 where toEnum = nat4; enumFrom = boundedEnumFrom- fromEnum = unNat4; enumFromThen = boundedEnumFromThen+instance Enum Nat4 where+ toEnum = nat4; enumFrom = boundedEnumFrom+ fromEnum = unNat4; enumFromThen = boundedEnumFromThen -instance Enum Nat5 where toEnum = nat5; enumFrom = boundedEnumFrom- fromEnum = unNat5; enumFromThen = boundedEnumFromThen+instance Enum Nat5 where+ toEnum = nat5; enumFrom = boundedEnumFrom+ fromEnum = unNat5; enumFromThen = boundedEnumFromThen -instance Enum Nat6 where toEnum = nat6; enumFrom = boundedEnumFrom- fromEnum = unNat6; enumFromThen = boundedEnumFromThen+instance Enum Nat6 where+ toEnum = nat6; enumFrom = boundedEnumFrom+ fromEnum = unNat6; enumFromThen = boundedEnumFromThen -instance Enum Nat7 where toEnum = nat7; enumFrom = boundedEnumFrom- fromEnum = unNat7; enumFromThen = boundedEnumFromThen+instance Enum Nat7 where+ toEnum = nat7; enumFrom = boundedEnumFrom+ fromEnum = unNat7; enumFromThen = boundedEnumFromThen instance Enum Natural where- toEnum = natural . fromIntegral- fromEnum = fromInteger . unNatural;- enumFrom (Natural x) = map Natural [x..]- enumFromThen (Natural x) (Natural s) = map Natural [x,s..]+ toEnum = natural . fromIntegral+ fromEnum = fromInteger . unNatural+ enumFrom (Natural x) = map Natural [x..]+ enumFromThen (Natural x) (Natural s) = map Natural [x,s..] -instance Enum A where toEnum = mkA; enumFrom = boundedEnumFrom- fromEnum = unA; enumFromThen = boundedEnumFromThen+instance Enum A where+ toEnum = mkA; enumFrom = boundedEnumFrom+ fromEnum = unA; enumFromThen = boundedEnumFromThen -instance Enum B where toEnum = mkB; enumFrom = boundedEnumFrom- fromEnum = unB; enumFromThen = boundedEnumFromThen+instance Enum B where+ toEnum = mkB; enumFrom = boundedEnumFrom+ fromEnum = unB; enumFromThen = boundedEnumFromThen -instance Enum C where toEnum = mkC; enumFrom = boundedEnumFrom- fromEnum = unC; enumFromThen = boundedEnumFromThen+instance Enum C where+ toEnum = mkC; enumFrom = boundedEnumFrom+ fromEnum = unC; enumFromThen = boundedEnumFromThen -instance Enum D where toEnum = mkD; enumFrom = boundedEnumFrom- fromEnum = unD; enumFromThen = boundedEnumFromThen+instance Enum D where+ toEnum = mkD; enumFrom = boundedEnumFrom+ fromEnum = unD; enumFromThen = boundedEnumFromThen -instance Enum E where toEnum = mkE; enumFrom = boundedEnumFrom- fromEnum = unE; enumFromThen = boundedEnumFromThen+instance Enum E where+ toEnum = mkE; enumFrom = boundedEnumFrom+ fromEnum = unE; enumFromThen = boundedEnumFromThen -instance Enum F where toEnum = mkF; enumFrom = boundedEnumFrom- fromEnum = unF; enumFromThen = boundedEnumFromThen+instance Enum F where toEnum = mkF; enumFrom = boundedEnumFrom+ fromEnum = unF; enumFromThen = boundedEnumFromThen -range' :: Enum a => (a,a) -> [a]-range' (m,n) = [m..n]+rng :: Enum a => (a,a) -> [a]+rng (m,n) = [m..n] -index' :: Integral a => (a,a) -> a -> Int-index' b@(m,_) i | inRange' b i = fromIntegral (i - m)- | otherwise = error "Index out of range."+idx :: Integral a => (a,a) -> a -> Int+idx b@(m,_) i | irng b i = fromIntegral (i - m)+ | otherwise = error "Index out of range." -inRange' :: Ord a => (a,a) -> a -> Bool-inRange' (m,n) i = m <= i && i <= m+irng :: Ord a => (a,a) -> a -> Bool+irng (m,n) i = m <= i && i <= m -instance Ix Int1 where range = range'; index = index'; inRange = inRange'-instance Ix Int2 where range = range'; index = index'; inRange = inRange'-instance Ix Int3 where range = range'; index = index'; inRange = inRange'-instance Ix Int4 where range = range'; index = index'; inRange = inRange'-instance Ix Word1 where range = range'; index = index'; inRange = inRange'-instance Ix Word2 where range = range'; index = index'; inRange = inRange'-instance Ix Word3 where range = range'; index = index'; inRange = inRange'-instance Ix Word4 where range = range'; index = index'; inRange = inRange'-instance Ix Nat where range = range'; index = index'; inRange = inRange'-instance Ix Nat1 where range = range'; index = index'; inRange = inRange'-instance Ix Nat2 where range = range'; index = index'; inRange = inRange'-instance Ix Nat3 where range = range'; index = index'; inRange = inRange'-instance Ix Nat4 where range = range'; index = index'; inRange = inRange'-instance Ix Nat5 where range = range'; index = index'; inRange = inRange'-instance Ix Nat6 where range = range'; index = index'; inRange = inRange'-instance Ix Nat7 where range = range'; index = index'; inRange = inRange'-instance Ix Natural where range = range'; index = index'; inRange = inRange'-instance Ix A where range = range'; index = index'; inRange = inRange'-instance Ix B where range = range'; index = index'; inRange = inRange'-instance Ix C where range = range'; index = index'; inRange = inRange'-instance Ix D where range = range'; index = index'; inRange = inRange'-instance Ix E where range = range'; index = index'; inRange = inRange'-instance Ix F where range = range'; index = index'; inRange = inRange'+instance Ix Int1 where range = rng; index = idx; inRange = irng+instance Ix Int2 where range = rng; index = idx; inRange = irng+instance Ix Int3 where range = rng; index = idx; inRange = irng+instance Ix Int4 where range = rng; index = idx; inRange = irng+instance Ix Word1 where range = rng; index = idx; inRange = irng+instance Ix Word2 where range = rng; index = idx; inRange = irng+instance Ix Word3 where range = rng; index = idx; inRange = irng+instance Ix Word4 where range = rng; index = idx; inRange = irng+instance Ix Nat where range = rng; index = idx; inRange = irng+instance Ix Nat1 where range = rng; index = idx; inRange = irng+instance Ix Nat2 where range = rng; index = idx; inRange = irng+instance Ix Nat3 where range = rng; index = idx; inRange = irng+instance Ix Nat4 where range = rng; index = idx; inRange = irng+instance Ix Nat5 where range = rng; index = idx; inRange = irng+instance Ix Nat6 where range = rng; index = idx; inRange = irng+instance Ix Nat7 where range = rng; index = idx; inRange = irng+instance Ix Natural where range = rng; index = idx; inRange = irng+instance Ix A where range = rng; index = idx; inRange = irng+instance Ix B where range = rng; index = idx; inRange = irng+instance Ix C where range = rng; index = idx; inRange = irng+instance Ix D where range = rng; index = idx; inRange = irng+instance Ix E where range = rng; index = idx; inRange = irng+instance Ix F where range = rng; index = idx; inRange = irng -instance Listable Int1 where list = [0,minBound]-instance Listable Int2 where list = listIntegral-instance Listable Int3 where list = listIntegral-instance Listable Int4 where list = listIntegral-instance Listable Word1 where list = listIntegral-instance Listable Word2 where list = listIntegral-instance Listable Word3 where list = listIntegral-instance Listable Word4 where list = listIntegral-instance Listable Nat where list = listIntegral-instance Listable Nat1 where list = listIntegral-instance Listable Nat2 where list = listIntegral-instance Listable Nat3 where list = listIntegral-instance Listable Nat4 where list = listIntegral-instance Listable Nat5 where list = listIntegral-instance Listable Nat6 where list = listIntegral-instance Listable Nat7 where list = listIntegral-instance Listable Natural where list = listIntegral-instance Listable A where list = listIntegral-instance Listable B where list = listIntegral-instance Listable C where list = listIntegral-instance Listable D where list = listIntegral-instance Listable E where list = listIntegral-instance Listable F where list = listIntegral+instance Listable Int1 where list = [0,minBound]+instance Listable Int2 where list = listIntegral+instance Listable Int3 where list = listIntegral+instance Listable Int4 where list = listIntegral+instance Listable Word1 where list = listIntegral+instance Listable Word2 where list = listIntegral+instance Listable Word3 where list = listIntegral+instance Listable Word4 where list = listIntegral+instance Listable Nat where list = listIntegral+instance Listable Nat1 where list = listIntegral+instance Listable Nat2 where list = listIntegral+instance Listable Nat3 where list = listIntegral+instance Listable Nat4 where list = listIntegral+instance Listable Nat5 where list = listIntegral+instance Listable Nat6 where list = listIntegral+instance Listable Nat7 where list = listIntegral+instance Listable Natural where list = listIntegral+instance Listable A where list = listIntegral+instance Listable B where list = listIntegral+instance Listable C where list = listIntegral+instance Listable D where list = listIntegral+instance Listable E where list = listIntegral+instance Listable F where list = listIntegral -- | Deprecated. Use 'Word1'.-type UInt1 = Word1+type UInt1 = Word1 -- | Deprecated. Use 'Word2'.-type UInt2 = Word2+type UInt2 = Word2 -- | Deprecated. Use 'Word3'.-type UInt3 = Word3+type UInt3 = Word3 -- | Deprecated. Use 'Word4'.-type UInt4 = Word4+type UInt4 = Word4 -- | Lists without repeated elements. --@@ -764,7 +815,7 @@ -- > [0,0] -- > > check $ \(NoDup xs) -> nub xs == (xs :: [Int]) -- > +++ OK, passed 200 tests.-newtype NoDup a = NoDup [a] deriving (Show, Read, Eq, Ord)+newtype NoDup a = NoDup [a] deriving (Show, Read, Eq, Ord) -- | Lists representing bags (multisets). -- The 'Listable' 'tiers' enumeration will not have repeated bags.@@ -773,27 +824,27 @@ -- > [Bag [],Bag [0],Bag [0,0],Bag [1],Bag [0,0,0],Bag [0,1]] -- -- See also: 'Test.LeanCheck.Tiers.bagsOf' and 'bagCons'.-newtype Bag a = Bag [a] deriving (Show, Read, Eq, Ord)+newtype Bag a = Bag [a] deriving (Show, Read, Eq, Ord) -- | Lists representing sets. -- The 'Listable' 'tiers' enumeration will not have repeated sets. -- -- > > take 6 (list :: [Set Nat]) -- > [Set [],Set [0],Set [1],Set [0,1],Set [2],Set [0,2]]-newtype Set a = Set [a] deriving (Show, Read, Eq, Ord)+newtype Set a = Set [a] deriving (Show, Read, Eq, Ord) -- | Lists of pairs representing maps. -- The 'Listable' 'tiers' enumeration will not have repeated maps. -- -- > > take 6 (list :: [Map Nat Nat]) -- > [Map [],Map [(0,0)],Map [(0,1)],Map [(1,0)],Map [(0,2)],Map [(1,1)]]-newtype Map a b = Map [(a,b)] deriving (Show, Read, Eq, Ord)+newtype Map a b = Map [(a,b)] deriving (Show, Read, Eq, Ord) -instance Listable a => Listable (NoDup a) where tiers = noDupListCons NoDup-instance Listable a => Listable (Bag a) where tiers = bagCons Bag-instance Listable a => Listable (Set a) where tiers = setCons Set+instance Listable a => Listable (NoDup a) where tiers = noDupListCons NoDup+instance Listable a => Listable (Bag a) where tiers = bagCons Bag+instance Listable a => Listable (Set a) where tiers = setCons Set instance (Listable a, Listable b)- => Listable (Map a b) where tiers = mapCons Map+ => Listable (Map a b) where tiers = mapCons Map -- | 'X' type to be wrapped around integer types for an e-'X'-treme integer -- enumeration. See the 'Listable' instance for 'X'. Use 'X' when@@ -805,12 +856,13 @@ -- > > check $ \(X x) -> x + 1 > (x :: Int) -- > +++ Failed! Falsifiable (after 4 tests): -- > 9223372036854775807-newtype X a = X {unX :: a} deriving (Eq, Ord)-instance Show a => Show (X a) where show (X x) = show x-instance (Integral a, Bounded a) => Listable (X a) where list = map X listXIntegral+newtype X a = X {unX :: a} deriving (Eq, Ord)+instance Show a => Show (X a) where show (X x) = show x+instance (Integral a, Bounded a) => Listable (X a) where+ list = map X listXIntegral -- ^ Extremily large integers are intercalated with small integers. ----- > list :: [X Int] = map X+-- > list :: [X Int] = map X -- > [ 0, 1, -1, maxBound, minBound -- > , 2, -2, maxBound-1, minBound+1 -- > , 3, -3, maxBound-2, minBound+2@@ -819,45 +871,45 @@ -- FIXME: make this work for Int2 / Word2 types -- by checking then using normal enumeration listXIntegral :: (Bounded a, Integral a) => [a]-listXIntegral = l undefined+listXIntegral = l undefined where l :: (Bounded a, Integral a) => a -> [a]- l a | count a <= 4 = listIntegral- | min < 0 = listXIntegralN- | otherwise = listXIntegralP+ l a | count a <= 4 = listIntegral+ | min < 0 = listXIntegralN+ | otherwise = listXIntegralP where- min = minBound `asTypeOf` a+ min = minBound `asTypeOf` a -- The type-hackery above is needed so that we don't need to activate -- ScopedTypeVariables listXIntegralN :: (Bounded a, Integral a) => [a]-listXIntegralN = 0 : (extremes 1 maxBound) +| (extremes (-1) minBound)+listXIntegralN = 0 : (extremes 1 maxBound) +| (extremes (-1) minBound) -- listXIntegralN :: Int4 = -- 0 : (([1,2,3,4] +| [7,6,5]) +| ([-1,-2,-3,-4] +| [-8,-7,-6,-5])) listXIntegralP :: (Bounded a, Integral a) => [a]-listXIntegralP = 0 : [1..midBound] ++| [maxBound,(maxBound-1)..(midBound+1)]+listXIntegralP = 0 : [1..midBound] ++| [maxBound,(maxBound-1)..(midBound+1)] where- midBound = maxBound `div` 3 * 2+ midBound = maxBound `div` 3 * 2 -- how many of this type exist? -- assumes 0 `elem` [minBound..maxBound] count :: (Bounded a, Integral a) => a -> Integer count a = 1 + max + abs min where- min = fromIntegral $ minBound `asTypeOf` a- max = fromIntegral $ maxBound `asTypeOf` a+ min = fromIntegral $ minBound `asTypeOf` a+ max = fromIntegral $ maxBound `asTypeOf` a extremes :: (Integral a) => a -> a -> [a] extremes x y | x > y = [x,x-1..m] +| [y..m-1] | otherwise = [x..m] +| [y,y-1..m+1]- where m = mid x y+ where m = mid x y mid :: Integral a => a -> a -> a-mid x y = x `div` 2- + y `div` 2- + if odd x && odd y then 1 else 0+mid x y = x `div` 2+ + y `div` 2+ + if odd x && odd y then 1 else 0 -- | Lazily interleaves two lists, switching between elements of the two. -- This version uses the first list more frequently than the second.@@ -879,9 +931,9 @@ -- > > check $ \(Xs xs) -> all (>=0) xs ==> sum (take 1 xs :: [Int]) <= sum xs -- > *** Failed! Falsifiable (after 56 tests): -- > [1,9223372036854775807]-newtype Xs a = Xs [a] deriving (Eq, Ord, Show, Read)+newtype Xs a = Xs [a] deriving (Eq, Ord, Show, Read) instance (Integral a, Bounded a) => Listable (Xs a) where- tiers = cons1 (Xs . map unX)+ tiers = cons1 (Xs . map unX) -- ^ Lists with elements of the 'X' type. -- | Space characters.@@ -944,22 +996,35 @@ -- Equivalent to 'Alpha'. data Letter = Letter {unLetter :: Char} -instance Show Space where show = show . unSpace-instance Show Lower where show = show . unLower-instance Show Upper where show = show . unUpper-instance Show Alpha where show = show . unAlpha-instance Show Digit where show = show . unDigit-instance Show AlphaNum where show = show . unAlphaNum-instance Show Letter where show = show . unLetter+instance Show Space where show = show . unSpace+instance Show Lower where show = show . unLower+instance Show Upper where show = show . unUpper+instance Show Alpha where show = show . unAlpha+instance Show Digit where show = show . unDigit+instance Show AlphaNum where show = show . unAlphaNum+instance Show Letter where show = show . unLetter -instance Listable Space where list = map Space [' ', '\t', '\n', '\r', '\f', '\v']-instance Listable Lower where list = map Lower ['a'..'z']-instance Listable Upper where list = map Upper ['A'..'Z']-instance Listable Alpha where list = map Alpha $ ['a'..'z'] +| ['A'..'Z']-instance Listable Digit where list = map Digit ['0'..'9']-instance Listable AlphaNum where list = map AlphaNum $ ['0'..'9'] +| ['a'..'z'] +| ['A'..'Z']-instance Listable Letter where list = map Letter $ ['a'..'z'] +| ['A'..'Z']+instance Listable Space where+ list = map Space [' ', '\t', '\n', '\r', '\f', '\v'] +instance Listable Lower where+ list = map Lower ['a'..'z']++instance Listable Upper where+ list = map Upper ['A'..'Z']++instance Listable Alpha where+ list = map Alpha $ ['a'..'z'] +| ['A'..'Z']++instance Listable Digit where+ list = map Digit ['0'..'9']++instance Listable AlphaNum where+ list = map AlphaNum $ ['0'..'9'] +| ['a'..'z'] +| ['A'..'Z']++instance Listable Letter where+ list = map Letter $ ['a'..'z'] +| ['A'..'Z']+ -- | Strings of spaces. data Spaces = Spaces {unSpaces :: String} @@ -981,21 +1046,21 @@ -- | Strings of letters data Letters = Letters {unLetters :: String} -instance Show Spaces where show = show . unSpaces-instance Show Lowers where show = show . unLowers-instance Show Uppers where show = show . unUppers-instance Show Alphas where show = show . unAlphas-instance Show Digits where show = show . unDigits-instance Show AlphaNums where show = show . unAlphaNums-instance Show Letters where show = show . unLetters+instance Show Spaces where show = show . unSpaces+instance Show Lowers where show = show . unLowers+instance Show Uppers where show = show . unUppers+instance Show Alphas where show = show . unAlphas+instance Show Digits where show = show . unDigits+instance Show AlphaNums where show = show . unAlphaNums+instance Show Letters where show = show . unLetters -instance Listable Spaces where tiers = cons1 (Spaces . map unSpace)-instance Listable Lowers where tiers = cons1 (Lowers . map unLower)-instance Listable Uppers where tiers = cons1 (Uppers . map unUpper)-instance Listable Alphas where tiers = cons1 (Alphas . map unAlpha)-instance Listable Digits where tiers = cons1 (Digits . map unDigit)-instance Listable AlphaNums where tiers = cons1 (AlphaNums . map unAlphaNum)-instance Listable Letters where tiers = cons1 (Letters . map unLetter)+instance Listable Spaces where tiers = cons1 (Spaces . map unSpace)+instance Listable Lowers where tiers = cons1 (Lowers . map unLower)+instance Listable Uppers where tiers = cons1 (Uppers . map unUpper)+instance Listable Alphas where tiers = cons1 (Alphas . map unAlpha)+instance Listable Digits where tiers = cons1 (Digits . map unDigit)+instance Listable AlphaNums where tiers = cons1 (AlphaNums . map unAlphaNum)+instance Listable Letters where tiers = cons1 (Letters . map unLetter) #if __GLASGOW_HASKELL__ == 708 -- there's no need to derive these on GHC >= 7.10
stack.yaml view
@@ -1,4 +1,4 @@-resolver: lts-17.9 # or ghc-8.10.4+resolver: lts-19.19 # or ghc-9.0.2 packages: - .
test/Test.hs view
@@ -42,12 +42,12 @@ import Test.LeanCheck.Utils.Types (Nat(..)) readMaybe :: Read a => String -> Maybe a-readMaybe s = case readsPrec 0 s of- [(x,"")] -> Just x- _ -> Nothing+readMaybe s = case readsPrec 0 s of+ [(x,"")] -> Just x+ _ -> Nothing getMaxTestsFromArgs :: Int -> IO Int-getMaxTestsFromArgs n = do+getMaxTestsFromArgs n = do as <- getArgs return $ case as of (s:_) -> fromMaybe n $ readMaybe s@@ -55,43 +55,43 @@ -- | check if a list is ordered ordered :: Ord a => [a] -> Bool-ordered = orderedBy compare--- ordered [] = True--- ordered [_] = True--- ordered (x:y:xs) = x <= y && ordered (y:xs)+ordered = orderedBy compare+-- ordered [] = True+-- ordered [_] = True+-- ordered (x:y:xs) = x <= y && ordered (y:xs) strictlyOrdered :: Ord a => [a] -> Bool-strictlyOrdered = strictlyOrderedBy compare+strictlyOrdered = strictlyOrderedBy compare -- | check if a list is ordered by a given ordering function orderedBy :: (a -> a -> Ordering) -> [a] -> Bool-orderedBy _ [] = True-orderedBy _ [_] = True-orderedBy cmp (x:y:xs) = case x `cmp` y of+orderedBy _ [] = True+orderedBy _ [_] = True+orderedBy cmp (x:y:xs) = case x `cmp` y of GT -> False _ -> orderedBy cmp (y:xs) orderedOn :: Ord b => (a -> b) -> [a] -> Bool-orderedOn f = orderedBy (comparing f)+orderedOn f = orderedBy (comparing f) -- | check if a list is strictly ordered by a given ordering function strictlyOrderedBy :: (a -> a -> Ordering) -> [a] -> Bool-strictlyOrderedBy _ [] = True-strictlyOrderedBy _ [_] = True-strictlyOrderedBy cmp (x:y:xs) = case x `cmp` y of+strictlyOrderedBy _ [] = True+strictlyOrderedBy _ [_] = True+strictlyOrderedBy cmp (x:y:xs) = case x `cmp` y of LT -> strictlyOrderedBy cmp (y:xs) _ -> False strictlyOrderedOn :: Ord b => (a -> b) -> [a] -> Bool-strictlyOrderedOn f = strictlyOrderedBy (comparing f)+strictlyOrderedOn f = strictlyOrderedBy (comparing f) ifNotEq :: Ordering -> Ordering -> Ordering--- Could be implemented as: ifNotEq = mappend-ifNotEq EQ p = p-ifNotEq o _ = o+-- Could be implemented as: ifNotEq = mappend+ifNotEq EQ p = p+ifNotEq o _ = o thn :: (a->a->Ordering) -> (a->a->Ordering) -> a -> a -> Ordering-thn cmp1 cmp2 x y = (x `cmp1` y) `ifNotEq` (x `cmp2` y)+thn cmp1 cmp2 x y = (x `cmp1` y) `ifNotEq` (x `cmp2` y) infixr 9 `thn` @@ -99,63 +99,67 @@ -- -- > (n `seriesOrderedBy`) comparing (id :: Type) tOrderedBy :: Listable a => Int -> (a -> a -> Ordering) -> Bool-tOrderedBy n cmp = orderedBy cmp $ take n list+tOrderedBy n cmp = orderedBy cmp $ take n list infixr 9 `tOrderedBy` tStrictlyOrderedBy :: Listable a => Int -> (a -> a -> Ordering) -> Bool-tStrictlyOrderedBy n cmp = strictlyOrderedBy cmp $ take n list+tStrictlyOrderedBy n cmp = strictlyOrderedBy cmp $ take n list infixr 9 `tStrictlyOrderedBy` tNatPairOrd :: Int -> Bool-tNatPairOrd n = n `tStrictlyOrderedBy` comparing sum' `thn` compare- where sum' (x,y) = x+y :: Nat+tNatPairOrd n = n `tStrictlyOrderedBy` comparing sum' `thn` compare+ where sum' (x,y) = x+y :: Nat tNatTripleOrd :: Int -> Bool-tNatTripleOrd n = n `tStrictlyOrderedBy` comparing sum' `thn` compare- where sum' (x,y,z) = x+y+z :: Nat+tNatTripleOrd n = n `tStrictlyOrderedBy` comparing sum' `thn` compare+ where sum' (x,y,z) = x+y+z :: Nat tNatQuadrupleOrd :: Int -> Bool-tNatQuadrupleOrd n = n `tStrictlyOrderedBy` comparing sum' `thn` compare- where sum' (x,y,z,w) = x+y+z+w :: Nat+tNatQuadrupleOrd n = n `tStrictlyOrderedBy` comparing sum' `thn` compare+ where sum' (x,y,z,w) = x+y+z+w :: Nat tNatQuintupleOrd :: Int -> Bool-tNatQuintupleOrd n = n `tStrictlyOrderedBy` comparing sum' `thn` compare- where sum' (x,y,z,w,v) = x+y+z+w+v :: Nat+tNatQuintupleOrd n = n `tStrictlyOrderedBy` comparing sum' `thn` compare+ where sum' (x,y,z,w,v) = x+y+z+w+v :: Nat tNatListOrd :: Int -> Bool-tNatListOrd n = n `tStrictlyOrderedBy` comparing sum' `thn` compare- where sum' = sum . map (+1) :: [Nat] -> Nat+tNatListOrd n = n `tStrictlyOrderedBy` comparing sum' `thn` compare+ where sum' = sum . map (+1) :: [Nat] -> Nat tListsOfStrictlyOrderedBy :: Int -> (a -> a -> Ordering) -> [[a]] -> Bool-tListsOfStrictlyOrderedBy n cmp = strictlyOrderedBy cmp . take n . concat+tListsOfStrictlyOrderedBy n cmp = strictlyOrderedBy cmp . take n . concat infixr 9 `tListsOfStrictlyOrderedBy` tListsOfNatOrd :: Int -> Bool-tListsOfNatOrd n = tListsOfStrictlyOrderedBy n (comparing sum' `thn` compare) tiers- where sum' = sum . map (+1) :: [Nat] -> Nat+tListsOfNatOrd n =+ tListsOfStrictlyOrderedBy n (comparing sum' `thn` compare) tiers+ where+ sum' = sum . map (+1) :: [Nat] -> Nat tPairEqParams :: Int -> Bool-tPairEqParams n = ces == srs+tPairEqParams n = ces == srs where- ces = map (map read) $ counterExamples n fail- srs = map pairToList $ take n list- pairToList (x,y) = [x,y :: Nat]+ ces = map (map read) $ counterExamples n fail+ srs = map pairToList $ take n list+ pairToList (x,y) = [x,y :: Nat] fail :: Nat -> Nat -> Bool- fail x y = False+ fail x y = False tTripleEqParams :: Int -> Bool-tTripleEqParams n = ces == srs+tTripleEqParams n = ces == srs where- ces = map (map read) $ counterExamples n fail- srs = map tripleToList $ take n list- tripleToList (x,y,z) = [x,y,z :: Nat]+ ces = map (map read) $ counterExamples n fail+ srs = map tripleToList $ take n list+ tripleToList (x,y,z) = [x,y,z :: Nat] fail :: Nat -> Nat -> Nat -> Bool- fail x y z = False+ fail x y z = False tProductsIsFilterByLength :: Eq a => [[a]] -> Int -> Int -> Bool-tProductsIsFilterByLength values m n = concat (take m byProduct) `isPrefixOf` concat byFilter- where byProduct = products $ replicate n values- byFilter = ((==n) . length) `filterT` listsOf values+tProductsIsFilterByLength values m n =+ concat (take m byProduct) `isPrefixOf` concat byFilter+ where+ byProduct = products $ replicate n values+ byFilter = ((==n) . length) `filterT` listsOf values
test/derive.hs view
@@ -8,13 +8,13 @@ import Data.List (elemIndices,sort) import Test.LeanCheck.Utils -data D0 = D0 deriving Show-data D1 a = D1 a deriving Show-data D2 a b = D2 a b deriving Show-data D3 a b c = D3 a b c deriving Show-data C1 a = C11 a | C10 deriving Show-data C2 a b = C22 a b | C21 a | C20 deriving Show-data I a b = a :+ b deriving Show+data D0 = D0 deriving Show+data D1 a = D1 a deriving Show+data D2 a b = D2 a b deriving Show+data D3 a b c = D3 a b c deriving Show+data C1 a = C11 a | C10 deriving Show+data C2 a b = C22 a b | C21 a | C20 deriving Show+data I a b = a :+ b deriving Show deriveListable ''D0 deriveListable ''D1@@ -25,10 +25,10 @@ deriveListable ''I -- recursive datatypes-data Peano = Zero | Succ Peano deriving Show-data List a = a :- List a | Nil deriving Show-data Bush a = Bush a :-: Bush a | Leaf a deriving (Show, Eq)-data Tree a = Node (Tree a) a (Tree a) | Null deriving (Show, Eq)+data Peano = Zero | Succ Peano deriving Show+data List a = a :- List a | Nil deriving Show+data Bush a = Bush a :-: Bush a | Leaf a deriving (Show, Eq)+data Tree a = Node (Tree a) a (Tree a) | Null deriving (Show, Eq) deriveListable ''Peano deriveListable ''List@@ -36,30 +36,30 @@ deriveListable ''Tree -- Nested datatype cascade-data Nested = Nested N0 (N1 Int) (N2 Int Int)-data N0 = R0 Int-data N1 a = R1 a-data N2 a b = R2 a b+data Nested = Nested N0 (N1 Int) (N2 Int Int)+data N0 = R0 Int+data N1 a = R1 a+data N2 a b = R2 a b deriveListableCascading ''Nested -- Recursive nested datatype cascade-data RN = RN RN0 (RN1 Int) (RN2 Int RN)-data RN0 = Nest0 Int | Recurse0 RN-data RN1 a = Nest1 a | Recurse1 RN-data RN2 a b = Nest2 a b | Recurse2 RN+data RN = RN RN0 (RN1 Int) (RN2 Int RN)+data RN0 = Nest0 Int | Recurse0 RN+data RN1 a = Nest1 a | Recurse1 RN+data RN2 a b = Nest2 a b | Recurse2 RN deriveListableCascading ''RN -- Type synonyms-data Pair a = Pair a a-type Alias a = Pair a+data Pair a = Pair a a+type Alias a = Pair a -- deriveListable ''Alias -- this will fail deriveListableCascading ''Alias deriveListableIfNeeded ''Alias -- only works because instance already exists -- Nested type synonyms-data Triple a = Triple a a a-type Tralias a = Triple a-data Pairiple a = Pairriple (Tralias a) (Tralias a)+data Triple a = Triple a a a+type Tralias a = Triple a+data Pairiple a = Pairriple (Tralias a) (Tralias a) deriveListableCascading ''Pairiple -- Those should have no effect (instance already exists):@@ -130,7 +130,8 @@ , (tiers :: [[ [Bool] ]]) =| 6 |= $(deriveTiers ''[]) , (tiers :: [[ Maybe Int ]]) =| 6 |= $(deriveTiers ''Maybe) , (tiers :: [[ Maybe Bool ]]) =| 6 |= $(deriveTiers ''Maybe)- , ([]:tiers :: [[Either Bool Int]]) =$ map sort . take 6 $= $(deriveTiers ''Either)+ , ([]:tiers :: [[Either Bool Int]])+ =$ map sort . take 6 $= $(deriveTiers ''Either) , (list :: [ Bool ]) =| n |= $(deriveList ''Bool) , (list :: [ [Int] ]) =| n |= $(deriveList ''[])@@ -139,15 +140,15 @@ , (list :: [ Maybe Bool ]) =| n |= $(deriveList ''Maybe) ] where- unD0 (D0) = ()- unD1 (D1 x) = (x)- unD2 (D2 x y) = (x,y)- unD3 (D3 x y z) = (x,y,z)+ unD0 (D0) = ()+ unD1 (D1 x) = (x)+ unD2 (D2 x y) = (x,y)+ unD3 (D3 x y z) = (x,y,z) peanoToNat :: Peano -> Nat-peanoToNat Zero = 0-peanoToNat (Succ n) = 1 + peanoToNat n+peanoToNat Zero = 0+peanoToNat (Succ n) = 1 + peanoToNat n listToList :: List a -> [a]-listToList Nil = []-listToList (x :- xs) = x : listToList xs+listToList Nil = []+listToList (x :- xs) = x : listToList xs
test/diff/eg/test-float.out view
@@ -1,19 +1,19 @@-*** Failed! Falsifiable (after 74 tests):+*** Failed! Falsifiable (after 65 tests): 0.33333334 1.0-*** Failed! Falsifiable (after 74 tests):+*** Failed! Falsifiable (after 65 tests): 0.33333334 1.0-*** Failed! Falsifiable (after 1188 tests):-0.2 0.2-*** Failed! Falsifiable (after 584 tests):-0.2 0.33333334+*** Failed! Falsifiable (after 694 tests):+1.6666666 0.33333334+*** Failed! Falsifiable (after 475 tests):+0.33333334 0.6 +++ OK, passed 10000 tests. +++ OK, passed 10000 tests. +++ OK, passed 10000 tests. +++ OK, passed 10000 tests.-*** Failed! Falsifiable (after 38 tests):-0.14285715+*** Failed! Falsifiable (after 22 tests):+0.6 *** Failed! Falsifiable (after 1 tests): () +++ OK, passed 10000 tests.-*** Failed! Falsifiable (after 5 tests):+*** Failed! Falsifiable (after 4 tests): 0.5
test/diff/tiers-ComplexDouble.out view
@@ -1,4 +1,4 @@-map length (tiers :: [[ Complex Double ]]) = [0,1,2,5,10,14,20,25,32,40,48,60,...]+map length (tiers :: [[ Complex Double ]]) = [0,1,2,3,4,5,6,7,8,9,10,11,...] length (list :: [ Complex Double ]) = Infinity @@ -13,267 +13,76 @@ , 1.0 :+ 0.0 ] , [ 0.0 :+ (-1.0)- , 0.0 :+ Infinity , 1.0 :+ 1.0 , (-1.0) :+ 0.0- , Infinity :+ 0.0 ] , [ 0.0 :+ 0.5- , 0.0 :+ 2.0- , 0.0 :+ (-Infinity) , 1.0 :+ (-1.0)- , 1.0 :+ Infinity , (-1.0) :+ 1.0- , Infinity :+ 1.0 , 0.5 :+ 0.0- , 2.0 :+ 0.0- , (-Infinity) :+ 0.0 ] , [ 0.0 :+ (-0.5)- , 0.0 :+ (-2.0) , 1.0 :+ 0.5+ , (-1.0) :+ (-1.0)+ , 0.5 :+ 1.0+ , (-0.5) :+ 0.0+ ]+ , [ 0.0 :+ 2.0+ , 1.0 :+ (-0.5)+ , (-1.0) :+ 0.5+ , 0.5 :+ (-1.0)+ , (-0.5) :+ 1.0+ , 2.0 :+ 0.0+ ]+ , [ 0.0 :+ Infinity , 1.0 :+ 2.0+ , (-1.0) :+ (-0.5)+ , 0.5 :+ 0.5+ , (-0.5) :+ (-1.0)+ , 2.0 :+ 1.0+ , Infinity :+ 0.0+ ]+ , [ 0.0 :+ (-Infinity)+ , 1.0 :+ Infinity+ , (-1.0) :+ 2.0+ , 0.5 :+ (-0.5)+ , (-0.5) :+ 0.5+ , 2.0 :+ (-1.0)+ , Infinity :+ 1.0+ , (-Infinity) :+ 0.0+ ]+ , [ 0.0 :+ (-2.0) , 1.0 :+ (-Infinity)- , (-1.0) :+ (-1.0) , (-1.0) :+ Infinity+ , 0.5 :+ 2.0+ , (-0.5) :+ (-0.5)+ , 2.0 :+ 0.5 , Infinity :+ (-1.0)- , Infinity :+ Infinity- , 0.5 :+ 1.0- , 2.0 :+ 1.0 , (-Infinity) :+ 1.0- , (-0.5) :+ 0.0 , (-2.0) :+ 0.0 ] , [ 0.0 :+ 0.3333333333333333- , 0.0 :+ 3.0- , 1.0 :+ (-0.5) , 1.0 :+ (-2.0)- , (-1.0) :+ 0.5- , (-1.0) :+ 2.0 , (-1.0) :+ (-Infinity)- , Infinity :+ 0.5- , Infinity :+ 2.0- , Infinity :+ (-Infinity)- , 0.5 :+ (-1.0) , 0.5 :+ Infinity- , 2.0 :+ (-1.0)- , 2.0 :+ Infinity+ , (-0.5) :+ 2.0+ , 2.0 :+ (-0.5)+ , Infinity :+ 0.5 , (-Infinity) :+ (-1.0)- , (-Infinity) :+ Infinity- , (-0.5) :+ 1.0 , (-2.0) :+ 1.0 , 0.3333333333333333 :+ 0.0- , 3.0 :+ 0.0 ] , [ 0.0 :+ (-0.3333333333333333)- , 0.0 :+ (-3.0) , 1.0 :+ 0.3333333333333333- , 1.0 :+ 3.0- , (-1.0) :+ (-0.5) , (-1.0) :+ (-2.0)- , Infinity :+ (-0.5)- , Infinity :+ (-2.0)- , 0.5 :+ 0.5- , 0.5 :+ 2.0 , 0.5 :+ (-Infinity)- , 2.0 :+ 0.5+ , (-0.5) :+ Infinity , 2.0 :+ 2.0- , 2.0 :+ (-Infinity)+ , Infinity :+ (-0.5) , (-Infinity) :+ 0.5- , (-Infinity) :+ 2.0- , (-Infinity) :+ (-Infinity)- , (-0.5) :+ (-1.0)- , (-0.5) :+ Infinity , (-2.0) :+ (-1.0)- , (-2.0) :+ Infinity , 0.3333333333333333 :+ 1.0- , 3.0 :+ 1.0 , (-0.3333333333333333) :+ 0.0- , (-3.0) :+ 0.0- ]- , [ 0.0 :+ 0.25- , 0.0 :+ 0.6666666666666666- , 0.0 :+ 1.5- , 0.0 :+ 4.0- , 1.0 :+ (-0.3333333333333333)- , 1.0 :+ (-3.0)- , (-1.0) :+ 0.3333333333333333- , (-1.0) :+ 3.0- , Infinity :+ 0.3333333333333333- , Infinity :+ 3.0- , 0.5 :+ (-0.5)- , 0.5 :+ (-2.0)- , 2.0 :+ (-0.5)- , 2.0 :+ (-2.0)- , (-Infinity) :+ (-0.5)- , (-Infinity) :+ (-2.0)- , (-0.5) :+ 0.5- , (-0.5) :+ 2.0- , (-0.5) :+ (-Infinity)- , (-2.0) :+ 0.5- , (-2.0) :+ 2.0- , (-2.0) :+ (-Infinity)- , 0.3333333333333333 :+ (-1.0)- , 0.3333333333333333 :+ Infinity- , 3.0 :+ (-1.0)- , 3.0 :+ Infinity- , (-0.3333333333333333) :+ 1.0- , (-3.0) :+ 1.0- , 0.25 :+ 0.0- , 0.6666666666666666 :+ 0.0- , 1.5 :+ 0.0- , 4.0 :+ 0.0- ]- , [ 0.0 :+ (-0.25)- , 0.0 :+ (-0.6666666666666666)- , 0.0 :+ (-1.5)- , 0.0 :+ (-4.0)- , 1.0 :+ 0.25- , 1.0 :+ 0.6666666666666666- , 1.0 :+ 1.5- , 1.0 :+ 4.0- , (-1.0) :+ (-0.3333333333333333)- , (-1.0) :+ (-3.0)- , Infinity :+ (-0.3333333333333333)- , Infinity :+ (-3.0)- , 0.5 :+ 0.3333333333333333- , 0.5 :+ 3.0- , 2.0 :+ 0.3333333333333333- , 2.0 :+ 3.0- , (-Infinity) :+ 0.3333333333333333- , (-Infinity) :+ 3.0- , (-0.5) :+ (-0.5)- , (-0.5) :+ (-2.0)- , (-2.0) :+ (-0.5)- , (-2.0) :+ (-2.0)- , 0.3333333333333333 :+ 0.5- , 0.3333333333333333 :+ 2.0- , 0.3333333333333333 :+ (-Infinity)- , 3.0 :+ 0.5- , 3.0 :+ 2.0- , 3.0 :+ (-Infinity)- , (-0.3333333333333333) :+ (-1.0)- , (-0.3333333333333333) :+ Infinity- , (-3.0) :+ (-1.0)- , (-3.0) :+ Infinity- , 0.25 :+ 1.0- , 0.6666666666666666 :+ 1.0- , 1.5 :+ 1.0- , 4.0 :+ 1.0- , (-0.25) :+ 0.0- , (-0.6666666666666666) :+ 0.0- , (-1.5) :+ 0.0- , (-4.0) :+ 0.0- ]- , [ 0.0 :+ 0.2- , 0.0 :+ 5.0- , 1.0 :+ (-0.25)- , 1.0 :+ (-0.6666666666666666)- , 1.0 :+ (-1.5)- , 1.0 :+ (-4.0)- , (-1.0) :+ 0.25- , (-1.0) :+ 0.6666666666666666- , (-1.0) :+ 1.5- , (-1.0) :+ 4.0- , Infinity :+ 0.25- , Infinity :+ 0.6666666666666666- , Infinity :+ 1.5- , Infinity :+ 4.0- , 0.5 :+ (-0.3333333333333333)- , 0.5 :+ (-3.0)- , 2.0 :+ (-0.3333333333333333)- , 2.0 :+ (-3.0)- , (-Infinity) :+ (-0.3333333333333333)- , (-Infinity) :+ (-3.0)- , (-0.5) :+ 0.3333333333333333- , (-0.5) :+ 3.0- , (-2.0) :+ 0.3333333333333333- , (-2.0) :+ 3.0- , 0.3333333333333333 :+ (-0.5)- , 0.3333333333333333 :+ (-2.0)- , 3.0 :+ (-0.5)- , 3.0 :+ (-2.0)- , (-0.3333333333333333) :+ 0.5- , (-0.3333333333333333) :+ 2.0- , (-0.3333333333333333) :+ (-Infinity)- , (-3.0) :+ 0.5- , (-3.0) :+ 2.0- , (-3.0) :+ (-Infinity)- , 0.25 :+ (-1.0)- , 0.25 :+ Infinity- , 0.6666666666666666 :+ (-1.0)- , 0.6666666666666666 :+ Infinity- , 1.5 :+ (-1.0)- , 1.5 :+ Infinity- , 4.0 :+ (-1.0)- , 4.0 :+ Infinity- , (-0.25) :+ 1.0- , (-0.6666666666666666) :+ 1.0- , (-1.5) :+ 1.0- , (-4.0) :+ 1.0- , 0.2 :+ 0.0- , 5.0 :+ 0.0- ]- , [ 0.0 :+ (-0.2)- , 0.0 :+ (-5.0)- , 1.0 :+ 0.2- , 1.0 :+ 5.0- , (-1.0) :+ (-0.25)- , (-1.0) :+ (-0.6666666666666666)- , (-1.0) :+ (-1.5)- , (-1.0) :+ (-4.0)- , Infinity :+ (-0.25)- , Infinity :+ (-0.6666666666666666)- , Infinity :+ (-1.5)- , Infinity :+ (-4.0)- , 0.5 :+ 0.25- , 0.5 :+ 0.6666666666666666- , 0.5 :+ 1.5- , 0.5 :+ 4.0- , 2.0 :+ 0.25- , 2.0 :+ 0.6666666666666666- , 2.0 :+ 1.5- , 2.0 :+ 4.0- , (-Infinity) :+ 0.25- , (-Infinity) :+ 0.6666666666666666- , (-Infinity) :+ 1.5- , (-Infinity) :+ 4.0- , (-0.5) :+ (-0.3333333333333333)- , (-0.5) :+ (-3.0)- , (-2.0) :+ (-0.3333333333333333)- , (-2.0) :+ (-3.0)- , 0.3333333333333333 :+ 0.3333333333333333- , 0.3333333333333333 :+ 3.0- , 3.0 :+ 0.3333333333333333- , 3.0 :+ 3.0- , (-0.3333333333333333) :+ (-0.5)- , (-0.3333333333333333) :+ (-2.0)- , (-3.0) :+ (-0.5)- , (-3.0) :+ (-2.0)- , 0.25 :+ 0.5- , 0.25 :+ 2.0- , 0.25 :+ (-Infinity)- , 0.6666666666666666 :+ 0.5- , 0.6666666666666666 :+ 2.0- , 0.6666666666666666 :+ (-Infinity)- , 1.5 :+ 0.5- , 1.5 :+ 2.0- , 1.5 :+ (-Infinity)- , 4.0 :+ 0.5- , 4.0 :+ 2.0- , 4.0 :+ (-Infinity)- , (-0.25) :+ (-1.0)- , (-0.25) :+ Infinity- , (-0.6666666666666666) :+ (-1.0)- , (-0.6666666666666666) :+ Infinity- , (-1.5) :+ (-1.0)- , (-1.5) :+ Infinity- , (-4.0) :+ (-1.0)- , (-4.0) :+ Infinity- , 0.2 :+ 1.0- , 5.0 :+ 1.0- , (-0.2) :+ 0.0- , (-5.0) :+ 0.0 ] , ... ]
test/diff/tiers-Double.out view
@@ -1,4 +1,4 @@-map length (tiers :: [[ Double ]]) = [1,1,2,3,2,2,2,4,4,2,2,6,...]+map length (tiers :: [[ Double ]]) = [1,1,1,1,1,1,1,1,1,1,1,1,...] length (list :: [ Double ]) = Infinity @@ -9,44 +9,15 @@ tiers :: [Double] = [ [0.0] , [1.0]- , [ -1.0- , Infinity- ]- , [ 0.5- , 2.0- , -Infinity- ]- , [ -0.5- , -2.0- ]- , [ 0.3333333333333333- , 3.0- ]- , [ -0.3333333333333333- , -3.0- ]- , [ 0.25- , 0.6666666666666666- , 1.5- , 4.0- ]- , [ -0.25- , -0.6666666666666666- , -1.5- , -4.0- ]- , [ 0.2- , 5.0- ]- , [ -0.2- , -5.0- ]- , [ 0.16666666666666666- , 0.4- , 0.75- , 1.3333333333333333- , 2.5- , 6.0- ]+ , [-1.0]+ , [0.5]+ , [-0.5]+ , [2.0]+ , [Infinity]+ , [-Infinity]+ , [-2.0]+ , [0.3333333333333333]+ , [-0.3333333333333333]+ , [1.5] , ... ]
test/diff/tiers-Float.out view
@@ -1,4 +1,4 @@-map length (tiers :: [[ Float ]]) = [1,1,2,3,2,2,2,4,4,2,2,6,...]+map length (tiers :: [[ Float ]]) = [1,1,1,1,1,1,1,1,1,1,1,1,...] length (list :: [ Float ]) = Infinity @@ -9,44 +9,15 @@ tiers :: [Float] = [ [0.0] , [1.0]- , [ -1.0- , Infinity- ]- , [ 0.5- , 2.0- , -Infinity- ]- , [ -0.5- , -2.0- ]- , [ 0.33333334- , 3.0- ]- , [ -0.33333334- , -3.0- ]- , [ 0.25- , 0.6666667- , 1.5- , 4.0- ]- , [ -0.25- , -0.6666667- , -1.5- , -4.0- ]- , [ 0.2- , 5.0- ]- , [ -0.2- , -5.0- ]- , [ 0.16666667- , 0.4- , 0.75- , 1.3333334- , 2.5- , 6.0- ]+ , [-1.0]+ , [0.5]+ , [-0.5]+ , [2.0]+ , [Infinity]+ , [-Infinity]+ , [-2.0]+ , [0.33333334]+ , [-0.33333334]+ , [1.5] , ... ]
test/diff/tiers-Rational.out view
@@ -1,4 +1,4 @@-map length (tiers :: [[ Rational ]]) = [1,1,1,2,2,2,2,4,4,2,2,6,...]+map length (tiers :: [[ Rational ]]) = [1,1,1,1,1,1,1,1,1,1,1,1,...] length (list :: [ Rational ]) = Infinity @@ -10,40 +10,14 @@ [ [0 % 1] , [1 % 1] , [(-1) % 1]- , [ 1 % 2- , 2 % 1- ]- , [ (-1) % 2- , (-2) % 1- ]- , [ 1 % 3- , 3 % 1- ]- , [ (-1) % 3- , (-3) % 1- ]- , [ 1 % 4- , 2 % 3- , 3 % 2- , 4 % 1- ]- , [ (-1) % 4- , (-2) % 3- , (-3) % 2- , (-4) % 1- ]- , [ 1 % 5- , 5 % 1- ]- , [ (-1) % 5- , (-5) % 1- ]- , [ 1 % 6- , 2 % 5- , 3 % 4- , 4 % 3- , 5 % 2- , 6 % 1- ]+ , [1 % 2]+ , [(-1) % 2]+ , [2 % 1]+ , [(-2) % 1]+ , [1 % 3]+ , [(-1) % 3]+ , [3 % 2]+ , [(-3) % 2]+ , [2 % 3] , ... ]
test/error.hs view
@@ -107,25 +107,25 @@ ] prop_sortMinE :: [Nat] -> Bool-prop_sortMinE xs = head (sort xs) == minimum (xs::[Nat])+prop_sortMinE xs = head (sort xs) == minimum (xs::[Nat]) prop_sortMin :: [Nat] -> Bool-prop_sortMin xs = not (null xs)- ==> head (sort xs) == minimum (xs::[Nat])+prop_sortMin xs = not (null xs)+ ==> head (sort xs) == minimum (xs::[Nat]) someNumbers :: Int -> Bool-someNumbers 2 = True-someNumbers 3 = True-someNumbers 5 = True-someNumbers 7 = True-someNumbers 11 = True-someNumbers 13 = True-someNumbers 17 = True+someNumbers 2 = True+someNumbers 3 = True+someNumbers 5 = True+someNumbers 7 = True+someNumbers 11 = True+someNumbers 13 = True+someNumbers 17 = True someOthers :: Int -> Int -> Bool-someOthers = \x -> case x of 2 -> \y -> case y of 2 -> True- 4 -> True- 8 -> True- 3 -> \y -> case y of 3 -> True- 9 -> True- 27 -> True+someOthers = \x -> case x of 2 -> \y -> case y of 2 -> True+ 4 -> True+ 8 -> True+ 3 -> \y -> case y of 3 -> True+ 9 -> True+ 27 -> True
test/fun.hs view
@@ -37,7 +37,7 @@ prop_mapFilter f p xs = filter p (map f xs) == map f (filter p xs) prop_false :: (A -> A) -> (A -> A) -> Bool-prop_false _ _ = False+prop_false _ _ = False prop_false' :: (A -> A) -> (A,A) -> Bool-prop_false' _ _ = False+prop_false' _ _ = False
test/funshow.hs view
@@ -30,10 +30,11 @@ -- partially defined -- , showFunctionLine 2 (\x -> case x of True -> True) == "\\x -> case x of True -> True"- , showFunctionLine 10 (\x -> case (x::Int) of 3 -> (4::Int); 5 -> 6)- == "\\x -> case x of 3 -> 4; 5 -> 6"- , showFunctionLine 10 (\x y -> case (x::Int,y::Int) of (1,2) -> (3::Int); (2,1) -> 3)- == "\\x y -> case (x,y) of (1,2) -> 3; (2,1) -> 3"+ , showFunctionLine 10 ((\x -> case x of 3 -> 4; 5 -> 6) :: Int -> Int)+ == "\\x -> case x of 3 -> 4; 5 -> 6"+ , showFunctionLine 10+ ((\x y -> case (x,y) of (1,2) -> 3; (2,1) -> 3) :: Int->Int->Int)+ == "\\x y -> case (x,y) of (1,2) -> 3; (2,1) -> 3" -- fully defined, infinite -- , showFunction 3 ((+) -:> int)
test/generic.hs view
@@ -10,42 +10,42 @@ import Test.LeanCheck.Utils import GHC.Generics (Generic) -data D0 = D0 deriving (Eq, Show, Generic)-data D1 a = D1 a deriving (Eq, Show, Generic)-data D2 a b = D2 a b deriving (Eq, Show, Generic)-data D3 a b c = D3 a b c deriving (Eq, Show, Generic)-data C1 a = C11 a | C10 deriving (Eq, Show, Generic)-data C2 a b = C22 a b | C21 a | C20 deriving (Eq, Show, Generic)-data I a b = a :+ b deriving (Eq, Show, Generic)+data D0 = D0 deriving (Eq, Show, Generic)+data D1 a = D1 a deriving (Eq, Show, Generic)+data D2 a b = D2 a b deriving (Eq, Show, Generic)+data D3 a b c = D3 a b c deriving (Eq, Show, Generic)+data C1 a = C11 a | C10 deriving (Eq, Show, Generic)+data C2 a b = C22 a b | C21 a | C20 deriving (Eq, Show, Generic)+data I a b = a :+ b deriving (Eq, Show, Generic) -instance Listable D0 where tiers = genericTiers+instance Listable D0 where tiers = genericTiers -instance Listable a => Listable (D1 a) where tiers = genericTiers+instance Listable a => Listable (D1 a) where tiers = genericTiers instance (Listable a, Listable b)- => Listable (D2 a b) where tiers = genericTiers+ => Listable (D2 a b) where tiers = genericTiers instance (Listable a, Listable b, Listable c)- => Listable (D3 a b c) where tiers = genericTiers+ => Listable (D3 a b c) where tiers = genericTiers -instance Listable a => Listable (C1 a) where tiers = genericTiers+instance Listable a => Listable (C1 a) where tiers = genericTiers instance (Listable a, Listable b)- => Listable (C2 a b) where tiers = genericTiers+ => Listable (C2 a b) where tiers = genericTiers instance (Listable a, Listable b)- => Listable (I a b) where tiers = genericTiers+ => Listable (I a b) where tiers = genericTiers -- recursive datatypes-data Peano = Zero | Succ Peano deriving (Show, Generic)-data List a = a :- List a | Nil deriving (Show, Generic)-data Bush a = Bush a :-: Bush a | Leaf a deriving (Show, Eq, Generic)-data Tree a = Node (Tree a) a (Tree a) | Null deriving (Show, Eq, Generic)+data Peano = Zero | Succ Peano deriving (Show, Generic)+data List a = a :- List a | Nil deriving (Show, Generic)+data Bush a = Bush a :-: Bush a | Leaf a deriving (Show, Eq, Generic)+data Tree a = Node (Tree a) a (Tree a) | Null deriving (Show, Eq, Generic) -instance Listable Peano where tiers = genericTiers-instance Listable a => Listable (List a) where tiers = genericTiers-instance Listable a => Listable (Bush a) where tiers = genericTiers-instance Listable a => Listable (Tree a) where tiers = genericTiers+instance Listable Peano where tiers = genericTiers+instance Listable a => Listable (List a) where tiers = genericTiers+instance Listable a => Listable (Bush a) where tiers = genericTiers+instance Listable a => Listable (Tree a) where tiers = genericTiers main :: IO ()@@ -57,7 +57,7 @@ exitFailure tests :: Int -> [Bool]-tests n =+tests n = [ True , map unD0 list =| n |= list@@ -121,15 +121,15 @@ , (genericTiers :: [[ Either Bool Int ]]) =| 6 |= $(deriveTiers ''Either) ] where- unD0 (D0) = ()- unD1 (D1 x) = (x)- unD2 (D2 x y) = (x,y)- unD3 (D3 x y z) = (x,y,z)+ unD0 (D0) = ()+ unD1 (D1 x) = (x)+ unD2 (D2 x y) = (x,y)+ unD3 (D3 x y z) = (x,y,z) peanoToNat :: Peano -> Nat-peanoToNat Zero = 0-peanoToNat (Succ n) = 1 + peanoToNat n+peanoToNat Zero = 0+peanoToNat (Succ n) = 1 + peanoToNat n listToList :: List a -> [a]-listToList Nil = []-listToList (x :- xs) = x : listToList xs+listToList Nil = []+listToList (x :- xs) = x : listToList xs
test/main.hs view
@@ -52,22 +52,21 @@ , counterExample n (\x y -> x + y == (x::Double)) == Just ["0.0","1.0"] , holds n (\x -> x + 1 /= (x::Int)) , counterExample n (\x -> x + 1 /= (x::Float)) == Just ["Infinity"]- || counterExample n (\x -> x + 1 /= (x::Float)) == Just ["inf"] -- bug on Hugs 2006-09?+ || counterExample n (\x -> x + 1 /= (x::Float)) == Just ["inf"] -- bug on Hugs , counterExample n (\x -> x + 1 /= (x::Double)) == Just ["Infinity"]- || counterExample n (\x -> x + 1 /= (x::Float)) == Just ["inf"] -- bug on Hugs 2006-09?+ || counterExample n (\x -> x + 1 /= (x::Float)) == Just ["inf"] -- bug on Hugs , allUnique (take n list :: [Float]) , allUnique (take n list :: [Double]) , allUnique (take n list :: [Rational]) , allUnique (take n list :: [Ratio Nat])- , orderedOn (\r -> numerator r + denominator r) (take n (list :: [Ratio Nat]))- , orderedOn (\r -> abs (numerator r) + abs(denominator r)) (take n (list :: [Rational])) , list == [LT, EQ, GT] , orderedOn length (take n (list :: [[Ordering]])) , orderedOn length (take n (list :: [[Bool]])) - , strictlyOrderedOn (\xs -> (sum $ map (+1) xs, xs)) (take n (list :: [[Word]]))+ , strictlyOrderedOn (\xs -> (sum $ map (+1) xs, xs))+ (take n (list :: [[Word]])) , tPairEqParams n , tTripleEqParams n@@ -97,10 +96,10 @@ ] allUnique :: Ord a => [a] -> Bool-allUnique [] = True-allUnique (x:xs) = x `notElem` xs- && allUnique (filter (< x) xs)- && allUnique (filter (> x) xs)+allUnique [] = True+allUnique (x:xs) = x `notElem` xs+ && allUnique (filter (< x) xs)+ && allUnique (filter (> x) xs) -- | 'zipwith\'' works similarly to 'zipWith', but takes neutral elements to@@ -112,7 +111,7 @@ -- -- > zipWith' (+) 0 0 [1,2,3] [1,2,3,4,5,6] == [2,4,6,4,5,6] zipWith' :: (a->b->c) -> a -> b -> [a] -> [b] -> [c]-zipWith' _ _ _ [] [] = []-zipWith' f _ zy xs [] = map (`f` zy) xs-zipWith' f zx _ [] ys = map (f zx) ys-zipWith' f zx zy (x:xs) (y:ys) = f x y : zipWith' f zx zy xs ys+zipWith' _ _ _ [] [] = []+zipWith' f _ zy xs [] = map (`f` zy) xs+zipWith' f zx _ [] ys = map (f zx) ys+zipWith' f zx zy (x:xs) (y:ys) = f x y : zipWith' f zx zy xs ys
test/operators.hs view
@@ -144,7 +144,7 @@ , fails n $ isNeverIdentity negate -:> int ] where- m = 200+ m = 200 --none :: (a -> Bool) -> [a] -> Bool---none p = not . or . map p+--none p = not . or . map p
test/stats.hs view
@@ -10,7 +10,7 @@ import Data.Function (on) main :: IO ()-main = do+main = do putStrLn "sum :: [Int] -> Bool" classStats 100 (sum :: [Int] -> Int) @@ -51,10 +51,11 @@ tests n = [ True - , classify [1,2,3,4,1,2,3,1,2,1] == [[1,1,1,1],[2,2,2],[3,3],[4]]- , classifyBy ((==) `on` odd) [1,2,3,4,1,2,3,1,2,1] == [[1,3,1,3,1,1],[2,4,2,2]]- , classifyOn odd [1,2,3,4,1,2,3,1,2,1] == [[1,3,1,3,1,1],[2,4,2,2]]- , counts [1,2,3,4,1,2,3,1,2,1] == [(1,4),(2,3),(3,2),(4,1)]+ , classify [1,2,3,4,1,2,3,1,2,1] == [[1,1,1,1],[2,2,2],[3,3],[4]]+ , classifyBy ((==) `on` odd) [1,2,3,4,1,2,3,1,2,1]+ == [[1,3,1,3,1,1],[2,4,2,2]]+ , classifyOn odd [1,2,3,4,1,2,3,1,2,1] == [[1,3,1,3,1,1],[2,4,2,2]]+ , counts [1,2,3,4,1,2,3,1,2,1] == [(1,4),(2,3),(3,2),(4,1)] , countsBy ((==) `on` odd) [1,2,3,4,1,2,3,1,2,1] == [(1,6),(2,4)]- , countsOn odd [1,2,3,4,1,2,3,1,2,1::Int] == [(True,6),(False,4)]+ , countsOn odd [1,2,3,4,1,2,3,1,2,1::Int] == [(True,6),(False,4)] ]
test/tiers.hs view
@@ -33,7 +33,8 @@ , all (uncurry (/=)) . concat . take 200 $ distinctPairs (tiers :: [[Nat]]) - , productMaybeWith ($) [[const Nothing, Just]] [[1],[2],[3],[4]] == [[1],[2],[3],[4]]+ , productMaybeWith ($) [[const Nothing, Just]] [[1],[2],[3],[4]]+ == [[1],[2],[3],[4]] , productMaybeWith (flip ($)) [[1],[2],[3],[4]] [[const Nothing],[Just]] == [[],[1],[2],[3],[4]]@@ -74,42 +75,46 @@ ] deleteT_is_map_delete :: (Eq a, Listable a) => Int -> a -> Bool-deleteT_is_map_delete n x = deleteT x tiers- =| n |= normalizeT (map (delete x) tiers)+deleteT_is_map_delete n x =+ deleteT x tiers =| n |= normalizeT (map (delete x) tiers) checkNoDup :: Int -> Bool-checkNoDup n = noDupListsOf (tiers :: [[Int]]) =| n |= tiers `suchThat` noDup- where noDup xs = nub (sort xs) == sort xs+checkNoDup n =+ noDupListsOf (tiers :: [[Int]]) =| n |= tiers `suchThat` noDup+ where+ noDup xs = nub (sort xs) == sort xs checkBags :: Int -> Bool-checkBags n = bagsOf (tiers :: [[Nat]]) =| n |= tiers `suchThat` ordered+checkBags n =+ bagsOf (tiers :: [[Nat]]) =| n |= tiers `suchThat` ordered checkSets :: Int -> Bool-checkSets n = setsOf (tiers :: [[Nat]]) =| n |= tiers `suchThat` strictlyOrdered+checkSets n =+ setsOf (tiers :: [[Nat]]) =| n |= tiers `suchThat` strictlyOrdered checkDistinctPairs :: Int -> Bool-checkDistinctPairs n =+checkDistinctPairs n = distinctPairs (tiers :: [[Nat]]) =| n |= tiers `suchThat` uncurry (/=) checkUnorderedDistinctPairs :: Int -> Bool-checkUnorderedDistinctPairs n =+checkUnorderedDistinctPairs n = unorderedDistinctPairs (tiers :: [[Nat]]) =| n |= tiers `suchThat` uncurry (<) checkUnorderedPairs :: Int -> Bool-checkUnorderedPairs n =+checkUnorderedPairs n = unorderedPairs (tiers :: [[Nat]]) =| n |= tiers `suchThat` uncurry (<=) checkLengthListingsOfLength :: Int -> Int -> Bool-checkLengthListingsOfLength n m = all check [1..m]- where check m = all (\xs -> length xs == m)- $ concat . take n- $ listsOfLength m natTiers+checkLengthListingsOfLength n m = all check [1..m]+ where check m = all (\xs -> length xs == m)+ $ concat . take n+ $ listsOfLength m natTiers checkSizesListingsOfLength :: Int -> Int -> Bool-checkSizesListingsOfLength n m = all check [1..m]- where check m = orderedBy compare- $ map sum . concat . take n- $ listsOfLength m natTiers+checkSizesListingsOfLength n m = all check [1..m]+ where check m = orderedBy compare+ $ map sum . concat . take n+ $ listsOfLength m natTiers natTiers :: [[Nat]]-natTiers = tiers+natTiers = tiers
test/types.hs view
@@ -24,8 +24,8 @@ -- | Given the number of bits, generates a range for signed/unsigned integers -- of that width. signedRange,unsignedRange :: (Num n) => Int -> [n]-signedRange n = map fromIntegral [-(2^(n-1))..(2^(n-1))-1]-unsignedRange n = map fromIntegral [0..(2^n)-1]+signedRange n = map fromIntegral [-(2^(n-1))..(2^(n-1))-1]+unsignedRange n = map fromIntegral [0..(2^n)-1] tests :: Int -> [Bool] tests n =@@ -154,7 +154,7 @@ , allTypeable || True ] where- unXs (Xs xs) = xs+ unXs (Xs xs) = xs prefiX :: (Bounded a, Integral a) => [a]@@ -202,10 +202,10 @@ ] permutation :: Eq a => [a] -> [a] -> Bool-[] `permutation` [] = True-(_:_) `permutation` [] = False-[] `permutation` (_:_) = False-(x:xs) `permutation` ys = x `elem` ys && xs `permutation` delete x ys+[] `permutation` [] = True+(_:_) `permutation` [] = False+[] `permutation` (_:_) = False+(x:xs) `permutation` ys = x `elem` ys && xs `permutation` delete x ys allTypeable :: Bool