{-# LANGUAGE TemplateHaskell, GADTs #-}
{-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-missing-signatures #-}
module Data.Random.Source.Internal.TH (monadRandom, randomSource) where

import Data.Bits
import Data.Generics
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Random.Internal.Source (Prim(..), MonadRandom(..), RandomSource(..))
import Data.Random.Internal.Words
import Language.Haskell.TH
import Language.Haskell.TH.Extras
import qualified Language.Haskell.TH.FlexibleDefaults as FD

import Control.Monad.Reader

data Method
    = GetPrim
    | GetWord8
    | GetWord16
    | GetWord32
    | GetWord64
    | GetDouble
    | GetNByteInteger
    deriving (Method -> Method -> Bool
(Method -> Method -> Bool)
-> (Method -> Method -> Bool) -> Eq Method
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Method -> Method -> Bool
$c/= :: Method -> Method -> Bool
== :: Method -> Method -> Bool
$c== :: Method -> Method -> Bool
Eq, Eq Method
Eq Method =>
(Method -> Method -> Ordering)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Method)
-> (Method -> Method -> Method)
-> Ord Method
Method -> Method -> Bool
Method -> Method -> Ordering
Method -> Method -> Method
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Method -> Method -> Method
$cmin :: Method -> Method -> Method
max :: Method -> Method -> Method
$cmax :: Method -> Method -> Method
>= :: Method -> Method -> Bool
$c>= :: Method -> Method -> Bool
> :: Method -> Method -> Bool
$c> :: Method -> Method -> Bool
<= :: Method -> Method -> Bool
$c<= :: Method -> Method -> Bool
< :: Method -> Method -> Bool
$c< :: Method -> Method -> Bool
compare :: Method -> Method -> Ordering
$ccompare :: Method -> Method -> Ordering
$cp1Ord :: Eq Method
Ord, Int -> Method
Method -> Int
Method -> [Method]
Method -> Method
Method -> Method -> [Method]
Method -> Method -> Method -> [Method]
(Method -> Method)
-> (Method -> Method)
-> (Int -> Method)
-> (Method -> Int)
-> (Method -> [Method])
-> (Method -> Method -> [Method])
-> (Method -> Method -> [Method])
-> (Method -> Method -> Method -> [Method])
-> Enum Method
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Method -> Method -> Method -> [Method]
$cenumFromThenTo :: Method -> Method -> Method -> [Method]
enumFromTo :: Method -> Method -> [Method]
$cenumFromTo :: Method -> Method -> [Method]
enumFromThen :: Method -> Method -> [Method]
$cenumFromThen :: Method -> Method -> [Method]
enumFrom :: Method -> [Method]
$cenumFrom :: Method -> [Method]
fromEnum :: Method -> Int
$cfromEnum :: Method -> Int
toEnum :: Int -> Method
$ctoEnum :: Int -> Method
pred :: Method -> Method
$cpred :: Method -> Method
succ :: Method -> Method
$csucc :: Method -> Method
Enum, Method
Method -> Method -> Bounded Method
forall a. a -> a -> Bounded a
maxBound :: Method
$cmaxBound :: Method
minBound :: Method
$cminBound :: Method
Bounded, ReadPrec [Method]
ReadPrec Method
Int -> ReadS Method
ReadS [Method]
(Int -> ReadS Method)
-> ReadS [Method]
-> ReadPrec Method
-> ReadPrec [Method]
-> Read Method
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Method]
$creadListPrec :: ReadPrec [Method]
readPrec :: ReadPrec Method
$creadPrec :: ReadPrec Method
readList :: ReadS [Method]
$creadList :: ReadS [Method]
readsPrec :: Int -> ReadS Method
$creadsPrec :: Int -> ReadS Method
Read, Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Method] -> ShowS
$cshowList :: [Method] -> ShowS
show :: Method -> String
$cshow :: Method -> String
showsPrec :: Int -> Method -> ShowS
$cshowsPrec :: Int -> Method -> ShowS
Show)

allMethods :: [Method]
allMethods :: [Method]
allMethods = [Method
forall a. Bounded a => a
minBound .. Method
forall a. Bounded a => a
maxBound]

