prim-spoon (empty) → 0.1.0
raw patch · 9 files changed
+333/−0 lines, 9 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, criterion, ghc-prim, prim-spoon, spoon
Files
- LICENSE +66/−0
- README.md +20/−0
- Setup.hs +6/−0
- bench/Bench/Control/Spoon/Prim.hs +100/−0
- bench/Main.hs +8/−0
- prim-spoon.cabal +64/−0
- src/Control/Spoon/Prim.hs +33/−0
- test/Spec.hs +12/−0
- test/Test/Control/Spoon/Prim.hs +24/−0
+ LICENSE view
@@ -0,0 +1,66 @@+Copyright for portions of project prim-spoon are held by (c) 2009 Matt Morrow & Dan Peebles as part of project spoon. All other copyright for project are held by (c) 2016 Michael Klein.++Copyright (c) 2015 Michael Klein +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 Matt Morrow or Dan Peebles 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.+++Copyright (c) 2009 Matt Morrow & Dan Peebles+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 Matt Morrow or Dan Peebles 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.
+ README.md view
@@ -0,0 +1,20 @@+#Prim-Spoon++[](https://travis-ci.org/michaeljklein/prim-spoon)++This is a microproject for the sole purpose of having a high-performance +version of `teaspoon` from [Control.Spoon](http://hackage.haskell.org/package/spoon-0.3.1), using primops.+While it is unsafe, it is as safe as `catch#` and `seq#` from [GHC.Prim](https://hackage.haskell.org/package/ghc-prim-0.4.0.0/candidate/docs/GHC-Prim.html).+(I'd look into how safe those are, but they're hidden in GHC's source and that _really_ seems like overkill.)++Current [benchmarks](https://rawgit.com/michaeljklein/prim-spoon/master/benchmarks.html)+suggest that `primspoon` takes about 3x as long as a function call on non-error +throwing values and about 5x as long to catch an error and return `Nothing`. +This is an improvment over `teaspoon`, which takes about 4x as long as a+function call on a non-error value and about 21x to catch an error.++Why bother? Three reasons: ++1. This is my first experience with digging into primops in Haskell for performance, and it was a good exercise.+2. I had begun to roll my own solution before I found `Control.Spoon` and wanted to benchmark several different solutions (for example, `makeStableName`).+3. I was curious how `unsafePerformIO` affects performance. It turns out that it takes longer than I expected, but it makes some sense as it's not the best thing to spend time optimizing.
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ bench/Bench/Control/Spoon/Prim.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE Unsafe #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -funbox-strict-fields #-}++module Bench.Control.Spoon.Prim (benchControlSpoonPrim) where+++import Criterion.Main+import Control.Spoon (teaspoon)+import GHC.Prim (RealWorld, State#, catch#, realWorld#, seq#)+import Control.Spoon.Prim+import System.IO.Unsafe (unsafeDupablePerformIO)+import System.Mem.StableName++-- | Control mehod for benchmarking (appx. lower bound for a functional solution)+justToJust :: Maybe a -> Maybe (Maybe a)+justToJust y@(Just _) = Just y+justToJust Nothing = Nothing++-- | Control method for benchmarking (appx. lower bound for output of a function)+catchMethod0 :: a -> Bool+catchMethod0 = const False++unpackMaybe :: (# State# RealWorld, Maybe a #) -> Maybe a+unpackMaybe (# _, x #) = x++-- | This, and the following methods, are used for comparison to ensure the+-- prim-spoon methods are high-performance+catchMethod1 :: a -> Maybe a+{-# INLINE catchMethod1 #-}+catchMethod1 x = let r = realWorld# in let (# _, v #) = catch# (\s -> let (# t, y #) = (seq# x) s in (# t, Just y #)) (\_ _ -> (# r, Nothing #)) r in v++catchMethod2 :: a -> Maybe a+{-# INLINE catchMethod2 #-}+catchMethod2 x = unpackMaybe (catch# ((\f s -> (\(# t, y #) -> (# t, Just y #)) (f s)) (seq# x)) (\_ _ -> (# realWorld#, Nothing #)) realWorld#)++catchMethod3 :: a -> Maybe a+{-# INLINE catchMethod3 #-}+catchMethod3 x = (\(# _, v #) -> v) (catch# ((\f s -> (\(# t, y #) -> (# t, Just y #)) (f s)) (seq# x)) (\_ _ -> (# realWorld#, Nothing #)) realWorld#)++catchMethod4 :: a -> Maybe a+{-# INLINE catchMethod4 #-}+catchMethod4 x = let r = realWorld# in (\(# _, v #) -> v) (catch# ((\f s -> (\(# t, y #) -> (# t, Just y #)) (f s)) (seq# x)) (\_ _ -> (# r, Nothing #)) r)++catchMethod5 :: a -> Maybe a+{-# INLINE catchMethod5 #-}+catchMethod5 x = (\(# _, v #) -> v) (catch# ((\f s -> (\(# t, y #) -> (# t, Just y #)) (f s)) (seq# x)) (\_ _ -> (# realWorld#, Nothing #)) realWorld#)++-- | This method *only* supports `Prelude.undefined` as the thrown error+-- (`unsafeDupablePerformIO` doesn't work with parallelism, but neither+-- does `makeStableName`+catchMethod6 :: a -> Maybe a+{-# INLINE catchMethod6 #-}+catchMethod6 x = if eqStableName undefName . unsafeDupablePerformIO . makeStableName $ x+ then Nothing+ else Just x+ where+ undefName :: forall t. StableName t+ undefName = unsafeDupablePerformIO . makeStableName $ undefined++-- | Benchmark the different options, with controls for comparison+benchControlSpoonPrim :: [Benchmark]+benchControlSpoonPrim = [+ bgroup "teaspoon " [ bench "Check undefined" $ whnf teaspoon undefined+ , bench "Check defined" $ whnf teaspoon False+ ],+ bgroup "const (control) " [ bench "Check undefined" $ whnf catchMethod0 undefined+ , bench "Check defined" $ whnf catchMethod0 False+ ],+ bgroup "Just (control) " [+ bench "Check defined" $ whnf Just False+ ],+ bgroup "justToJust (control)" [ bench "check Nothing " $ whnf justToJust Nothing+ , bench "Check Just " $ whnf Just False+ ],+ bgroup "catchMethod1 " [ bench "Check undefined" $ whnf catchMethod1 undefined+ , bench "Check defined" $ whnf catchMethod1 False+ ],+ bgroup "catchMethod2 " [ bench "Check undefined" $ whnf catchMethod2 undefined+ , bench "Check defined" $ whnf catchMethod2 False+ ],+ bgroup "catchMethod3 " [ bench "Check undefined" $ whnf catchMethod3 undefined+ , bench "Check defined" $ whnf catchMethod3 False+ ],+ bgroup "catchMethod4 " [ bench "Check undefined" $ whnf catchMethod4 undefined+ , bench "Check defined" $ whnf catchMethod4 False+ ],+ bgroup "catchMethod5 " [ bench "Check undefined" $ whnf catchMethod5 undefined+ , bench "Check defined" $ whnf catchMethod5 False+ ],+ bgroup "catchMethod6 " [ bench "Check undefined" $ whnf catchMethod6 undefined+ , bench "Check defined" $ whnf catchMethod6 False+ ],+ bgroup "primspoon " [ bench "Check undefined" $ whnf primspoon undefined+ , bench "Check defined" $ whnf primspoon False+ ]]+
+ bench/Main.hs view
@@ -0,0 +1,8 @@+module Main where++import Bench.Control.Spoon.Prim (benchControlSpoonPrim)+import Criterion.Main (defaultMain )++main :: IO ()+main = defaultMain . concat $ [ benchControlSpoonPrim+ ]
+ prim-spoon.cabal view
@@ -0,0 +1,64 @@+name: prim-spoon+version: 0.1.0+license: BSD3+license-file: LICENSE+author: Michael Klein+maintainer: Michael Klein <lambdamichael@gmail.com>+homepage: https://github.com/michaeljklein/prim-spoon+stability: experimental+category: Error handling+synopsis: Catch errors thrown from pure computations using primops.+copyright: 2016 Michael Klein, portions also licensed to: 2009 Matt Morrow & Dan Peebles, 2013 Liyang HU+description: Takes an error-throwing expression and puts it back in the Maybe it belongs in, but with primops.+build-type: Simple+cabal-version: >= 1.10+extra-source-files: README.md++library+ hs-source-dirs: src+ build-depends: base >= 4.7 && < 5+ , ghc-prim >= 0.3.1.0+ , spoon >= 0.3+ exposed-modules: Control.Spoon.Prim+ ghc-options: -Wall -funbox-strict-fields+ default-language: Haskell2010+ default-extensions: MagicHash+ , RankNTypes+ , ScopedTypeVariables+ , UnboxedTuples+ , Unsafe++benchmark prim-spoon-bench+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ main-is: Main.hs+ build-depends: base+ , criterion >= 1.1.0.0 && < 1.2.0.0+ , ghc-prim >= 0.3.1.0+ , prim-spoon+ , spoon >= 0.3.1+ other-modules: Bench.Control.Spoon.Prim+ ghc-options: -Wall -funbox-strict-fields+ default-language: Haskell2010+ default-extensions: MagicHash+ , RankNTypes+ , ScopedTypeVariables+ , UnboxedTuples+ , Unsafe++test-suite prim-spoon-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , HUnit >= 1.2.5.2+ , spoon >= 0.3.1+ , prim-spoon+ , QuickCheck >= 2.7.6+ other-modules: Test.Control.Spoon.Prim+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/michaeljklein/prim-spoon.git
+ src/Control/Spoon/Prim.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE Unsafe #-}++{-|+Module : Control.Spoon.Prim+Description : This is the main module for prim-spoon+Copyright : (c) Michael Klein, 2016+License : GPL-3+Maintainer : lambdamichael@gmail.com+Stability : experimental++ This module exports `primspoon`. If you want the other+ spoon functions, you'll need "Control.Spoon".+-}++module Control.Spoon.Prim (primspoon) where++import GHC.Prim (RealWorld, State#, catch#, realWorld#, seq#)+import Prelude (Maybe(..))++-- | This function takes an exception and a `State#` `RealWorld`, returning the output of `realWorld#` and `Nothing`+exceptionToNothing :: a -> State# RealWorld -> (forall b. (# State# RealWorld, Maybe b #))+{-# INLINE exceptionToNothing #-}+exceptionToNothing _ _ = (# realWorld#, Nothing #)++-- | Evaluate a value to weak-head normal form and return Nothing if any exceptions are thrown during evaluation. For any error-free value, @primspoon = Just@.+primspoon :: a -> Maybe a+{-# INLINE primspoon #-}+primspoon x = (\(# _, v #) -> v) (catch# ((\f s -> (\(# t, y #) -> (# t, Just y #)) (f s)) (seq# x)) exceptionToNothing realWorld#)
+ test/Spec.hs view
@@ -0,0 +1,12 @@+module Main where++import Test.Control.Spoon.Prim (testControlSpoonPrim)+import Test.HUnit++doTests :: [[Test]] -> IO ()+doTests ts = print =<< (runTestTT. test . concat) ts++main :: IO ()+main = doTests [ testControlSpoonPrim+ ]+
+ test/Test/Control/Spoon/Prim.hs view
@@ -0,0 +1,24 @@+module Test.Control.Spoon.Prim where++import Control.Spoon (teaspoon )+import Control.Spoon.Prim (primspoon )+import Test.HUnit+import Test.QuickCheck (quickCheck)++testIsJust :: (Int -> Maybe Int) -> Test+testIsJust f = test $ quickCheck (\x -> Just x == f x)++testTeaspoon :: Test+testTeaspoon = test [ "Test teaspoon for undefined" ~: Nothing ~=? teaspoon (undefined :: Int),+ "Test teaspoon for defined " ~: testIsJust teaspoon+ ]++testPrimspoon :: Test+testPrimspoon = test [ "Test primspoon for undefined" ~: Nothing ~=? primspoon (undefined :: Int),+ "Test primspoon for defined " ~: testIsJust primspoon+ ]++testControlSpoonPrim :: [Test]+testControlSpoonPrim = [ testTeaspoon+ , testPrimspoon+ ]