{-# 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 -> Complex Double
toBaseComplex (Complex Double#
d1# Double#
d2#) = (Double# -> Double
D# Double#
d1#) forall a. a -> a -> Complex a
C.:+ (Double# -> Double
D# Double#
d2#)

fromBaseComplex :: C.Complex Double -> Complex
fromBaseComplex :: Complex Double -> Complex
fromBaseComplex ( (D# Double#
d1#) C.:+ (D# Double#
d2#) ) = Double# -> Double# -> Complex
Complex Double#
d1# Double#
d2#

instance Eq Complex where
  Complex Double#
a Double#
b == :: Complex -> Complex -> Bool
== Complex Double#
c Double#
d =
    case Double#
a Double# -> Double# -> Int#
==## Double#
c of
      Int#
1# -> case Double#
b Double# -> Double# -> Int#
==## Double#
d of
        Int#
1# -> Bool
True
        Int#
_   -> Bool
False
      Int#
_   -> Bool
False

instance Show Complex where
  showsPrec :: Int -> Complex -> ShowS
showsPrec Int
p (Complex Double#
a Double#
b)
    = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
>= Int
11)
        forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Complex "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (Double# -> Double
D# Double#
a)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (Double# -> Double
D# Double#
b)

instance Read Complex where
  readPrec :: ReadPrec Complex
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ do
    Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"Complex")
    (D# Double#
a) <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
    (D# Double#
b) <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
    forall (m :: * -> *) a. Monad m => a -> m a
return (Double# -> Double# -> Complex
Complex Double#
a Double#
b)

data Maybe = Maybe (# (# #) | Complex #)

instance Eq Maybe where
  Maybe
ma == :: Maybe -> Maybe -> Bool
== Maybe
mb =
    forall a. a -> (Complex -> a) -> Maybe -> a
maybe (Maybe -> Bool
isNothing Maybe
mb)
          (\Complex
a -> forall a. a -> (Complex -> a) -> Maybe -> a
maybe Bool
False (\Complex
b -> Complex
a forall a. Eq a => a -> a -> Bool
== Complex
b) Maybe
mb) Maybe
ma
    
instance Show Maybe where
  showsPrec :: Int -> Maybe -> ShowS
showsPrec Int
p (Maybe (# (# #) | Complex #)
m) = case (# (# #) | Complex #)
m of
    (# (# #) | #) -> String -> ShowS
showString String
"nothing"
    (# | Complex
c #) -> Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10)
      forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"just "
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Complex
c

instance Read Maybe where
  readPrec :: ReadPrec Maybe
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ ReadPrec Maybe
nothingP forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ ReadPrec Maybe
justP
    where
      nothingP :: ReadPrec Maybe
nothingP = do
        Ident String
"nothing" <- ReadPrec Lexeme
lexP
        forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
nothing
      justP :: ReadPrec Maybe
justP = forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ do
        Ident String
"just" <- ReadPrec Lexeme
lexP
        Complex
a <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
        forall (m :: * -> *) a. Monad m => a -> m a
return (Complex -> Maybe
just Complex
a)

listToMaybe :: [Complex] -> Maybe
listToMaybe :: [Complex] -> Maybe
listToMaybe [] = Maybe
nothing
listToMaybe (Complex
x:[Complex]
_) = Complex -> Maybe
just Complex
x

maybeToList :: Maybe -> [Complex]
maybeToList :: Maybe -> [Complex]
maybeToList = forall a. a -> (Complex -> a) -> Maybe -> a
maybe [] (forall a. a -> [a] -> [a]
: [])

catMaybes :: [Maybe] -> [Complex]
catMaybes :: [Maybe] -> [Complex]
catMaybes = forall a. (a -> Maybe) -> [a] -> [Complex]
mapMaybe forall a. a -> a
id

mapMaybe :: (a -> Maybe) -> [a] -> [Complex]
mapMaybe :: forall a. (a -> Maybe) -> [a] -> [Complex]
mapMaybe a -> Maybe
_ [] = []
mapMaybe a -> Maybe
f (a
a : [a]
as) =
  let ws :: [Complex]
ws = forall a. (a -> Maybe) -> [a] -> [Complex]
mapMaybe a -> Maybe
f [a]
as
  in forall a. a -> (Complex -> a) -> Maybe -> a
maybe [Complex]
ws (forall a. a -> [a] -> [a]
: [Complex]
ws) (a -> Maybe
f a
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 :: forall r a. (Complex -> r -> r) -> (a -> Maybe) -> a -> r -> r
mapMaybeFB Complex -> r -> r
cons a -> Maybe
f a
x r
next = forall a. a -> (Complex -> a) -> Maybe -> a
maybe r
next (forall a b c. (a -> b -> c) -> b -> a -> c
flip Complex -> r -> r
cons r
next) (a -> Maybe
f a
x)

isNothing :: Maybe -> Bool
isNothing :: Maybe -> Bool
isNothing = forall a. a -> (Complex -> a) -> Maybe -> a
maybe Bool
True (forall a b. a -> b -> a
const Bool
False)

isJust :: Maybe -> Bool
isJust :: Maybe -> Bool
isJust = forall a. a -> (Complex -> a) -> Maybe -> a
maybe Bool
False (forall a b. a -> b -> a
const Bool
True)

nothing :: Maybe
nothing :: Maybe
nothing = (# (# #) | Complex #) -> Maybe
Maybe (# (# #) | #)

just :: Complex -> Maybe
just :: Complex -> Maybe
just Complex
c = (# (# #) | Complex #) -> Maybe
Maybe (# | Complex
c #)

fromMaybe :: Complex -> Maybe -> Complex
fromMaybe :: Complex -> Maybe -> Complex
fromMaybe Complex
a (Maybe (# (# #) | Complex #)
m) = case (# (# #) | Complex #)
m of
  (# (# #) | #) -> Complex
a
  (# | Complex
c #) -> Complex
c

maybe :: a -> (Complex -> a) -> Maybe -> a
maybe :: forall a. a -> (Complex -> a) -> Maybe -> a
maybe a
a Complex -> a
f (Maybe (# (# #) | Complex #)
m) = case (# (# #) | Complex #)
m of
  (# (# #) | #) -> a
a
  (# | Complex
c #) -> Complex -> a
f Complex
c

toBaseMaybe :: Maybe -> P.Maybe Complex
toBaseMaybe :: Maybe -> Maybe Complex
toBaseMaybe = forall a. a -> (Complex -> a) -> Maybe -> a
maybe forall a. Maybe a
P.Nothing forall a. a -> Maybe a
P.Just

fromBaseMaybe :: P.Maybe Complex -> Maybe
fromBaseMaybe :: Maybe Complex -> Maybe
fromBaseMaybe = forall b a. b -> (a -> b) -> Maybe a -> b
P.maybe Maybe
nothing Complex -> Maybe
just