data Context
    = Generic
    | RandomSource
    | MonadRandom
    deriving (Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq, Eq Context
Eq Context =>
(Context -> Context -> Ordering)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Context)
-> (Context -> Context -> Context)
-> Ord Context
Context -> Context -> Bool
Context -> Context -> Ordering
Context -> Context -> Context
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Context -> Context -> Context
$cmin :: Context -> Context -> Context
max :: Context -> Context -> Context
$cmax :: Context -> Context -> Context
>= :: Context -> Context -> Bool
$c>= :: Context -> Context -> Bool
> :: Context -> Context -> Bool
$c> :: Context -> Context -> Bool
<= :: Context -> Context -> Bool
$c<= :: Context -> Context -> Bool
< :: Context -> Context -> Bool
$c< :: Context -> Context -> Bool
compare :: Context -> Context -> Ordering
$ccompare :: Context -> Context -> Ordering
$cp1Ord :: Eq Context
Ord, Int -> Context
Context -> Int
Context -> [Context]
Context -> Context
Context -> Context -> [Context]
Context -> Context -> Context -> [Context]
(Context -> Context)
-> (Context -> Context)
-> (Int -> Context)
-> (Context -> Int)
-> (Context -> [Context])
-> (Context -> Context -> [Context])
-> (Context -> Context -> [Context])
-> (Context -> Context -> Context -> [Context])
-> Enum Context
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Context -> Context -> Context -> [Context]
$cenumFromThenTo :: Context -> Context -> Context -> [Context]
enumFromTo :: Context -> Context -> [Context]
$cenumFromTo :: Context -> Context -> [Context]
enumFromThen :: Context -> Context -> [Context]
$cenumFromThen :: Context -> Context -> [Context]
enumFrom :: Context -> [Context]
$cenumFrom :: Context -> [Context]
fromEnum :: Context -> Int
$cfromEnum :: Context -> Int
toEnum :: Int -> Context
$ctoEnum :: Int -> Context
pred :: Context -> Context
$cpred :: Context -> Context
succ :: Context -> Context
$csucc :: Context -> Context
Enum, Context
Context -> Context -> Bounded Context
forall a. a -> a -> Bounded a
maxBound :: Context
$cmaxBound :: Context
minBound :: Context
$cminBound :: Context
Bounded, ReadPrec [Context]
ReadPrec Context
Int -> ReadS Context
ReadS [Context]
(Int -> ReadS Context)
-> ReadS [Context]
-> ReadPrec Context
-> ReadPrec [Context]
-> Read Context
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Context]
$creadListPrec :: ReadPrec [Context]
readPrec :: ReadPrec Context
$creadPrec :: ReadPrec Context
readList :: ReadS [Context]
$creadList :: ReadS [Context]
readsPrec :: Int -> ReadS Context
$creadsPrec :: Int -> ReadS Context
Read, Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show)

methodNameBase :: Context -> Method -> String
methodNameBase :: Context -> Method -> String
methodNameBase c :: Context
c n :: Method
n = Name -> String
nameBase (Context -> Method -> Name
methodName Context
c Method
n)

methodName :: Context -> Method -> Name
methodName :: Context -> Method -> Name
methodName Generic      GetPrim          = String -> Name
mkName "getPrim"
methodName Generic      GetWord8         = String -> Name
mkName "getWord8"
methodName Generic      GetWord16        = String -> Name
mkName "getWord16"
methodName Generic      GetWord32        = String -> Name
mkName "getWord32"
methodName Generic      GetWord64        = String -> Name
mkName "getWord64"
methodName Generic      GetDouble        = String -> Name
mkName "getDouble"
methodName Generic      GetNByteInteger  = String -> Name
mkName "getNByteInteger"
methodName RandomSource GetPrim          = 'getRandomPrimFrom
methodName RandomSource GetWord8         = 'getRandomWord8From
methodName RandomSource GetWord16        = 'getRandomWord16From
methodName RandomSource GetWord32        = 'getRandomWord32From
methodName RandomSource GetWord64        = 'getRandomWord64From
methodName RandomSource GetDouble        = 'getRandomDoubleFrom
methodName RandomSource GetNByteInteger  = 'getRandomNByteIntegerFrom
methodName MonadRandom  GetPrim          = 'getRandomPrim
methodName MonadRandom  GetWord8         = 'getRandomWord8
methodName MonadRandom  GetWord16        = 'getRandomWord16
methodName MonadRandom  GetWord32        = 'getRandomWord32
methodName MonadRandom  GetWord64        = 'getRandomWord64
methodName MonadRandom  GetDouble        = 'getRandomDouble
methodName MonadRandom  GetNByteInteger  = 'getRandomNByteInteger

isMethodName :: Context -> Name -> Bool
isMethodName :: Context -> Name -> Bool
isMethodName c :: Context
c n :: Name
n = Maybe Method -> Bool
forall a. Maybe a -> Bool
isJust (Context -> Name -> Maybe Method
nameToMethod Context
c Name
n)

