Initial check-in (from the TFP lunch)
authorJoachim Breitner <mail@joachim-breitner.de>
Mon, 26 May 2014 12:07:26 +0000 (14:07 +0200)
committerJoachim Breitner <mail@joachim-breitner.de>
Mon, 26 May 2014 12:07:26 +0000 (14:07 +0200)
.travis.yml [new file with mode: 0644]
Data/List/Fusion/Probe.hs [new file with mode: 0644]
LICENSE [new file with mode: 0644]
Setup.hs [new file with mode: 0644]
list-fusion-probe.cabal [new file with mode: 0644]
tests/Test.hs [new file with mode: 0644]

diff --git a/.travis.yml b/.travis.yml
new file mode 100644 (file)
index 0000000..c2c69d3
--- /dev/null
@@ -0,0 +1,49 @@
+# NB: don't set `language: haskell` here
+
+# See https://github.com/hvr/multi-ghc-travis
+
+# The following enables several GHC versions to be tested; often it's enough to test only against the last release in a major GHC version. Feel free to omit lines listings versions you don't need/want testing for.
+env:
+ - GHCVER=6.12.3
+# - GHCVER=7.0.1
+# - GHCVER=7.0.2
+# - GHCVER=7.0.3
+ - GHCVER=7.0.4
+# - GHCVER=7.2.1
+ - GHCVER=7.2.2
+# - GHCVER=7.4.1
+ - GHCVER=7.4.2
+# - GHCVER=7.6.1
+# - GHCVER=7.6.2
+ - GHCVER=7.6.3
+ - GHCVER=7.8.2
+ - GHCVER=head  # see section about GHC HEAD snapshots
+
+# Note: the distinction between `before_install` and `install` is not important.
+before_install:
+ - sudo add-apt-repository -y ppa:hvr/ghc
+ - sudo apt-get update
+ - sudo apt-get install cabal-install-1.18 ghc-$GHCVER
+ - export PATH=/opt/ghc/$GHCVER/bin:$PATH
+
+install:
+ - cabal-1.18 update
+ - cabal-1.18 install --only-dependencies --enable-tests --enable-benchmarks
+
+# Here starts the actual work to be performed for the package under test; any command which exits with a non-zero exit code causes the build to fail.
+script:
+ - cabal-1.18 configure --enable-tests --enable-benchmarks -v2  # -v2 provides useful information for debugging
+ - cabal-1.18 build   # this builds all libraries and executables (including tests/benchmarks)
+ - cabal-1.18 test
+ - cabal-1.18 check
+ - cabal-1.18 sdist   # tests that a source-distribution can be generated
+
+# The following scriptlet checks that the resulting source distribution can be built & installed
+ - export SRC_TGZ=$(cabal-1.18 info . | awk '{print $2 ".tar.gz";exit}') ;
+   cd dist/;
+   if [ -f "$SRC_TGZ" ]; then
+      cabal-1.18 install "$SRC_TGZ";
+   else
+      echo "expected '$SRC_TGZ' not found";
+      exit 1;
+   fi
diff --git a/Data/List/Fusion/Probe.hs b/Data/List/Fusion/Probe.hs
new file mode 100644 (file)
index 0000000..30f345e
--- /dev/null
@@ -0,0 +1,46 @@
+{- |
+   Copyright  : Copyright (C) 2014 Joachim Breitner
+   License    : BSD3
+
+   Maintainer : Joachim Breitner <mail@joachim-breitner.de>
+   Stability  : stable
+   Portability: GHCspecific
+-}
+
+module Data.List.Fusion.Probe where
+
+
+import GHC.Exts (build, augment)
+
+-- | This function can be wrapped around a list that should be compiled away by
+-- list fusion. If it does, this function will disappear. If not, it will throw
+-- an error at runtime.
+--
+-- > main = print $ foldl (+) 0 (fuseThis [0..1000])
+--
+-- Will print @Test: fuseList: List did not fuse@, while
+--
+-- > main = print $ foldl (+) 0 (fuseThis [0..1000])
+--
+-- will print @500500@.
+
+fuseThis :: [a] -> [a]
+fuseThis = id
+
+{-# NOINLINE fuseThis #-}
+
+{-# RULES
+"fold/fuseThis/build" [~0]
+    forall k z (g::forall b. (a->b->b) -> b -> b) .
+    foldr k z (fuseThis (build g)) = g k z
+
+"foldr/fuseThis/augment" [~0]
+    forall k z xs (g::forall b. (a->b->b) -> b -> b) .
+    foldr k z (fuseThis (augment g xs)) = g k (foldr k z xs)
+ #-}
+
+{-# RULES
+"fuseThis/fail" [0]
+    fuseThis = error "fuseThis: List did not fuse"
+ #-}
+
diff --git a/LICENSE b/LICENSE
new file mode 100644 (file)
index 0000000..e164159
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2014, Joachim Breitner
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Joachim Breitner nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644 (file)
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/list-fusion-probe.cabal b/list-fusion-probe.cabal
new file mode 100644 (file)
index 0000000..6a0b7e2
--- /dev/null
@@ -0,0 +1,32 @@
+name:                list-fusion-probe
+version:             0.1
+synopsis:            testing list fusion for success
+description:         This package provides a function @fuseThis@ that can be
+                     wrapped around a flist. If that list is fused away, all is
+                     well. If not, a runtime error will occur.
+license:             BSD3
+license-file:        LICENSE
+author:              Joachim Breitner
+maintainer:          mail@joachim-breitner.de
+copyright:           2014 Joachim Breitner
+category:            Data
+build-type:          Simple
+cabal-version:       >=1.8
+tested-with:         GHC ==7.6
+
+library
+  exposed-modules:     Data.List.Fusion.Probe
+  build-depends:       base ==4.6.*
+
+test-suite test
+  Type:
+    exitcode-stdio-1.0
+  Hs-source-dirs:
+    tests
+  Main-is:
+    Test.hs
+  Build-depends:
+      base == 4.6.*
+    , tasty == 0.7.*
+    , tasty-hunit == 0.4.*
+    , list-fusion-probe
diff --git a/tests/Test.hs b/tests/Test.hs
new file mode 100644 (file)
index 0000000..45eff8a
--- /dev/null
@@ -0,0 +1,33 @@
+import Data.List.Fusion.Probe
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+
+import Control.Exception
+import Control.Monad
+
+assertErrorCall :: String -> IO a -> IO ()
+assertErrorCall ex action =
+    handleJust isWanted (const $ return ()) $ do
+        action
+        assertFailure $ "Expected exception: " ++ show ex
+  where isWanted (ErrorCall x) = guard $ x == ex
+
+
+x1, x2 :: Integer
+x1 = foldl (+) 0 (fuseThis [0..1001])
+x2 = foldr (+) 0 (fuseThis [0..1000])
+
+main = defaultMain unitTests
+
+unitTests = testGroup "Unit tests"
+  [ testCase "foldr fuses" $
+      x2 `compare` 500500 @?= EQ
+
+  , testCase "foldl does not fuse" $
+      assertErrorCall "fuseThis: List did not fuse" (evaluate x1)
+  ]
+
+
+