diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Andrew Martin (c) 2018 + +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 Andrew Martin 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/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,1 @@ +# unpacked-maybe-numeric diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Data/Maybe/Unpacked/Numeric/Complex/Double.hs b/src/Data/Maybe/Unpacked/Numeric/Complex/Double.hs new file mode 100644 --- /dev/null +++ b/src/Data/Maybe/Unpacked/Numeric/Complex/Double.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} + +module Data.Maybe.Unpacked.Numeric.Complex.Double + ( Complex(..) + , toBaseComplex + , fromBaseComplex + + , Maybe(..) + , just + , nothing + + , maybe + + , isJust + , isNothing + , fromMaybe + , listToMaybe + , maybeToList + , catMaybes + , mapMaybe + + , toBaseMaybe + , fromBaseMaybe + ) where + +import Prelude hiding (Maybe,maybe) + +import qualified Data.Complex as C +import GHC.Base (build) +import GHC.Exts (Double#,Double(D#),(==##)) + +import GHC.Read (Read(readPrec), expectP) +import Text.Read (parens, Lexeme(Ident), lexP, (+++)) +import Text.ParserCombinators.ReadPrec (prec, step) +import qualified Prelude as P + +data Complex = Complex Double# Double# + +toBaseComplex :: Complex -> C.Complex Double +toBaseComplex (Complex d1# d2#) = (D# d1#) C.:+ (D# d2#) + +fromBaseComplex :: C.Complex Double -> Complex +fromBaseComplex ( (D# d1#) C.:+ (D# d2#) ) = Complex d1# d2# + +instance Eq Complex where + Complex a b == Complex c d = + case a ==## c of + 1# -> case b ==## d of + 1# -> True + _ -> False + _ -> False + +instance Show Complex where + showsPrec p (Complex a b) + = showParen (p >= 11) + $ showString "Complex " + . showsPrec 11 (D# a) + . showString " " + . showsPrec 11 (D# b) + +instance Read Complex where + readPrec = parens $ prec 10 $ do + expectP (Ident "Complex") + (D# a) <- step readPrec + (D# b) <- step readPrec + return (Complex a b) + +data Maybe = Maybe (# (# #) | Complex #) + +instance Eq Maybe where + ma == mb = + maybe (isNothing mb) + (\a -> maybe False (\b -> a == b) mb) ma + +instance Show Maybe where + showsPrec p (Maybe m) = case m of + (# (# #) | #) -> showString "nothing" + (# | c #) -> showParen (p > 10) + $ showString "just " + . showsPrec 11 c + +instance Read Maybe where + readPrec = parens $ nothingP +++ justP + where + nothingP = prec 10 $ do + Ident "nothing" <- lexP + return nothing + justP = prec 10 $ do + Ident "just" <- lexP + a <- step readPrec + return (just a) + +listToMaybe :: [Complex] -> Maybe +listToMaybe [] = nothing +listToMaybe (x:_) = just x + +maybeToList :: Maybe -> [Complex] +maybeToList = maybe [] (: []) + +catMaybes :: [Maybe] -> [Complex] +catMaybes = mapMaybe id + +mapMaybe :: (a -> Maybe) -> [a] -> [Complex] +mapMaybe _ [] = [] +mapMaybe f (a : as) = + let ws = mapMaybe f as + in maybe ws (: ws) (f a) +{-# NOINLINE [1] mapMaybe #-} + +{-# RULES +"mapMaybe" [~1] forall f xs. mapMaybe f xs + = build (\c n -> foldr (mapMaybeFB c f) n xs) +"mapMaybeList" [1] forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f + #-} + +{-# NOINLINE [0] mapMaybeFB #-} +mapMaybeFB :: (Complex -> r -> r) -> (a -> Maybe) -> a -> r -> r +mapMaybeFB cons f x next = maybe next (flip cons next) (f x) + +isNothing :: Maybe -> Bool +isNothing = maybe True (const False) + +isJust :: Maybe -> Bool +isJust = maybe False (const True) + +nothing :: Maybe +nothing = Maybe (# (# #) | #) + +just :: Complex -> Maybe +just c = Maybe (# | c #) + +fromMaybe :: Complex -> Maybe -> Complex +fromMaybe a (Maybe m) = case m of + (# (# #) | #) -> a + (# | c #) -> c + +maybe :: a -> (Complex -> a) -> Maybe -> a +maybe a f (Maybe m) = case m of + (# (# #) | #) -> a + (# | c #) -> f c + +toBaseMaybe :: Maybe -> P.Maybe Complex +toBaseMaybe = maybe P.Nothing P.Just + +fromBaseMaybe :: P.Maybe Complex -> Maybe +fromBaseMaybe = P.maybe nothing just + diff --git a/src/Data/Maybe/Unpacked/Numeric/Complex/Float.hs b/src/Data/Maybe/Unpacked/Numeric/Complex/Float.hs new file mode 100644 --- /dev/null +++ b/src/Data/Maybe/Unpacked/Numeric/Complex/Float.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} + +module Data.Maybe.Unpacked.Numeric.Complex.Float + ( Complex(..) + , toBaseComplex + , fromBaseComplex + + , Maybe(..) + , just + , nothing + + , maybe + + , isJust + , isNothing + , fromMaybe + , listToMaybe + , maybeToList + , catMaybes + , mapMaybe + + , toBaseMaybe + , fromBaseMaybe + ) where + +import Prelude hiding (Maybe,maybe) + +import qualified Data.Complex as C +import GHC.Base (build) +import GHC.Exts (Float#,Float(F#),eqFloat#) + +import GHC.Read (Read(readPrec), expectP) +import Text.Read (parens, Lexeme(Ident), lexP, (+++)) +import Text.ParserCombinators.ReadPrec (prec, step) +import qualified Prelude as P + +data Complex = Complex Float# Float# + +toBaseComplex :: Complex -> C.Complex Float +toBaseComplex (Complex d1# d2#) = (F# d1#) C.:+ (F# d2#) + +fromBaseComplex :: C.Complex Float -> Complex +fromBaseComplex ( (F# d1#) C.:+ (F# d2#) ) = Complex d1# d2# + +instance Eq Complex where + Complex a b == Complex c d = + case a `eqFloat#` c of + 1# -> case b `eqFloat#` d of + 1# -> True + _ -> False + _ -> False + +instance Show Complex where + showsPrec p (Complex a b) + = showParen (p >= 11) + $ showString "Complex " + . showsPrec 11 (F# a) + . showString " " + . showsPrec 11 (F# b) + +instance Read Complex where + readPrec = parens $ prec 10 $ do + expectP (Ident "Complex") + (F# a) <- step readPrec + (F# b) <- step readPrec + return (Complex a b) + +data Maybe = Maybe (# (# #) | Complex #) + +instance Eq Maybe where + ma == mb = + maybe (isNothing mb) + (\a -> maybe False (\b -> a == b) mb) ma + +instance Show Maybe where + showsPrec p (Maybe m) = case m of + (# (# #) | #) -> showString "nothing" + (# | c #) -> showParen (p > 10) + $ showString "just " + . showsPrec 11 c + +instance Read Maybe where + readPrec = parens $ nothingP +++ justP + where + nothingP = prec 10 $ do + Ident "nothing" <- lexP + return nothing + justP = prec 10 $ do + Ident "just" <- lexP + a <- step readPrec + return (just a) + +listToMaybe :: [Complex] -> Maybe +listToMaybe [] = nothing +listToMaybe (x:_) = just x + +maybeToList :: Maybe -> [Complex] +maybeToList = maybe [] (: []) + +catMaybes :: [Maybe] -> [Complex] +catMaybes = mapMaybe id + +mapMaybe :: (a -> Maybe) -> [a] -> [Complex] +mapMaybe _ [] = [] +mapMaybe f (a : as) = + let ws = mapMaybe f as + in maybe ws (: ws) (f a) +{-# NOINLINE [1] mapMaybe #-} + +{-# RULES +"mapMaybe" [~1] forall f xs. mapMaybe f xs + = build (\c n -> foldr (mapMaybeFB c f) n xs) +"mapMaybeList" [1] forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f + #-} + +{-# NOINLINE [0] mapMaybeFB #-} +mapMaybeFB :: (Complex -> r -> r) -> (a -> Maybe) -> a -> r -> r +mapMaybeFB cons f x next = maybe next (flip cons next) (f x) + +isNothing :: Maybe -> Bool +isNothing = maybe True (const False) + +isJust :: Maybe -> Bool +isJust = maybe False (const True) + +nothing :: Maybe +nothing = Maybe (# (# #) | #) + +just :: Complex -> Maybe +just c = Maybe (# | c #) + +fromMaybe :: Complex -> Maybe -> Complex +fromMaybe a (Maybe m) = case m of + (# (# #) | #) -> a + (# | c #) -> c + +maybe :: a -> (Complex -> a) -> Maybe -> a +maybe a f (Maybe m) = case m of + (# (# #) | #) -> a + (# | c #) -> f c + +toBaseMaybe :: Maybe -> P.Maybe Complex +toBaseMaybe = maybe P.Nothing P.Just + +fromBaseMaybe :: P.Maybe Complex -> Maybe +fromBaseMaybe = P.maybe nothing just + diff --git a/src/Data/Maybe/Unpacked/Numeric/Double.hs b/src/Data/Maybe/Unpacked/Numeric/Double.hs new file mode 100644 --- /dev/null +++ b/src/Data/Maybe/Unpacked/Numeric/Double.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} + +module Data.Maybe.Unpacked.Numeric.Double + ( Maybe(..) + , just + , nothing + + , maybe + + , isJust + , isNothing + , fromMaybe + , listToMaybe + , maybeToList + , catMaybes + , mapMaybe + + , toBaseMaybe + , fromBaseMaybe + ) where + +import Prelude hiding (Maybe,maybe) + +import GHC.Base (build) +import GHC.Exts (Double#,Double(D#)) + +import GHC.Read (Read(readPrec)) +import Text.Read (parens, Lexeme(Ident), lexP, (+++)) +import Text.ParserCombinators.ReadPrec (prec, step) +import qualified Prelude as P + +data Maybe = Maybe (# (# #) | Double# #) + +instance Eq Maybe where + ma == mb = + maybe (isNothing mb) + (\a -> maybe False (\b -> a == b) mb) ma + +instance Ord Maybe where + compare ma mb = maybe LT (\a -> maybe GT (compare a) mb) ma + +instance Show Maybe where + showsPrec p (Maybe m) = case m of + (# (# #) | #) -> showString "nothing" + (# | d #) -> showParen (p > 10) + $ showString "just " + . showsPrec 11 (D# d) + +instance Read Maybe where + readPrec = parens $ nothingP +++ justP + where + nothingP = prec 10 $ do + Ident "nothing" <- lexP + return nothing + justP = prec 10 $ do + Ident "just" <- lexP + a <- step readPrec + return (just a) + +listToMaybe :: [Double] -> Maybe +listToMaybe [] = nothing +listToMaybe (x:_) = just x + +maybeToList :: Maybe -> [Double] +maybeToList = maybe [] (: []) + +catMaybes :: [Maybe] -> [Double] +catMaybes = mapMaybe id + +mapMaybe :: (a -> Maybe) -> [a] -> [Double] +mapMaybe _ [] = [] +mapMaybe f (a : as) = + let ws = mapMaybe f as + in maybe ws (: ws) (f a) +{-# NOINLINE [1] mapMaybe #-} + +{-# RULES +"mapMaybe" [~1] forall f xs. mapMaybe f xs + = build (\c n -> foldr (mapMaybeFB c f) n xs) +"mapMaybeList" [1] forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f + #-} + +{-# NOINLINE [0] mapMaybeFB #-} +mapMaybeFB :: (Double -> r -> r) -> (a -> Maybe) -> a -> r -> r +mapMaybeFB cons f x next = maybe next (flip cons next) (f x) + +isNothing :: Maybe -> Bool +isNothing = maybe True (const False) + +isJust :: Maybe -> Bool +isJust = maybe False (const True) + +nothing :: Maybe +nothing = Maybe (# (# #) | #) + +just :: Double -> Maybe +just (D# d) = Maybe (# | d #) + +fromMaybe :: Double -> Maybe -> Double +fromMaybe a (Maybe m) = case m of + (# (# #) | #) -> a + (# | d #) -> D# d + +maybe :: a -> (Double -> a) -> Maybe -> a +maybe a f (Maybe m) = case m of + (# (# #) | #) -> a + (# | d #) -> f (D# d) + +toBaseMaybe :: Maybe -> P.Maybe Double +toBaseMaybe = maybe P.Nothing P.Just + +fromBaseMaybe :: P.Maybe Double -> Maybe +fromBaseMaybe = P.maybe nothing just diff --git a/src/Data/Maybe/Unpacked/Numeric/Float.hs b/src/Data/Maybe/Unpacked/Numeric/Float.hs new file mode 100644 --- /dev/null +++ b/src/Data/Maybe/Unpacked/Numeric/Float.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} + +module Data.Maybe.Unpacked.Numeric.Float + ( Maybe(..) + , just + , nothing + + , maybe + + , isJust + , isNothing + , fromMaybe + , listToMaybe + , maybeToList + , catMaybes + , mapMaybe + + , toBaseMaybe + , fromBaseMaybe + ) where + +import Prelude hiding (Maybe,maybe) + +import GHC.Base (build) +import GHC.Exts (Float#,Float(F#)) + +import GHC.Read (Read(readPrec)) +import Text.Read (parens, Lexeme(Ident), lexP, (+++)) +import Text.ParserCombinators.ReadPrec (prec, step) +import qualified Prelude as P + +data Maybe = Maybe (# (# #) | Float# #) + +instance Eq Maybe where + ma == mb = + maybe (isNothing mb) + (\a -> maybe False (\b -> a == b) mb) ma + +instance Ord Maybe where + compare ma mb = maybe LT (\a -> maybe GT (compare a) mb) ma + +instance Show Maybe where + showsPrec p (Maybe m) = case m of + (# (# #) | #) -> showString "nothing" + (# | d #) -> showParen (p > 10) + $ showString "just " + . showsPrec 11 (F# d) + +instance Read Maybe where + readPrec = parens $ nothingP +++ justP + where + nothingP = prec 10 $ do + Ident "nothing" <- lexP + return nothing + justP = prec 10 $ do + Ident "just" <- lexP + a <- step readPrec + return (just a) + +listToMaybe :: [Float] -> Maybe +listToMaybe [] = nothing +listToMaybe (x:_) = just x + +maybeToList :: Maybe -> [Float] +maybeToList = maybe [] (: []) + +catMaybes :: [Maybe] -> [Float] +catMaybes = mapMaybe id + +mapMaybe :: (a -> Maybe) -> [a] -> [Float] +mapMaybe _ [] = [] +mapMaybe f (a : as) = + let ws = mapMaybe f as + in maybe ws (: ws) (f a) +{-# NOINLINE [1] mapMaybe #-} + +{-# RULES +"mapMaybe" [~1] forall f xs. mapMaybe f xs + = build (\c n -> foldr (mapMaybeFB c f) n xs) +"mapMaybeList" [1] forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f + #-} + +{-# NOINLINE [0] mapMaybeFB #-} +mapMaybeFB :: (Float -> r -> r) -> (a -> Maybe) -> a -> r -> r +mapMaybeFB cons f x next = maybe next (flip cons next) (f x) + +isNothing :: Maybe -> Bool +isNothing = maybe True (const False) + +isJust :: Maybe -> Bool +isJust = maybe False (const True) + +nothing :: Maybe +nothing = Maybe (# (# #) | #) + +just :: Float -> Maybe +just (F# d) = Maybe (# | d #) + +fromMaybe :: Float -> Maybe -> Float +fromMaybe a (Maybe m) = case m of + (# (# #) | #) -> a + (# | d #) -> F# d + +maybe :: a -> (Float -> a) -> Maybe -> a +maybe a f (Maybe m) = case m of + (# (# #) | #) -> a + (# | d #) -> f (F# d) + +toBaseMaybe :: Maybe -> P.Maybe Float +toBaseMaybe = maybe P.Nothing P.Just + +fromBaseMaybe :: P.Maybe Float -> Maybe +fromBaseMaybe = P.maybe nothing just diff --git a/src/Data/Maybe/Unpacked/Numeric/Int.hs b/src/Data/Maybe/Unpacked/Numeric/Int.hs new file mode 100644 --- /dev/null +++ b/src/Data/Maybe/Unpacked/Numeric/Int.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} + +module Data.Maybe.Unpacked.Numeric.Int + ( Maybe(..) + , just + , nothing + + , maybe + + , isJust + , isNothing + , fromMaybe + , listToMaybe + , maybeToList + , catMaybes + , mapMaybe + + , toBaseMaybe + , fromBaseMaybe + ) where + +import Prelude hiding (Maybe,maybe) + +import GHC.Base (build) +import GHC.Exts (Int#) +import GHC.Int (Int(I#)) + +import GHC.Read (Read(readPrec)) +import Text.Read (parens, Lexeme(Ident), lexP, (+++)) +import Text.ParserCombinators.ReadPrec (prec, step) + +import qualified Prelude as P + +data Maybe = Maybe (# (# #) | Int# #) + +instance Eq Maybe where + ma == mb = + maybe (isNothing mb) + (\a -> maybe False (\b -> a == b) mb) ma + +instance Ord Maybe where + compare ma mb = maybe LT (\a -> maybe GT (compare a) mb) ma + +instance Show Maybe where + showsPrec p (Maybe m) = case m of + (# (# #) | #) -> showString "nothing" + (# | i #) -> showParen (p > 10) + $ showString "just " + . showsPrec 11 (I# i) + +instance Read Maybe where + readPrec = parens $ nothingP +++ justP + where + nothingP = prec 10 $ do + Ident "nothing" <- lexP + return nothing + justP = prec 10 $ do + Ident "just" <- lexP + a <- step readPrec + return (just a) + +listToMaybe :: [Int] -> Maybe +listToMaybe [] = nothing +listToMaybe (x:_) = just x + +maybeToList :: Maybe -> [Int] +maybeToList = maybe [] (: []) + +catMaybes :: [Maybe] -> [Int] +catMaybes = mapMaybe id + +mapMaybe :: (a -> Maybe) -> [a] -> [Int] +mapMaybe _ [] = [] +mapMaybe f (a : as) = + let ws = mapMaybe f as + in maybe ws (: ws) (f a) +{-# NOINLINE [1] mapMaybe #-} + +{-# RULES +"mapMaybe" [~1] forall f xs. mapMaybe f xs + = build (\c n -> foldr (mapMaybeFB c f) n xs) +"mapMaybeList" [1] forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f + #-} + +{-# NOINLINE [0] mapMaybeFB #-} +mapMaybeFB :: (Int -> r -> r) -> (a -> Maybe) -> a -> r -> r +mapMaybeFB cons f x next = maybe next (flip cons next) (f x) + +isNothing :: Maybe -> Bool +isNothing = maybe True (const False) + +isJust :: Maybe -> Bool +isJust = maybe False (const True) + +nothing :: Maybe +nothing = Maybe (# (# #) | #) + +just :: Int -> Maybe +just (I# i) = Maybe (# | i #) + +fromMaybe :: Int -> Maybe -> Int +fromMaybe a (Maybe m) = case m of + (# (# #) | #) -> a + (# | i #) -> I# i + +maybe :: a -> (Int -> a) -> Maybe -> a +maybe a f (Maybe m) = case m of + (# (# #) | #) -> a + (# | i #) -> f (I# i) + +toBaseMaybe :: Maybe -> P.Maybe Int +toBaseMaybe = maybe P.Nothing P.Just + +fromBaseMaybe :: P.Maybe Int -> Maybe +fromBaseMaybe = P.maybe nothing just + diff --git a/src/Data/Maybe/Unpacked/Numeric/Int16.hs b/src/Data/Maybe/Unpacked/Numeric/Int16.hs new file mode 100644 --- /dev/null +++ b/src/Data/Maybe/Unpacked/Numeric/Int16.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} + +module Data.Maybe.Unpacked.Numeric.Int16 + ( Maybe(..) + , just + , nothing + + , maybe + + , isJust + , isNothing + , fromMaybe + , listToMaybe + , maybeToList + , catMaybes + , mapMaybe + + , toBaseMaybe + , fromBaseMaybe + ) where + +import Prelude hiding (Maybe,maybe) + +import GHC.Base (build) +import GHC.Exts (Int#, (>#), (<#)) +import GHC.Int (Int16(I16#)) + +import GHC.Read (Read(readPrec)) +import Text.Read (parens, Lexeme(Ident), lexP, (+++)) +import Text.ParserCombinators.ReadPrec (prec, step) + +import qualified Prelude as P + +data Maybe = M Int# + +instance Eq Maybe where + ma == mb = + maybe (isNothing mb) + (\a -> maybe False (\b -> a == b) mb) ma + +instance Ord Maybe where + compare ma mb = maybe LT (\a -> maybe GT (compare a) mb) ma + +instance Show Maybe where + showsPrec p m = + maybe (showString "nothing") + (\i -> showParen (p > 10) + $ showString "just " + . showsPrec 11 i + ) m + +instance Read Maybe where + readPrec = parens $ nothingP +++ justP + where + nothingP = prec 10 $ do + Ident "nothing" <- lexP + return nothing + justP = prec 10 $ do + Ident "just" <- lexP + a <- step readPrec + return (just a) + +listToMaybe :: [Int16] -> Maybe +{-# INLINE listToMaybe #-} +listToMaybe [] = nothing +listToMaybe (x:_) = just x + +maybeToList :: Maybe -> [Int16] +maybeToList m = maybe [] (: []) m + +catMaybes :: [Maybe] -> [Int16] +catMaybes ms = mapMaybe id ms + +mapMaybe :: (a -> Maybe) -> [a] -> [Int16] +mapMaybe _ [] = [] +mapMaybe f (a : as) = + let ws = mapMaybe f as + in maybe ws (: ws) (f a) +{-# NOINLINE [1] mapMaybe #-} + +{-# RULES +"mapMaybe" [~1] forall f xs. mapMaybe f xs + = build (\c n -> foldr (mapMaybeFB c f) n xs) +"mapMaybeList" [1] forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f + #-} + +{-# NOINLINE [0] mapMaybeFB #-} +mapMaybeFB :: (Int16 -> r -> r) -> (a -> Maybe) -> a -> r -> r +mapMaybeFB cons f x next = maybe next (flip cons next) (f x) + +isNothing :: Maybe -> Bool +{-# INLINE isNothing #-} +isNothing m = maybe True (const False) m + +isJust :: Maybe -> Bool +{-# INLINE isJust #-} +isJust m = maybe False (const True) m + +nothing :: Maybe +{-# INLINE nothing #-} +nothing = M 32768# + +just :: Int16 -> Maybe +{-# INLINE just #-} +just (I16# i) = M i + +fromMaybe :: Int16 -> Maybe -> Int16 +{-# INLINE fromMaybe #-} +fromMaybe a m = maybe a id m + +maybe :: a -> (Int16 -> a) -> Maybe -> a +{-# INLINE maybe #-} +maybe a f (M m) = case m ># 32767# of + 1# -> a + _ -> case m <# -32768# of + 1# -> a + _ -> f (I16# m) + +toBaseMaybe :: Maybe -> P.Maybe Int16 +{-# INLINE toBaseMaybe #-} +toBaseMaybe m = maybe P.Nothing P.Just m + +fromBaseMaybe :: P.Maybe Int16 -> Maybe +{-# INLINE fromBaseMaybe #-} +fromBaseMaybe m = P.maybe nothing just m + diff --git a/src/Data/Maybe/Unpacked/Numeric/Int32.hs b/src/Data/Maybe/Unpacked/Numeric/Int32.hs new file mode 100644 --- /dev/null +++ b/src/Data/Maybe/Unpacked/Numeric/Int32.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} + +module Data.Maybe.Unpacked.Numeric.Int32 + ( Maybe(..) + , just + , nothing + + , maybe + + , isJust + , isNothing + , fromMaybe + , listToMaybe + , maybeToList + , catMaybes + , mapMaybe + + , toBaseMaybe + , fromBaseMaybe + ) where + +import Prelude hiding (Maybe,maybe) + +import GHC.Base (build) +import GHC.Exts +import GHC.Int (Int32(I32#)) + +import GHC.Read (Read(readPrec)) +import Text.Read (parens, Lexeme(Ident), lexP, (+++)) +import Text.ParserCombinators.ReadPrec (prec, step) + +import qualified Prelude as P + +data Maybe = M Int# + +instance Eq Maybe where + ma == mb = + maybe (isNothing mb) + (\a -> maybe False (\b -> a == b) mb) ma + {-# INLINE (==) #-} + +instance Ord Maybe where + compare ma mb = maybe LT (\a -> maybe GT (compare a) mb) ma + {-# INLINE compare #-} + +instance Show Maybe where + showsPrec p m = + maybe (showString "nothing") + (\i -> showParen (p > 10) + $ showString "just " + . showsPrec 11 i + ) m + +instance Read Maybe where + readPrec = parens $ nothingP +++ justP + where + nothingP = prec 10 $ do + Ident "nothing" <- lexP + return nothing + justP = prec 10 $ do + Ident "just" <- lexP + a <- step readPrec + return (just a) + +listToMaybe :: [Int32] -> Maybe +{-# INLINE listToMaybe #-} +listToMaybe [] = nothing +listToMaybe (x:_) = just x + +maybeToList :: Maybe -> [Int32] +maybeToList m = maybe [] (: []) m + +catMaybes :: [Maybe] -> [Int32] +catMaybes ms = mapMaybe id ms + +mapMaybe :: (a -> Maybe) -> [a] -> [Int32] +mapMaybe _ [] = [] +mapMaybe f (a : as) = + let ws = mapMaybe f as + in maybe ws (: ws) (f a) +{-# NOINLINE [1] mapMaybe #-} + +{-# RULES +"mapMaybe" [~1] forall f xs. mapMaybe f xs + = build (\c n -> foldr (mapMaybeFB c f) n xs) +"mapMaybeList" [1] forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f + #-} + +{-# NOINLINE [0] mapMaybeFB #-} +mapMaybeFB :: (Int32 -> r -> r) -> (a -> Maybe) -> a -> r -> r +mapMaybeFB cons f x next = maybe next (flip cons next) (f x) + +isNothing :: Maybe -> Bool +{-# INLINE isNothing #-} +isNothing m = maybe True (const False) m + +isJust :: Maybe -> Bool +{-# INLINE isJust #-} +isJust m = maybe False (const True) m + +nothing :: Maybe +{-# INLINE nothing #-} +nothing = M 2147483648# + +just :: Int32 -> Maybe +{-# INLINE just #-} +just (I32# i) = M i + +fromMaybe :: Int32 -> Maybe -> Int32 +{-# INLINE fromMaybe #-} +fromMaybe a m = maybe a id m + +maybe :: a -> (Int32 -> a) -> Maybe -> a +{-# INLINE maybe #-} +maybe a f (M m) = case m ># 2147483647# of + 1# -> a + _ -> case m <# -2147483648# of + 1# -> a + _ -> f (I32# m) + +toBaseMaybe :: Maybe -> P.Maybe Int32 +{-# INLINE toBaseMaybe #-} +toBaseMaybe m = maybe P.Nothing P.Just m + +fromBaseMaybe :: P.Maybe Int32 -> Maybe +{-# INLINE fromBaseMaybe #-} +fromBaseMaybe m = P.maybe nothing just m + diff --git a/src/Data/Maybe/Unpacked/Numeric/Int64.hs b/src/Data/Maybe/Unpacked/Numeric/Int64.hs new file mode 100644 --- /dev/null +++ b/src/Data/Maybe/Unpacked/Numeric/Int64.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} + +module Data.Maybe.Unpacked.Numeric.Int64 + ( Maybe(..) + , just + , nothing + + , maybe + + , isJust + , isNothing + , fromMaybe + , listToMaybe + , maybeToList + , catMaybes + , mapMaybe + + , toBaseMaybe + , fromBaseMaybe + ) where + +import Prelude hiding (Maybe,maybe) + +import GHC.Base (build) +import GHC.Exts (Int#) +import GHC.Int (Int64(I64#)) + +import GHC.Read (Read(readPrec)) +import Text.Read (parens, Lexeme(Ident), lexP, (+++)) +import Text.ParserCombinators.ReadPrec (prec, step) + +import qualified Prelude as P + +data Maybe = Maybe (# (# #) | Int# #) + +instance Eq Maybe where + ma == mb = + maybe (isNothing mb) + (\a -> maybe False (\b -> a == b) mb) ma + +instance Ord Maybe where + compare ma mb = maybe LT (\a -> maybe GT (compare a) mb) ma + +instance Show Maybe where + showsPrec p (Maybe m) = case m of + (# (# #) | #) -> showString "nothing" + (# | i #) -> showParen (p > 10) + $ showString "just " + . showsPrec 11 (I64# i) + +instance Read Maybe where + readPrec = parens $ nothingP +++ justP + where + nothingP = prec 10 $ do + Ident "nothing" <- lexP + return nothing + justP = prec 10 $ do + Ident "just" <- lexP + a <- step readPrec + return (just a) + +listToMaybe :: [Int64] -> Maybe +listToMaybe [] = nothing +listToMaybe (x:_) = just x + +maybeToList :: Maybe -> [Int64] +maybeToList = maybe [] (: []) + +catMaybes :: [Maybe] -> [Int64] +catMaybes = mapMaybe id + +mapMaybe :: (a -> Maybe) -> [a] -> [Int64] +mapMaybe _ [] = [] +mapMaybe f (a : as) = + let ws = mapMaybe f as + in maybe ws (: ws) (f a) +{-# NOINLINE [1] mapMaybe #-} + +{-# RULES +"mapMaybe" [~1] forall f xs. mapMaybe f xs + = build (\c n -> foldr (mapMaybeFB c f) n xs) +"mapMaybeList" [1] forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f + #-} + +{-# NOINLINE [0] mapMaybeFB #-} +mapMaybeFB :: (Int64 -> r -> r) -> (a -> Maybe) -> a -> r -> r +mapMaybeFB cons f x next = maybe next (flip cons next) (f x) + +isNothing :: Maybe -> Bool +isNothing = maybe True (const False) + +isJust :: Maybe -> Bool +isJust = maybe False (const True) + +nothing :: Maybe +nothing = Maybe (# (# #) | #) + +just :: Int64 -> Maybe +just (I64# i) = Maybe (# | i #) + +fromMaybe :: Int64 -> Maybe -> Int64 +fromMaybe a (Maybe m) = case m of + (# (# #) | #) -> a + (# | i #) -> I64# i + +maybe :: a -> (Int64 -> a) -> Maybe -> a +maybe a f (Maybe m) = case m of + (# (# #) | #) -> a + (# | i #) -> f (I64# i) + +toBaseMaybe :: Maybe -> P.Maybe Int64 +toBaseMaybe = maybe P.Nothing P.Just + +fromBaseMaybe :: P.Maybe Int64 -> Maybe +fromBaseMaybe = P.maybe nothing just + diff --git a/src/Data/Maybe/Unpacked/Numeric/Int8.hs b/src/Data/Maybe/Unpacked/Numeric/Int8.hs new file mode 100644 --- /dev/null +++ b/src/Data/Maybe/Unpacked/Numeric/Int8.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} + +module Data.Maybe.Unpacked.Numeric.Int8 + ( Maybe(..) + , just + , nothing + + , maybe + + , isJust + , isNothing + , fromMaybe + , listToMaybe + , maybeToList + , catMaybes + , mapMaybe + + , toBaseMaybe + , fromBaseMaybe + ) where + +import Prelude hiding (Maybe,maybe) + +import GHC.Base (build) +import GHC.Exts +import GHC.Int (Int8(I8#)) + +import GHC.Read (Read(readPrec)) +import Text.Read (parens, Lexeme(Ident), lexP, (+++)) +import Text.ParserCombinators.ReadPrec (prec, step) + +import qualified Prelude as P + +data Maybe = M Int# + +instance Eq Maybe where + ma == mb = + maybe (isNothing mb) + (\a -> maybe False (\b -> a == b) mb) ma + +instance Ord Maybe where + compare ma mb = maybe LT (\a -> maybe GT (compare a) mb) ma + +instance Show Maybe where + showsPrec p m = + maybe (showString "nothing") + (\i -> showParen (p > 10) + $ showString "just " + . showsPrec 11 i + ) m + +instance Read Maybe where + readPrec = parens $ nothingP +++ justP + where + nothingP = prec 10 $ do + Ident "nothing" <- lexP + return nothing + justP = prec 10 $ do + Ident "just" <- lexP + a <- step readPrec + return (just a) + +listToMaybe :: [Int8] -> Maybe +{-# INLINE listToMaybe #-} +listToMaybe [] = nothing +listToMaybe (x:_) = just x + +maybeToList :: Maybe -> [Int8] +maybeToList m = maybe [] (: []) m + +catMaybes :: [Maybe] -> [Int8] +catMaybes ms = mapMaybe id ms + +mapMaybe :: (a -> Maybe) -> [a] -> [Int8] +mapMaybe _ [] = [] +mapMaybe f (a : as) = + let ws = mapMaybe f as + in maybe ws (: ws) (f a) +{-# NOINLINE [1] mapMaybe #-} + +{-# RULES +"mapMaybe" [~1] forall f xs. mapMaybe f xs + = build (\c n -> foldr (mapMaybeFB c f) n xs) +"mapMaybeList" [1] forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f + #-} + +{-# NOINLINE [0] mapMaybeFB #-} +mapMaybeFB :: (Int8 -> r -> r) -> (a -> Maybe) -> a -> r -> r +mapMaybeFB cons f x next = maybe next (flip cons next) (f x) + +isNothing :: Maybe -> Bool +{-# INLINE isNothing #-} +isNothing m = maybe True (const False) m + +isJust :: Maybe -> Bool +{-# INLINE isJust #-} +isJust m = maybe False (const True) m + +nothing :: Maybe +{-# INLINE nothing #-} +nothing = M 128# + +just :: Int8 -> Maybe +{-# INLINE just #-} +just (I8# i) = M i + +fromMaybe :: Int8 -> Maybe -> Int8 +{-# INLINE fromMaybe #-} +fromMaybe a m = maybe a id m + +maybe :: a -> (Int8 -> a) -> Maybe -> a +{-# INLINE maybe #-} +maybe a f (M m) = case m ># 127# of + 1# -> a + _ -> case m <# -128# of + 1# -> a + _ -> f (I8# m) + +toBaseMaybe :: Maybe -> P.Maybe Int8 +{-# INLINE toBaseMaybe #-} +toBaseMaybe m = maybe P.Nothing P.Just m + +fromBaseMaybe :: P.Maybe Int8 -> Maybe +{-# INLINE fromBaseMaybe #-} +fromBaseMaybe m = P.maybe nothing just m + diff --git a/src/Data/Maybe/Unpacked/Numeric/Word.hs b/src/Data/Maybe/Unpacked/Numeric/Word.hs new file mode 100644 --- /dev/null +++ b/src/Data/Maybe/Unpacked/Numeric/Word.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} + +module Data.Maybe.Unpacked.Numeric.Word + ( Maybe(..) + , just + , nothing + + , maybe + + , isJust + , isNothing + , fromMaybe + , listToMaybe + , maybeToList + , catMaybes + , mapMaybe + + , toBaseMaybe + , fromBaseMaybe + ) where + +import Prelude hiding (Maybe,maybe) + +import GHC.Base (build) +import GHC.Exts (Word#) +import GHC.Word (Word(W#)) + +import GHC.Read (Read(readPrec)) +import Text.Read (parens, Lexeme(Ident), lexP, (+++)) +import Text.ParserCombinators.ReadPrec (prec, step) + +import qualified Prelude as P + +data Maybe = Maybe (# (# #) | Word# #) + +instance Eq Maybe where + ma == mb = + maybe (isNothing mb) + (\a -> maybe False (\b -> a == b) mb) ma + +instance Ord Maybe where + compare ma mb = maybe LT (\a -> maybe GT (compare a) mb) ma + +instance Show Maybe where + showsPrec p (Maybe m) = case m of + (# (# #) | #) -> showString "nothing" + (# | w #) -> showParen (p > 10) + $ showString "just " + . showsPrec 11 (W# w) + +instance Read Maybe where + readPrec = parens $ nothingP +++ justP + where + nothingP = prec 10 $ do + Ident "nothing" <- lexP + return nothing + justP = prec 10 $ do + Ident "just" <- lexP + a <- step readPrec + return (just a) + +listToMaybe :: [Word] -> Maybe +listToMaybe [] = nothing +listToMaybe (x:_) = just x + +maybeToList :: Maybe -> [Word] +maybeToList = maybe [] (: []) + +catMaybes :: [Maybe] -> [Word] +catMaybes = mapMaybe id + +mapMaybe :: (a -> Maybe) -> [a] -> [Word] +mapMaybe _ [] = [] +mapMaybe f (a : as) = + let ws = mapMaybe f as + in maybe ws (: ws) (f a) +{-# NOINLINE [1] mapMaybe #-} + +{-# RULES +"mapMaybe" [~1] forall f xs. mapMaybe f xs + = build (\c n -> foldr (mapMaybeFB c f) n xs) +"mapMaybeList" [1] forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f + #-} + +{-# NOINLINE [0] mapMaybeFB #-} +mapMaybeFB :: (Word -> r -> r) -> (a -> Maybe) -> a -> r -> r +mapMaybeFB cons f x next = maybe next (flip cons next) (f x) + +isNothing :: Maybe -> Bool +isNothing = maybe True (const False) + +isJust :: Maybe -> Bool +isJust = maybe False (const True) + +nothing :: Maybe +nothing = Maybe (# (# #) | #) + +just :: Word -> Maybe +just (W# w) = Maybe (# | w #) + +fromMaybe :: Word -> Maybe -> Word +fromMaybe a (Maybe m) = case m of + (# (# #) | #) -> a + (# | w #) -> W# w + +maybe :: a -> (Word -> a) -> Maybe -> a +maybe a f (Maybe m) = case m of + (# (# #) | #) -> a + (# | w #) -> f (W# w) + +toBaseMaybe :: Maybe -> P.Maybe Word +toBaseMaybe = maybe P.Nothing P.Just + +fromBaseMaybe :: P.Maybe Word -> Maybe +fromBaseMaybe = P.maybe nothing just + diff --git a/src/Data/Maybe/Unpacked/Numeric/Word16.hs b/src/Data/Maybe/Unpacked/Numeric/Word16.hs new file mode 100644 --- /dev/null +++ b/src/Data/Maybe/Unpacked/Numeric/Word16.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} + +module Data.Maybe.Unpacked.Numeric.Word16 + ( Maybe(..) + , just + , nothing + + , maybe + + , isJust + , isNothing + , fromMaybe + , listToMaybe + , maybeToList + , catMaybes + , mapMaybe + + , toBaseMaybe + , fromBaseMaybe + ) where + +import Prelude hiding (Maybe,maybe) + +import GHC.Base (build) +import GHC.Exts (Word#) +import GHC.Word (Word16(W16#)) + +import GHC.Read (Read(readPrec)) +import Text.Read (parens, Lexeme(Ident), lexP, (+++)) +import Text.ParserCombinators.ReadPrec (prec, step) + +import qualified Prelude as P + +data Maybe = Maybe (# (# #) | Word# #) + +instance Eq Maybe where + ma == mb = + maybe (isNothing mb) + (\a -> maybe False (\b -> a == b) mb) ma + +instance Ord Maybe where + compare ma mb = maybe LT (\a -> maybe GT (compare a) mb) ma + +instance Show Maybe where + showsPrec p (Maybe m) = case m of + (# (# #) | #) -> showString "nothing" + (# | w #) -> showParen (p > 10) + $ showString "just " + . showsPrec 11 (W16# w) + +instance Read Maybe where + readPrec = parens $ nothingP +++ justP + where + nothingP = prec 10 $ do + Ident "nothing" <- lexP + return nothing + justP = prec 10 $ do + Ident "just" <- lexP + a <- step readPrec + return (just a) + +listToMaybe :: [Word16] -> Maybe +listToMaybe [] = nothing +listToMaybe (x:_) = just x + +maybeToList :: Maybe -> [Word16] +maybeToList = maybe [] (: []) + +catMaybes :: [Maybe] -> [Word16] +catMaybes = mapMaybe id + +mapMaybe :: (a -> Maybe) -> [a] -> [Word16] +mapMaybe _ [] = [] +mapMaybe f (a : as) = + let ws = mapMaybe f as + in maybe ws (: ws) (f a) +{-# NOINLINE [1] mapMaybe #-} + +{-# RULES +"mapMaybe" [~1] forall f xs. mapMaybe f xs + = build (\c n -> foldr (mapMaybeFB c f) n xs) +"mapMaybeList" [1] forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f + #-} + +{-# NOINLINE [0] mapMaybeFB #-} +mapMaybeFB :: (Word16 -> r -> r) -> (a -> Maybe) -> a -> r -> r +mapMaybeFB cons f x next = maybe next (flip cons next) (f x) + +isNothing :: Maybe -> Bool +isNothing = maybe True (const False) + +isJust :: Maybe -> Bool +isJust = maybe False (const True) + +nothing :: Maybe +nothing = Maybe (# (# #) | #) + +just :: Word16 -> Maybe +just (W16# w) = Maybe (# | w #) + +fromMaybe :: Word16 -> Maybe -> Word16 +fromMaybe a (Maybe m) = case m of + (# (# #) | #) -> a + (# | w #) -> W16# w + +maybe :: a -> (Word16 -> a) -> Maybe -> a +maybe a f (Maybe m) = case m of + (# (# #) | #) -> a + (# | w #) -> f (W16# w) + +toBaseMaybe :: Maybe -> P.Maybe Word16 +toBaseMaybe = maybe P.Nothing P.Just + +fromBaseMaybe :: P.Maybe Word16 -> Maybe +fromBaseMaybe = P.maybe nothing just + diff --git a/src/Data/Maybe/Unpacked/Numeric/Word32.hs b/src/Data/Maybe/Unpacked/Numeric/Word32.hs new file mode 100644 --- /dev/null +++ b/src/Data/Maybe/Unpacked/Numeric/Word32.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} + +module Data.Maybe.Unpacked.Numeric.Word32 + ( Maybe(..) + , just + , nothing + + , maybe + + , isJust + , isNothing + , fromMaybe + , listToMaybe + , maybeToList + , catMaybes + , mapMaybe + + , toBaseMaybe + , fromBaseMaybe + ) where + +import Prelude hiding (Maybe,maybe) + +import GHC.Base (build) +import GHC.Exts (Word#) +import GHC.Word (Word32(W32#)) + +import GHC.Read (Read(readPrec)) +import Text.Read (parens, Lexeme(Ident), lexP, (+++)) +import Text.ParserCombinators.ReadPrec (prec, step) + +import qualified Prelude as P + +data Maybe = Maybe (# (# #) | Word# #) + +instance Eq Maybe where + ma == mb = + maybe (isNothing mb) + (\a -> maybe False (\b -> a == b) mb) ma + +instance Ord Maybe where + compare ma mb = maybe LT (\a -> maybe GT (compare a) mb) ma + +instance Show Maybe where + showsPrec p (Maybe m) = case m of + (# (# #) | #) -> showString "nothing" + (# | w #) -> showParen (p > 10) + $ showString "just " + . showsPrec 11 (W32# w) + +instance Read Maybe where + readPrec = parens $ nothingP +++ justP + where + nothingP = prec 10 $ do + Ident "nothing" <- lexP + return nothing + justP = prec 10 $ do + Ident "just" <- lexP + a <- step readPrec + return (just a) + +listToMaybe :: [Word32] -> Maybe +listToMaybe [] = nothing +listToMaybe (x:_) = just x + +maybeToList :: Maybe -> [Word32] +maybeToList = maybe [] (: []) + +catMaybes :: [Maybe] -> [Word32] +catMaybes = mapMaybe id + +mapMaybe :: (a -> Maybe) -> [a] -> [Word32] +mapMaybe _ [] = [] +mapMaybe f (a : as) = + let ws = mapMaybe f as + in maybe ws (: ws) (f a) +{-# NOINLINE [1] mapMaybe #-} + +{-# RULES +"mapMaybe" [~1] forall f xs. mapMaybe f xs + = build (\c n -> foldr (mapMaybeFB c f) n xs) +"mapMaybeList" [1] forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f + #-} + +{-# NOINLINE [0] mapMaybeFB #-} +mapMaybeFB :: (Word32 -> r -> r) -> (a -> Maybe) -> a -> r -> r +mapMaybeFB cons f x next = maybe next (flip cons next) (f x) + +isNothing :: Maybe -> Bool +isNothing = maybe True (const False) + +isJust :: Maybe -> Bool +isJust = maybe False (const True) + +nothing :: Maybe +nothing = Maybe (# (# #) | #) + +just :: Word32 -> Maybe +just (W32# w) = Maybe (# | w #) + +fromMaybe :: Word32 -> Maybe -> Word32 +fromMaybe a (Maybe m) = case m of + (# (# #) | #) -> a + (# | w #) -> W32# w + +maybe :: a -> (Word32 -> a) -> Maybe -> a +maybe a f (Maybe m) = case m of + (# (# #) | #) -> a + (# | w #) -> f (W32# w) + +toBaseMaybe :: Maybe -> P.Maybe Word32 +toBaseMaybe = maybe P.Nothing P.Just + +fromBaseMaybe :: P.Maybe Word32 -> Maybe +fromBaseMaybe = P.maybe nothing just + diff --git a/src/Data/Maybe/Unpacked/Numeric/Word64.hs b/src/Data/Maybe/Unpacked/Numeric/Word64.hs new file mode 100644 --- /dev/null +++ b/src/Data/Maybe/Unpacked/Numeric/Word64.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} + +module Data.Maybe.Unpacked.Numeric.Word64 + ( Maybe(..) + , just + , nothing + + , maybe + + , isJust + , isNothing + , fromMaybe + , listToMaybe + , maybeToList + , catMaybes + , mapMaybe + + , toBaseMaybe + , fromBaseMaybe + ) where + +import Prelude hiding (Maybe,maybe) + +import GHC.Base (build) +import GHC.Exts (Word#) +import GHC.Word (Word64(W64#)) + +import GHC.Read (Read(readPrec)) +import Text.Read (parens, Lexeme(Ident), lexP, (+++)) +import Text.ParserCombinators.ReadPrec (prec, step) + +import qualified Prelude as P + +data Maybe = Maybe (# (# #) | Word# #) + +instance Eq Maybe where + ma == mb = + maybe (isNothing mb) + (\a -> maybe False (\b -> a == b) mb) ma + +instance Ord Maybe where + compare ma mb = maybe LT (\a -> maybe GT (compare a) mb) ma + +instance Show Maybe where + showsPrec p (Maybe m) = case m of + (# (# #) | #) -> showString "nothing" + (# | w #) -> showParen (p > 10) + $ showString "just " + . showsPrec 11 (W64# w) + +instance Read Maybe where + readPrec = parens $ nothingP +++ justP + where + nothingP = prec 10 $ do + Ident "nothing" <- lexP + return nothing + justP = prec 10 $ do + Ident "just" <- lexP + a <- step readPrec + return (just a) + +listToMaybe :: [Word64] -> Maybe +listToMaybe [] = nothing +listToMaybe (x:_) = just x + +maybeToList :: Maybe -> [Word64] +maybeToList = maybe [] (: []) + +catMaybes :: [Maybe] -> [Word64] +catMaybes = mapMaybe id + +mapMaybe :: (a -> Maybe) -> [a] -> [Word64] +mapMaybe _ [] = [] +mapMaybe f (a : as) = + let ws = mapMaybe f as + in maybe ws (: ws) (f a) +{-# NOINLINE [1] mapMaybe #-} + +{-# RULES +"mapMaybe" [~1] forall f xs. mapMaybe f xs + = build (\c n -> foldr (mapMaybeFB c f) n xs) +"mapMaybeList" [1] forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f + #-} + +{-# NOINLINE [0] mapMaybeFB #-} +mapMaybeFB :: (Word64 -> r -> r) -> (a -> Maybe) -> a -> r -> r +mapMaybeFB cons f x next = maybe next (flip cons next) (f x) + +isNothing :: Maybe -> Bool +isNothing = maybe True (const False) + +isJust :: Maybe -> Bool +isJust = maybe False (const True) + +nothing :: Maybe +nothing = Maybe (# (# #) | #) + +just :: Word64 -> Maybe +just (W64# w) = Maybe (# | w #) + +fromMaybe :: Word64 -> Maybe -> Word64 +fromMaybe a (Maybe m) = case m of + (# (# #) | #) -> a + (# | w #) -> W64# w + +maybe :: a -> (Word64 -> a) -> Maybe -> a +maybe a f (Maybe m) = case m of + (# (# #) | #) -> a + (# | w #) -> f (W64# w) + +toBaseMaybe :: Maybe -> P.Maybe Word64 +toBaseMaybe = maybe P.Nothing P.Just + +fromBaseMaybe :: P.Maybe Word64 -> Maybe +fromBaseMaybe = P.maybe nothing just + diff --git a/src/Data/Maybe/Unpacked/Numeric/Word8.hs b/src/Data/Maybe/Unpacked/Numeric/Word8.hs new file mode 100644 --- /dev/null +++ b/src/Data/Maybe/Unpacked/Numeric/Word8.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} + +module Data.Maybe.Unpacked.Numeric.Word8 + ( Maybe(..) + , just + , nothing + + , maybe + + , isJust + , isNothing + , fromMaybe + , listToMaybe + , maybeToList + , catMaybes + , mapMaybe + + , toBaseMaybe + , fromBaseMaybe + ) where + +import Prelude hiding (Maybe,maybe) + +import GHC.Base (build) +import GHC.Exts (Word#) +import GHC.Word (Word8(W8#)) + +import GHC.Read (Read(readPrec)) +import Text.Read (parens, Lexeme(Ident), lexP, (+++)) +import Text.ParserCombinators.ReadPrec (prec, step) + +import qualified Prelude as P + +data Maybe = Maybe (# (# #) | Word# #) + +instance Eq Maybe where + ma == mb = + maybe (isNothing mb) + (\a -> maybe False (\b -> a == b) mb) ma + +instance Ord Maybe where + compare ma mb = maybe LT (\a -> maybe GT (compare a) mb) ma + +instance Show Maybe where + showsPrec p (Maybe m) = case m of + (# (# #) | #) -> showString "nothing" + (# | w #) -> showParen (p > 10) + $ showString "just " + . showsPrec 11 (W8# w) + +instance Read Maybe where + readPrec = parens $ nothingP +++ justP + where + nothingP = prec 10 $ do + Ident "nothing" <- lexP + return nothing + justP = prec 10 $ do + Ident "just" <- lexP + a <- step readPrec + return (just a) + +listToMaybe :: [Word8] -> Maybe +listToMaybe [] = nothing +listToMaybe (x:_) = just x + +maybeToList :: Maybe -> [Word8] +maybeToList = maybe [] (: []) + +catMaybes :: [Maybe] -> [Word8] +catMaybes = mapMaybe id + +mapMaybe :: (a -> Maybe) -> [a] -> [Word8] +mapMaybe _ [] = [] +mapMaybe f (a : as) = + let ws = mapMaybe f as + in maybe ws (: ws) (f a) +{-# NOINLINE [1] mapMaybe #-} + +{-# RULES +"mapMaybe" [~1] forall f xs. mapMaybe f xs + = build (\c n -> foldr (mapMaybeFB c f) n xs) +"mapMaybeList" [1] forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f + #-} + +{-# NOINLINE [0] mapMaybeFB #-} +mapMaybeFB :: (Word8 -> r -> r) -> (a -> Maybe) -> a -> r -> r +mapMaybeFB cons f x next = maybe next (flip cons next) (f x) + +isNothing :: Maybe -> Bool +isNothing = maybe True (const False) + +isJust :: Maybe -> Bool +isJust = maybe False (const True) + +nothing :: Maybe +nothing = Maybe (# (# #) | #) + +just :: Word8 -> Maybe +just (W8# w) = Maybe (# | w #) + +fromMaybe :: Word8 -> Maybe -> Word8 +fromMaybe a (Maybe m) = case m of + (# (# #) | #) -> a + (# | w #) -> W8# w + +maybe :: a -> (Word8 -> a) -> Maybe -> a +maybe a f (Maybe m) = case m of + (# (# #) | #) -> a + (# | w #) -> f (W8# w) + +toBaseMaybe :: Maybe -> P.Maybe Word8 +toBaseMaybe = maybe P.Nothing P.Just + +fromBaseMaybe :: P.Maybe Word8 -> Maybe +fromBaseMaybe = P.maybe nothing just + diff --git a/test/laws.hs b/test/laws.hs new file mode 100644 --- /dev/null +++ b/test/laws.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeApplications #-} + +import Test.QuickCheck.Arbitrary +import Test.QuickCheck.Gen +import Test.QuickCheck.Classes +import Data.Proxy (Proxy (Proxy)) +import GHC.Exts + +import qualified Data.Maybe.Unpacked.Numeric.Complex.Float as MComplexFloat +import qualified Data.Maybe.Unpacked.Numeric.Complex.Double as MComplexDouble + +import qualified Data.Maybe.Unpacked.Numeric.Float as MFloat +import qualified Data.Maybe.Unpacked.Numeric.Double as MDouble + +import qualified Data.Maybe.Unpacked.Numeric.Int as MInt +import qualified Data.Maybe.Unpacked.Numeric.Int8 as MInt8 +import qualified Data.Maybe.Unpacked.Numeric.Int16 as MInt16 +import qualified Data.Maybe.Unpacked.Numeric.Int32 as MInt32 +import qualified Data.Maybe.Unpacked.Numeric.Int64 as MInt64 + +import qualified Data.Maybe.Unpacked.Numeric.Word as MWord +import qualified Data.Maybe.Unpacked.Numeric.Word8 as MWord8 +import qualified Data.Maybe.Unpacked.Numeric.Word16 as MWord16 +import qualified Data.Maybe.Unpacked.Numeric.Word32 as MWord32 +import qualified Data.Maybe.Unpacked.Numeric.Word64 as MWord64 + +main :: IO () +main = lawsCheckMany allPropsApplied + +allLaws :: + ( Arbitrary a + , Eq a + , Ord a + , Show a + , Read a + ) => Proxy a -> [Laws] +allLaws p = map ($ p) + [ eqLaws, ordLaws, showReadLaws + ] + + +allPropsApplied :: [(String, [Laws])] +allPropsApplied = + [ ("Maybe (Complex Float)", map ($ (Proxy :: Proxy MComplexFloat.Maybe)) [eqLaws, showReadLaws]) + , ("Maybe (Complex Double)", map ($ (Proxy :: Proxy MComplexDouble.Maybe)) [eqLaws, showReadLaws]) + + , ("Maybe Float", allLaws (Proxy :: Proxy MFloat.Maybe)) + , ("Maybe Double", allLaws (Proxy :: Proxy MDouble.Maybe)) + , ("Maybe Int8", allLaws (Proxy :: Proxy MInt8.Maybe)) + , ("Maybe Int16", allLaws (Proxy :: Proxy MInt16.Maybe)) + , ("Maybe Int32", allLaws (Proxy :: Proxy MInt32.Maybe)) + , ("Maybe Int64", allLaws (Proxy :: Proxy MInt64.Maybe)) + , ("Maybe Int", allLaws (Proxy :: Proxy MInt.Maybe)) + , ("Maybe Word8", allLaws (Proxy :: Proxy MWord8.Maybe)) + , ("Maybe Word16", allLaws (Proxy :: Proxy MWord16.Maybe)) + , ("Maybe Word32", allLaws (Proxy :: Proxy MWord32.Maybe)) + , ("Maybe Word64", allLaws (Proxy :: Proxy MWord64.Maybe)) + , ("Maybe Word", allLaws (Proxy :: Proxy MWord.Maybe)) + ] + +unFloat :: Float -> Float# +unFloat (F# f#) = f# + +unDouble :: Double -> Double# +unDouble (D# d#) = d# + +instance Arbitrary MComplexFloat.Complex where + arbitrary = do + x <- arbitrary + y <- arbitrary + pure (MComplexFloat.Complex (unFloat x) (unFloat y)) + +instance Arbitrary MComplexDouble.Complex where + arbitrary = do + x <- arbitrary + y <- arbitrary + pure (MComplexDouble.Complex (unDouble x) (unDouble y)) + +instance Arbitrary MComplexFloat.Maybe where + arbitrary = frequency [(1,pure MComplexFloat.nothing), (1, MComplexFloat.just <$> arbitrary)] + +instance Arbitrary MComplexDouble.Maybe where + arbitrary = frequency [(1,pure MComplexDouble.nothing), (1, MComplexDouble.just <$> arbitrary)] + +instance Arbitrary MFloat.Maybe where + arbitrary = frequency [(1,pure MFloat.nothing), (1, MFloat.just <$> arbitrary)] + +instance Arbitrary MDouble.Maybe where + arbitrary = frequency [(1,pure MDouble.nothing), (1, MDouble.just <$> arbitrary)] + +instance Arbitrary MWord8.Maybe where + arbitrary = frequency [(1, pure MWord8.nothing), (1, MWord8.just <$> arbitrary)] + +instance Arbitrary MWord16.Maybe where + arbitrary = frequency [(1, pure MWord16.nothing), (1, MWord16.just <$> arbitrary)] + +instance Arbitrary MWord32.Maybe where + arbitrary = frequency [(1, pure MWord32.nothing), (1, MWord32.just <$> arbitrary)] + +instance Arbitrary MWord64.Maybe where + arbitrary = frequency [(1, pure MWord64.nothing), (1, MWord64.just <$> arbitrary)] + +instance Arbitrary MWord.Maybe where + arbitrary = frequency [(1, pure MWord.nothing), (1, MWord.just <$> arbitrary)] + +instance Arbitrary MInt8.Maybe where + arbitrary = frequency [(1, pure MInt8.nothing), (1, MInt8.just <$> arbitrary)] + +instance Arbitrary MInt16.Maybe where + arbitrary = frequency [(1, pure MInt16.nothing), (1, MInt16.just <$> arbitrary)] + +instance Arbitrary MInt32.Maybe where + arbitrary = frequency [(1, pure MInt32.nothing), (1, MInt32.just <$> arbitrary)] + +instance Arbitrary MInt64.Maybe where + arbitrary = frequency [(1, pure MInt64.nothing), (1, MInt64.just <$> arbitrary)] + +instance Arbitrary MInt.Maybe where + arbitrary = frequency [(1, pure MInt.nothing), (1, MInt.just <$> arbitrary)] diff --git a/unpacked-maybe-numeric.cabal b/unpacked-maybe-numeric.cabal new file mode 100644 --- /dev/null +++ b/unpacked-maybe-numeric.cabal @@ -0,0 +1,58 @@ +name: unpacked-maybe-numeric +version: 0.1.0.0 +synopsis: maybes of numeric values with fewer indirections +description: This library provides one `Maybe` type per the usual numeric types: + Float, Double, Complex {Float|Double}, Int{|8|16|32|64}, and Word{|8|16|32|64} + . + All of the numeric types inside the `Maybe` are unboxed, while the `Maybe` value + itself is represented as an Unboxed Sum (though for sub-machine-size Int/Word values, + the `Maybe` is just a wrapper around the underlying type, with out-of-bounds corresponding + to the 'Nothing' value. Thus, the usage of these constructors is unsafe, as this is only + checked internally). +homepage: https://github.com/andrewthad/unpacked-maybe-numeric#readme +bug-reports: https://github.com/andrewthad/unpacked-maybe-numeric/issues +author: Andrew Martin, chessai +maintainer: andrew.thaddeus@gmail.com, chessai1996@gmail.com +category: Data +copyright: 2018 Andrew Martin +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 +extra-source-files: README.md + +source-repository head + type: git + location: https://github.com/andrewthad/unpacked-maybe-numeric + +library + exposed-modules: + Data.Maybe.Unpacked.Numeric.Complex.Float + Data.Maybe.Unpacked.Numeric.Complex.Double + Data.Maybe.Unpacked.Numeric.Float + Data.Maybe.Unpacked.Numeric.Double + Data.Maybe.Unpacked.Numeric.Int + Data.Maybe.Unpacked.Numeric.Int8 + Data.Maybe.Unpacked.Numeric.Int16 + Data.Maybe.Unpacked.Numeric.Int32 + Data.Maybe.Unpacked.Numeric.Int64 + Data.Maybe.Unpacked.Numeric.Word + Data.Maybe.Unpacked.Numeric.Word8 + Data.Maybe.Unpacked.Numeric.Word16 + Data.Maybe.Unpacked.Numeric.Word32 + Data.Maybe.Unpacked.Numeric.Word64 + hs-source-dirs: + src + build-depends: + base >=4.10.1.0 && <5 + , primitive >= 0.6.4 + ghc-options: -Wall -O2 + default-language: Haskell2010 + +test-suite laws + default-language: Haskell2010 + ghc-options: -Wall + type: exitcode-stdio-1.0 + main-is: laws.hs + hs-source-dirs: test + build-depends: base, quickcheck-classes, unpacked-maybe-numeric, QuickCheck