nameToMethod :: Context -> Name -> Maybe Method
nameToMethod :: Context -> Name -> Maybe Method
nameToMethod c :: Context
c name :: Name
name
    = Name -> [(Name, Method)] -> Maybe Method
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
name
        [ (Name
n, Method
m) 
        | Method
m <- [Method]
allMethods
        , let n :: Name
n = Context -> Method -> Name
methodName Context
c Method
m
        ]


-- 'Context'-sensitive version of the FlexibleDefaults DSL
scoreBy :: (a -> b) -> ReaderT Context (FD.Defaults a) t -> ReaderT Context (FD.Defaults b) t
scoreBy :: (a -> b)
-> ReaderT Context (Defaults a) t -> ReaderT Context (Defaults b) t
scoreBy f :: a -> b
f = (Defaults a t -> Defaults b t)
-> ReaderT Context (Defaults a) t -> ReaderT Context (Defaults b) t
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((a -> b) -> Defaults a t -> Defaults b t
forall a b t. (a -> b) -> Defaults a t -> Defaults b t
FD.scoreBy a -> b
f)

method :: Method -> ReaderT Context (FD.Function s) t -> ReaderT Context (FD.Defaults s) t
method :: Method
-> ReaderT Context (Function s) t -> ReaderT Context (Defaults s) t
method m :: Method
m f :: ReaderT Context (Function s) t
f = do
    Context
c <- ReaderT Context (Defaults s) Context
forall r (m :: * -> *). MonadReader r m => m r
ask
    (Function s t -> Defaults s t)
-> ReaderT Context (Function s) t -> ReaderT Context (Defaults s) t
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (String -> Function s t -> Defaults s t
forall s a. String -> Function s a -> Defaults s a
FD.function (Context -> Method -> String
methodNameBase Context
c Method
m)) ReaderT Context (Function s) t
f

implementation :: ReaderT Context (FD.Implementation s) (Q [Dec]) -> ReaderT Context (FD.Function s) ()
implementation :: ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation = (Implementation s (Q [Dec]) -> Function s ())
-> ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT Implementation s (Q [Dec]) -> Function s ()
forall s. Implementation s (Q [Dec]) -> Function s ()
FD.implementation

cost :: Num s => s -> ReaderT Context (FD.Implementation s) ()
cost :: s -> ReaderT Context (Implementation s) ()
cost = Implementation s () -> ReaderT Context (Implementation s) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Implementation s () -> ReaderT Context (Implementation s) ())
-> (s -> Implementation s ())
-> s
-> ReaderT Context (Implementation s) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Implementation s ()
forall s. Num s => s -> Implementation s ()
FD.cost

dependsOn :: Method -> ReaderT Context (FD.Implementation s) ()
dependsOn :: Method -> ReaderT Context (Implementation s) ()
dependsOn m :: Method
m = do
    Context
c <- ReaderT Context (Implementation s) Context
forall r (m :: * -> *). MonadReader r m => m r
ask
    Implementation s () -> ReaderT Context (Implementation s) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> Implementation s ()
forall s. String -> Implementation s ()
FD.dependsOn (Context -> Method -> String
methodNameBase Context
c Method
m))

changeContext :: Context -> Context -> Name -> Name
changeContext :: Context -> Context -> Name -> Name
changeContext c1 :: Context
c1 c2 :: Context
c2 = (Name -> Maybe Name) -> Name -> Name
forall a. (a -> Maybe a) -> a -> a
replace ((Method -> Name) -> Maybe Method -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Context -> Method -> Name
methodName Context
c2) (Maybe Method -> Maybe Name)
-> (Name -> Maybe Method) -> Name -> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Name -> Maybe Method
nameToMethod Context
c1)

-- map all occurrences of generic method names to the proper local ones
-- and introduce a 'src' parameter where needed if the Context is RandomSource
specialize :: Monad m => Q [Dec] -> ReaderT Context m (Q [Dec])
specialize :: Q [Dec] -> ReaderT Context m (Q [Dec])
specialize futzedDecsQ :: Q [Dec]
futzedDecsQ = do
    let decQ :: Q [Dec]
decQ = ([Dec] -> [Dec]) -> Q [Dec] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Dec] -> [Dec]
genericalizeDecs Q [Dec]
futzedDecsQ
    Context
c <- ReaderT Context m Context
forall r (m :: * -> *). MonadReader r m => m r
ask
    let specializeDec :: [Dec] -> [Dec]
specializeDec = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((Name -> Name) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT (Context -> Context -> Name -> Name
changeContext Context
Generic Context
c))
    if Context
c Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
RandomSource
        then Q [Dec] -> ReaderT Context m (Q [Dec])
forall (m :: * -> *) a. Monad m => a -> m a
return (Q [Dec] -> ReaderT Context m (Q [Dec]))
-> Q [Dec] -> ReaderT Context m (Q [Dec])
forall a b. (a -> b) -> a -> b
$ do
                Name
src <- String -> Q Name
newName "_src"
                [Dec]
decs <- Q [Dec]
decQ
                [Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return ((Dec -> Dec) -> [Dec] -> [Dec]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Dec -> Dec
addSrcParam Name
src) ([Dec] -> [Dec]) -> ([Dec] -> [Dec]) -> [Dec] -> [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Dec] -> [Dec]
specializeDec ([Dec] -> [Dec]) -> [Dec] -> [Dec]
forall a b. (a -> b) -> a -> b
$ [Dec]
decs)
        else Q [Dec] -> ReaderT Context m (Q [Dec])
forall (m :: * -> *) a. Monad m => a -> m a
return (([Dec] -> [Dec]) -> Q [Dec] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Dec] -> [Dec]
specializeDec Q [Dec]
decQ)

stripTypeSigs :: Q [Dec] -> Q [Dec]
stripTypeSigs :: Q [Dec] -> Q [Dec]
stripTypeSigs = ([Dec] -> [Dec]) -> Q [Dec] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Dec -> Bool) -> [Dec] -> [Dec]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Dec -> Bool) -> Dec -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dec -> Bool
isSig))
    where isSig :: Dec -> Bool
isSig SigD{} = Bool
True; isSig _ = Bool
False

addSrcParam :: Name -> Dec -> Dec
addSrcParam :: Name -> Dec -> Dec
addSrcParam src :: Name
src
    = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((Dec -> Dec) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT Dec -> Dec
expandDecs) 
    (Dec -> Dec) -> (Dec -> Dec) -> Dec -> Dec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((Exp -> Exp) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT Exp -> Exp
expandExps)
    where
        srcP :: Pat
srcP = Name -> Pat
VarP Name
src
        srcE :: Exp
srcE = Name -> Exp
VarE Name
src
        
        expandDecs :: Dec -> Dec
expandDecs (ValD (VarP n :: Name
n) body :: Body
body decs :: [Dec]
decs)
            | Context -> Name -> Bool
isMethodName Context
RandomSource Name
n
            = Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [Pat
srcP] Body
body [Dec]
decs]
        expandDecs (FunD n :: Name
n clauses :: [Clause]
clauses)
            | Context -> Name -> Bool
isMethodName Context
RandomSource Name
n
            = Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause (Pat
srcP Pat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
: [Pat]
ps) Body
body [Dec]
decs | Clause ps :: [Pat]
ps body :: Body
body decs :: [Dec]
decs <- [Clause]
clauses]
        
        expandDecs other :: Dec
other = Dec
other
        
        expandExps :: Exp -> Exp
expandExps e :: Exp
e@(VarE n :: Name
n)
            | Context -> Name -> Bool
isMethodName Context
RandomSource Name
n   = Exp -> Exp -> Exp
AppE Exp
e Exp
srcE
        expandExps other :: Exp
other = Exp
other

-- dummy expressions which will be remapped by 'specialize'
dummy :: Method -> ExpQ
dummy :: Method -> ExpQ
dummy = Exp -> ExpQ
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> ExpQ) -> (Method -> Exp) -> Method -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Exp
VarE (Name -> Exp) -> (Method -> Name) -> Method -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Method -> Name
methodName Context
Generic

getPrim, getWord8, getWord16, 
    getWord32, getWord64, getDouble, 
    getNByteInteger :: ExpQ
getPrim :: ExpQ
getPrim             = Method -> ExpQ
dummy Method
GetPrim
getWord8 :: ExpQ
getWord8            = Method -> ExpQ
dummy Method
GetWord8
getWord16 :: ExpQ
getWord16           = Method -> ExpQ
dummy Method
GetWord16
getWord32 :: ExpQ
getWord32           = Method -> ExpQ
dummy Method
GetWord32
getWord64 :: ExpQ
getWord64           = Method -> ExpQ
dummy Method
GetWord64
getDouble :: ExpQ
getDouble           = Method -> ExpQ
dummy Method
GetDouble
getNByteInteger :: ExpQ
getNByteInteger     = Method -> ExpQ
dummy Method
GetNByteInteger

-- The defaulting rules for RandomSource and MonadRandom.  Costs are rates of
-- entropy waste (bits discarded per bit requested) plus the occasional ad-hoc
-- penalty where it seems appropriate.

-- TODO: figure out a clean way to break these up for individual testing.
-- Also analyze to see which of these can never be selected (I suspect that set is non-empty)
defaults :: Context -> FD.Defaults (Sum Double) ()
defaults :: Context -> Defaults (Sum Double) ()
defaults = ReaderT Context (Defaults (Sum Double)) ()
-> Context -> Defaults (Sum Double) ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT Context (Defaults (Sum Double)) ()
 -> Context -> Defaults (Sum Double) ())
-> ReaderT Context (Defaults (Sum Double)) ()
-> Context
-> Defaults (Sum Double) ()
forall a b. (a -> b) -> a -> b
$
    (Double -> Sum Double)
-> ReaderT Context (Defaults Double) ()
-> ReaderT Context (Defaults (Sum Double)) ()
forall a b t.
(a -> b)
-> ReaderT Context (Defaults a) t -> ReaderT Context (Defaults b) t
scoreBy Double -> Sum Double
forall a. a -> Sum a
Sum (ReaderT Context (Defaults Double) ()
 -> ReaderT Context (Defaults (Sum Double)) ())
-> ReaderT Context (Defaults Double) ()
-> ReaderT Context (Defaults (Sum Double)) ()
forall a b. (a -> b) -> a -> b
$ do
        Method
-> ReaderT Context (Function Double) ()
-> ReaderT Context (Defaults Double) ()
forall s t.
Method
-> ReaderT Context (Function s) t -> ReaderT Context (Defaults s) t
method Method
GetPrim (ReaderT Context (Function Double) ()
 -> ReaderT Context (Defaults Double) ())
-> ReaderT Context (Function Double) ()
-> ReaderT Context (Defaults Double) ()
forall a b. (a -> b) -> a -> b
$ do
            ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                (Method -> ReaderT Context (Implementation Double) ())
-> [Method] -> ReaderT Context (Implementation Double) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn ([Method]
allMethods [Method] -> [Method] -> [Method]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Method
GetPrim])
                
                -- GHC 6 requires type signatures for GADT matches, even
                -- inside [d||].  This code is evaluated at more than one type, though,
                -- and at its eventual splice site the signature actually isn't even allowed.
                -- So, there's a dummy signature here which is immediately stripped out.
                Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize (Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec]))
-> (Q [Dec] -> Q [Dec])
-> Q [Dec]
-> ReaderT Context (Implementation Double) (Q [Dec])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q [Dec] -> Q [Dec]
stripTypeSigs (Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec]))
-> Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall a b. (a -> b) -> a -> b
$
                    [d| getPrim :: Prim a -> m a
                        getPrim PrimWord8               = $getWord8
                        getPrim PrimWord16              = $getWord16
                        getPrim PrimWord32              = $getWord32
                        getPrim PrimWord64              = $getWord64
                        getPrim PrimDouble              = $getDouble
                        getPrim (PrimNByteInteger n)    = $getNByteInteger n
                     |]
        
        (Double -> Double)
-> ReaderT Context (Defaults Double) ()
-> ReaderT Context (Defaults Double) ()
forall a b t.
(a -> b)
-> ReaderT Context (Defaults a) t -> ReaderT Context (Defaults b) t
scoreBy (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/8) (ReaderT Context (Defaults Double) ()
 -> ReaderT Context (Defaults Double) ())
-> ReaderT Context (Defaults Double) ()
-> ReaderT Context (Defaults Double) ()
forall a b. (a -> b) -> a -> b
$
            Method
-> ReaderT Context (Function Double) ()
-> ReaderT Context (Defaults Double) ()
forall s t.
Method
-> ReaderT Context (Function s) t -> ReaderT Context (Defaults s) t
method Method
GetWord8 (ReaderT Context (Function Double) ()
 -> ReaderT Context (Defaults Double) ())
-> ReaderT Context (Function Double) ()
-> ReaderT Context (Defaults Double) ()
forall a b. (a -> b) -> a -> b
$ do
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetPrim
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getWord8 = $getPrim PrimWord8 |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 1
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetNByteInteger
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getWord8 = liftM fromInteger ($getNByteInteger 1) |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 8
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord16
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getWord8 = liftM fromIntegral $getWord16 |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 24
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord32
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getWord8 = liftM fromIntegral $getWord32 |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 56
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord64
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getWord8 = liftM fromIntegral $getWord64 |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 64
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetDouble
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getWord8 = liftM (truncate . (256*)) $getDouble |]
                
        (Double -> Double)
-> ReaderT Context (Defaults Double) ()
-> ReaderT Context (Defaults Double) ()
forall a b t.
(a -> b)
-> ReaderT Context (Defaults a) t -> ReaderT Context (Defaults b) t
scoreBy (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/16) (ReaderT Context (Defaults Double) ()
 -> ReaderT Context (Defaults Double) ())
-> ReaderT Context (Defaults Double) ()
-> ReaderT Context (Defaults Double) ()
forall a b. (a -> b) -> a -> b
$
            Method
-> ReaderT Context (Function Double) ()
-> ReaderT Context (Defaults Double) ()
forall s t.
Method
-> ReaderT Context (Function s) t -> ReaderT Context (Defaults s) t
method Method
GetWord16 (ReaderT Context (Function Double) ()
 -> ReaderT Context (Defaults Double) ())
-> ReaderT Context (Function Double) ()
-> ReaderT Context (Defaults Double) ()
forall a b. (a -> b) -> a -> b
$ do
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetPrim
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getWord16 = $getPrim PrimWord16 |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 1
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetNByteInteger
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getWord16 = liftM fromInteger ($getNByteInteger 2) |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord8
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize 
                        [d|
                            getWord16 = do
                                a <- $getWord8
                                b <- $getWord8
                                return (buildWord16 a b)
                         |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 16
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord32
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getWord16 = liftM fromIntegral $getWord32 |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 48
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord64
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getWord16 = liftM fromIntegral $getWord64 |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 64
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetDouble
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getWord16 = liftM (truncate . (65536*)) $getDouble |]
        
        (Double -> Double)
-> ReaderT Context (Defaults Double) ()
-> ReaderT Context (Defaults Double) ()
forall a b t.
(a -> b)
-> ReaderT Context (Defaults a) t -> ReaderT Context (Defaults b) t
scoreBy (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/32) (ReaderT Context (Defaults Double) ()
 -> ReaderT Context (Defaults Double) ())
-> ReaderT Context (Defaults Double) ()
-> ReaderT Context (Defaults Double) ()
forall a b. (a -> b) -> a -> b
$
            Method
-> ReaderT Context (Function Double) ()
-> ReaderT Context (Defaults Double) ()
forall s t.
Method
-> ReaderT Context (Function s) t -> ReaderT Context (Defaults s) t
method Method
GetWord32 (ReaderT Context (Function Double) ()
 -> ReaderT Context (Defaults Double) ())
-> ReaderT Context (Function Double) ()
-> ReaderT Context (Defaults Double) ()
forall a b. (a -> b) -> a -> b
$ do
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetPrim
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getWord32 = $getPrim PrimWord32 |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 1
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetNByteInteger
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getWord32 = liftM fromInteger ($getNByteInteger 4) |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 0.1
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord8
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize 
                        [d|
                            getWord32 = do
                                a <- $getWord8
                                b <- $getWord8
                                c <- $getWord8
                                d <- $getWord8
                                return (buildWord32 a b c d)
                         |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord16
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize 
                        [d|
                            getWord32 = do
                                a <- $getWord16
                                b <- $getWord16
                                return (buildWord32' a b)
                         |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 32
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord64
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getWord32 = liftM fromIntegral $getWord64 |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 64
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetDouble
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getWord32 = liftM (truncate . (4294967296*)) $getDouble |]
        
        (Double -> Double)
-> ReaderT Context (Defaults Double) ()
-> ReaderT Context (Defaults Double) ()
forall a b t.
(a -> b)
-> ReaderT Context (Defaults a) t -> ReaderT Context (Defaults b) t
scoreBy (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/64) (ReaderT Context (Defaults Double) ()
 -> ReaderT Context (Defaults Double) ())
-> ReaderT Context (Defaults Double) ()
-> ReaderT Context (Defaults Double) ()
forall a b. (a -> b) -> a -> b
$
            Method
-> ReaderT Context (Function Double) ()
-> ReaderT Context (Defaults Double) ()
forall s t.
Method
-> ReaderT Context (Function s) t -> ReaderT Context (Defaults s) t
method Method
GetWord64 (ReaderT Context (Function Double) ()
 -> ReaderT Context (Defaults Double) ())
-> ReaderT Context (Function Double) ()
-> ReaderT Context (Defaults Double) ()
forall a b. (a -> b) -> a -> b
$ do
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetPrim
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getWord64 = $getPrim PrimWord64 |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 1
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetNByteInteger
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getWord64 = liftM fromInteger ($getNByteInteger 8) |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 0.2
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord8
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize 
                        [d|
                            getWord64 = do
                                a <- $getWord8
                                b <- $getWord8
                                c <- $getWord8
                                d <- $getWord8
                                e <- $getWord8
                                f <- $getWord8
                                g <- $getWord8
                                h <- $getWord8
                                return (buildWord64 a b c d e f g h)
                         |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 0.1
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord16
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize 
                        [d|
                            getWord64 = do
                                a <- $getWord16
                                b <- $getWord16
                                c <- $getWord16
                                d <- $getWord16
                                return (buildWord64' a b c d)
                         |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord32
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize 
                        [d|
                            getWord64 = do
                                a <- $getWord32
                                b <- $getWord32
                                return (buildWord64'' a b)
                         |]
        
        (Double -> Double)
-> ReaderT Context (Defaults Double) ()
-> ReaderT Context (Defaults Double) ()
forall a b t.
(a -> b)
-> ReaderT Context (Defaults a) t -> ReaderT Context (Defaults b) t
scoreBy (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/52) (ReaderT Context (Defaults Double) ()
 -> ReaderT Context (Defaults Double) ())
-> ReaderT Context (Defaults Double) ()
-> ReaderT Context (Defaults Double) ()
forall a b. (a -> b) -> a -> b
$
            Method
-> ReaderT Context (Function Double) ()
-> ReaderT Context (Defaults Double) ()
forall s t.
Method
-> ReaderT Context (Function s) t -> ReaderT Context (Defaults s) t
method Method
GetDouble (ReaderT Context (Function Double) ()
 -> ReaderT Context (Defaults Double) ())
-> ReaderT Context (Function Double) ()
-> ReaderT Context (Defaults Double) ()
forall a b. (a -> b) -> a -> b
$ do
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetPrim
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getDouble = $getPrim PrimDouble |]
                
                ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                    Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 12
                    Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord64
                    Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize 
                        [d|
                            getDouble = do
                                w <- $getWord64
                                return (wordToDouble w)
                         |]
        
        Method
-> ReaderT Context (Function Double) ()
-> ReaderT Context (Defaults Double) ()
forall s t.
Method
-> ReaderT Context (Function s) t -> ReaderT Context (Defaults s) t
method Method
GetNByteInteger (ReaderT Context (Function Double) ()
 -> ReaderT Context (Defaults Double) ())
-> ReaderT Context (Function Double) ()
-> ReaderT Context (Defaults Double) ()
forall a b. (a -> b) -> a -> b
$ do
            ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetPrim
                Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize [d| getNByteInteger n = $getPrim (PrimNByteInteger n) |]
            
            ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                Bool
-> ReaderT Context (Implementation Double) ()
-> ReaderT Context (Implementation Double) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
intIs64 (Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 1e-2)
                Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord8
                Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord16
                Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord32
                Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize
                    [d|
                        getNByteInteger 1 = do
                            x <- $getWord8
                            return $! toInteger x
                        getNByteInteger 2 = do
                            x <- $getWord16
                            return $! toInteger x
                        getNByteInteger 4 = do
                            x <- $getWord32
                            return $! toInteger x
                        getNByteInteger np4
                            | np4 > 4 = do
                                let n = np4 - 4
                                x <- $getWord32
                                y <- $(dummy GetNByteInteger) n
                                return $! (toInteger x `shiftL` (n `shiftL` 3)) .|. y
                        getNByteInteger np2
                            | np2 > 2 = do
                                let n = np2 - 2
                                x <- $getWord16
                                y <- $(dummy GetNByteInteger) n
                                return $! (toInteger x `shiftL` (n `shiftL` 3)) .|. y
                        getNByteInteger _ = return 0
                      |]
                    
            ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall s.
ReaderT Context (Implementation s) (Q [Dec])
-> ReaderT Context (Function s) ()
implementation (ReaderT Context (Implementation Double) (Q [Dec])
 -> ReaderT Context (Function Double) ())
-> ReaderT Context (Implementation Double) (Q [Dec])
-> ReaderT Context (Function Double) ()
forall a b. (a -> b) -> a -> b
$ do
                Bool
-> ReaderT Context (Implementation Double) ()
-> ReaderT Context (Implementation Double) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
intIs64) (Double -> ReaderT Context (Implementation Double) ()
forall s. Num s => s -> ReaderT Context (Implementation s) ()
cost 1e-2)
                Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord8
                Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord16
                Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord32
                Method -> ReaderT Context (Implementation Double) ()
forall s. Method -> ReaderT Context (Implementation s) ()
dependsOn Method
GetWord64
                Q [Dec] -> ReaderT Context (Implementation Double) (Q [Dec])
forall (m :: * -> *).
Monad m =>
Q [Dec] -> ReaderT Context m (Q [Dec])
specialize
                    [d|
                        getNByteInteger 1 = do
                            x <- $getWord8
                            return $! toInteger x
                        getNByteInteger 2 = do
                            x <- $getWord16
                            return $! toInteger x
                        getNByteInteger 4 = do
                            x <- $getWord32
                            return $! toInteger x
                        getNByteInteger 8 = do
                            x <- $getWord64
                            return $! toInteger x
                        getNByteInteger np8
                            | np8 > 8 = do
                                let n = np8 - 8
                                x <- $getWord64
                                y <- $(dummy GetNByteInteger) n
                                return $! (toInteger x `shiftL` (n `shiftL` 3)) .|. y
                        getNByteInteger np4
                            | np4 > 4 = do
                                let n = np4 - 4
                                x <- $getWord32
                                y <- $(dummy GetNByteInteger) n
                                return $! (toInteger x `shiftL` (n `shiftL` 3)) .|. y
                        getNByteInteger np2
                            | np2 > 2 = do
                                let n = np2 - 2
                                x <- $getWord16
                                y <- $(dummy GetNByteInteger) n
                                return $! (toInteger x `shiftL` (n `shiftL` 3)) .|. y
                        getNByteInteger _ = return 0
                      |]
                    

-- |Complete a possibly-incomplete 'RandomSource' implementation.  It is 
-- recommended that this macro be used even if the implementation is currently
-- complete, as the 'RandomSource' class may be extended at any time.
--
-- To use 'randomSource', just wrap your instance declaration as follows (and
-- enable the TemplateHaskell, MultiParamTypeClasses and GADTs language
-- extensions, as well as any others required by your instances, such as
-- FlexibleInstances):
--
-- > $(randomSource [d|
-- >         instance RandomSource FooM Bar where
-- >             {- at least one RandomSource function... -}
-- >     |])
randomSource :: Q [Dec] -> Q [Dec]
randomSource :: Q [Dec] -> Q [Dec]
randomSource = Defaults (Sum Double) () -> Q [Dec] -> Q [Dec]
forall s. (Monoid s, Ord s) => Defaults s () -> Q [Dec] -> Q [Dec]
FD.withDefaults (Context -> Defaults (Sum Double) ()
defaults Context
RandomSource)

-- |Complete a possibly-incomplete 'MonadRandom' implementation.  It is 
-- recommended that this macro be used even if the implementation is currently
-- complete, as the 'MonadRandom' class may be extended at any time.
--
-- To use 'monadRandom', just wrap your instance declaration as follows (and
-- enable the TemplateHaskell and GADTs language extensions):
--
-- > $(monadRandom [d|
-- >         instance MonadRandom FooM where
-- >             getRandomDouble = return pi
-- >             getRandomWord16 = return 4
-- >             {- etc... -}
-- >     |])
monadRandom :: Q [Dec] -> Q [Dec]
monadRandom :: Q [Dec] -> Q [Dec]
monadRandom = Defaults (Sum Double) () -> Q [Dec] -> Q [Dec]
forall s. (Monoid s, Ord s) => Defaults s () -> Q [Dec] -> Q [Dec]
FD.withDefaults (Context -> Defaults (Sum Double) ()
defaults Context
MonadRandom)

-- -- This is nice in theory, but under GHC 7 it never typechecks; without generalizing the let-bound
-- -- functions, it gets absurd errors like "cannot match 'm Int' with 'IO t'".  Probably need
-- -- to mechanically specialize the supplied signature to create a signature for every other
-- -- let-bound function.
-- primFunction :: Q Type -> Q [Dec] -> ExpQ
-- primFunction getPrimType decsQ = do
--     getPrimSig <- sigD (mkName (methodName Generic GetPrim)) getPrimType
--     decs <- decsQ >>= FD.implementDefaults (defaults Generic)
--     f <- getPrim
--     return (LetE (getPrimSig : decs) f)