{-# LANGUAGE GeneralizedNewtypeDeriving, CPP #-}
module Language.Haskell.TH.FlexibleDefaults.DSL where
#if !(MIN_VERSION_base(4,8,0))
import Control.Applicative
#endif
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State
import Control.Monad.Trans.Writer
import Data.List
import Data.Semigroup as Semigroup
import qualified Data.Map as M
import Data.Ord
import qualified Data.Set as S
import Language.Haskell.TH
import Language.Haskell.TH.FlexibleDefaults.Solve
newtype Impls s = Impls { Impls s -> Map String [ImplSpec s]
unImpls :: M.Map String [ImplSpec s] }
instance Functor Impls where
fmap :: (a -> b) -> Impls a -> Impls b
fmap f :: a -> b
f (Impls m :: Map String [ImplSpec a]
m) = Map String [ImplSpec b] -> Impls b
forall s. Map String [ImplSpec s] -> Impls s
Impls (([ImplSpec a] -> [ImplSpec b])
-> Map String [ImplSpec a] -> Map String [ImplSpec b]
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((ImplSpec a -> ImplSpec b) -> [ImplSpec a] -> [ImplSpec b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> ImplSpec a -> ImplSpec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) Map String [ImplSpec a]
m)
instance Semigroup.Semigroup (Impls s) where
<> :: Impls s -> Impls s -> Impls s
(<>) (Impls x :: Map String [ImplSpec s]
x) (Impls y :: Map String [ImplSpec s]
y) = Map String [ImplSpec s] -> Impls s
forall s. Map String [ImplSpec s] -> Impls s
Impls (([ImplSpec s] -> [ImplSpec s] -> [ImplSpec s])
-> Map String [ImplSpec s]
-> Map String [ImplSpec s]
-> Map String [ImplSpec s]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith [ImplSpec s] -> [ImplSpec s] -> [ImplSpec s]
forall a. Monoid a => a -> a -> a
mappend Map String [ImplSpec s]
x Map String [ImplSpec s]
y)
instance Monoid (Impls s) where
mempty :: Impls s
mempty = Map String [ImplSpec s] -> Impls s
forall s. Map String [ImplSpec s] -> Impls s
Impls Map String [ImplSpec s]
forall a. Monoid a => a
mempty
mappend :: Impls s -> Impls s -> Impls s
mappend = Impls s -> Impls s -> Impls s
forall a. Semigroup a => a -> a -> a
(Semigroup.<>)
newtype Defaults s a = Defaults { Defaults s a -> Writer (Impls s) a
unDefaults :: Writer (Impls s) a }
deriving (a -> Defaults s b -> Defaults s a
(a -> b) -> Defaults s a -> Defaults s b
(forall a b. (a -> b) -> Defaults s a -> Defaults s b)
-> (forall a b. a -> Defaults s b -> Defaults s a)
-> Functor (Defaults s)
forall a b. a -> Defaults s b -> Defaults s a
forall a b. (a -> b) -> Defaults s a -> Defaults s b
forall s a b. a -> Defaults s b -> Defaults s a
forall s a b. (a -> b) -> Defaults s a -> Defaults s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Defaults s b -> Defaults s a
$c<$ :: forall s a b. a -> Defaults s b -> Defaults s a
fmap :: (a -> b) -> Defaults s a -> Defaults s b
$cfmap :: forall s a b. (a -> b) -> Defaults s a -> Defaults s b
Functor, Functor (Defaults s)
a -> Defaults s a
Functor (Defaults s) =>
(forall a. a -> Defaults s a)
-> (forall a b.
Defaults s (a -> b) -> Defaults s a -> Defaults s b)
-> (forall a b c.
(a -> b -> c) -> Defaults s a -> Defaults s b -> Defaults s c)
-> (forall a b. Defaults s a -> Defaults s b -> Defaults s b)
-> (forall a b. Defaults s a -> Defaults s b -> Defaults s a)
-> Applicative (Defaults s)
Defaults s a -> Defaults s b -> Defaults s b
Defaults s a -> Defaults s b -> Defaults s a
Defaults s (a -> b) -> Defaults s a -> Defaults s b
(a -> b -> c) -> Defaults s a -> Defaults s b -> Defaults s c
forall s. Functor (Defaults s)
forall a. a -> Defaults s a
forall s a. a -> Defaults s a
forall a b. Defaults s a -> Defaults s b -> Defaults s a
forall a b. Defaults s a -> Defaults s b -> Defaults s b
forall a b. Defaults s (a -> b) -> Defaults s a -> Defaults s b
forall s a b. Defaults s a -> Defaults s b -> Defaults s a
forall s a b. Defaults s a -> Defaults s b -> Defaults s b
forall s a b. Defaults s (a -> b) -> Defaults s a -> Defaults s b
forall a b c.
(a -> b -> c) -> Defaults s a -> Defaults s b -> Defaults s c
forall s a b c.
(a -> b -> c) -> Defaults s a -> Defaults s b -> Defaults s c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Defaults s a -> Defaults s b -> Defaults s a
$c<* :: forall s a b. Defaults s a -> Defaults s b -> Defaults s a
*> :: Defaults s a -> Defaults s b -> Defaults s b
$c*> :: forall s a b. Defaults s a -> Defaults s b -> Defaults s b
liftA2 :: (a -> b -> c) -> Defaults s a -> Defaults s b -> Defaults s c
$cliftA2 :: forall s a b c.
(a -> b -> c) -> Defaults s a -> Defaults s b -> Defaults s c
<*> :: Defaults s (a -> b) -> Defaults s a -> Defaults s b
$c<*> :: forall s a b. Defaults s (a -> b) -> Defaults s a -> Defaults s b
pure :: a -> Defaults s a
$cpure :: forall s a. a -> Defaults s a
$cp1Applicative :: forall s. Functor (Defaults s)
Applicative, Applicative (Defaults s)
a -> Defaults s a
Applicative (Defaults s) =>
(forall a b. Defaults s a -> (a -> Defaults s b) -> Defaults s b)
-> (forall a b. Defaults s a -> Defaults s b -> Defaults s b)
-> (forall a. a -> Defaults s a)
-> Monad (Defaults s)
Defaults s a -> (a -> Defaults s b) -> Defaults s b
Defaults s a -> Defaults s b -> Defaults s b
forall s. Applicative (Defaults s)
forall a. a -> Defaults s a
forall s a. a -> Defaults s a
forall a b. Defaults s a -> Defaults s b -> Defaults s b
forall a b. Defaults s a -> (a -> Defaults s b) -> Defaults s b
forall s a b. Defaults s a -> Defaults s b -> Defaults s b
forall s a b. Defaults s a -> (a -> Defaults s b) -> Defaults s b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Defaults s a
$creturn :: forall s a. a -> Defaults s a
>> :: Defaults s a -> Defaults s b -> Defaults s b
$c>> :: forall s a b. Defaults s a -> Defaults s b -> Defaults s b
>>= :: Defaults s a -> (a -> Defaults s b) -> Defaults s b
$c>>= :: forall s a b. Defaults s a -> (a -> Defaults s b) -> Defaults s b
$cp1Monad :: forall s. Applicative (Defaults s)
Monad)
addImplSpecs :: String -> [ImplSpec s] -> Defaults s ()
addImplSpecs :: String -> [ImplSpec s] -> Defaults s ()
addImplSpecs f :: String
f = Writer (Impls s) () -> Defaults s ()
forall s a. Writer (Impls s) a -> Defaults s a
Defaults (Writer (Impls s) () -> Defaults s ())
-> ([ImplSpec s] -> Writer (Impls s) ())
-> [ImplSpec s]
-> Defaults s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Impls s -> Writer (Impls s) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (Impls s -> Writer (Impls s) ())
-> ([ImplSpec s] -> Impls s) -> [ImplSpec s] -> Writer (Impls s) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String [ImplSpec s] -> Impls s
forall s. Map String [ImplSpec s] -> Impls s
Impls (Map String [ImplSpec s] -> Impls s)
-> ([ImplSpec s] -> Map String [ImplSpec s])
-> [ImplSpec s]
-> Impls s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [ImplSpec s] -> Map String [ImplSpec s]
forall k a. k -> a -> Map k a
M.singleton String
f
addImplSpec :: String -> ImplSpec s -> Defaults s ()
addImplSpec :: String -> ImplSpec s -> Defaults s ()
addImplSpec f :: String
f = String -> [ImplSpec s] -> Defaults s ()
forall s. String -> [ImplSpec s] -> Defaults s ()
addImplSpecs String
f ([ImplSpec s] -> Defaults s ())
-> (ImplSpec s -> [ImplSpec s]) -> ImplSpec s -> Defaults s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ImplSpec s -> [ImplSpec s] -> [ImplSpec s]
forall a. a -> [a] -> [a]
:[])
toProblem :: (Ord s, Monoid s) => Defaults s () -> Problem s
toProblem :: Defaults s () -> Problem s
toProblem
= ([ImplSpec s] -> [ImplSpec s]) -> Problem s -> Problem s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ImplSpec s -> ImplSpec s -> Ordering)
-> [ImplSpec s] -> [ImplSpec s]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((ImplSpec s -> ImplSpec s -> Ordering)
-> ImplSpec s -> ImplSpec s -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ImplSpec s -> s) -> ImplSpec s -> ImplSpec s -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ImplSpec s -> s
forall s. Monoid s => ImplSpec s -> s
scoreImplSpec)))
(Problem s -> Problem s)
-> (Defaults s () -> Problem s) -> Defaults s () -> Problem s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Impls s -> Problem s
forall s. Impls s -> Map String [ImplSpec s]
unImpls
(Impls s -> Problem s)
-> (Defaults s () -> Impls s) -> Defaults s () -> Problem s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((), Impls s) -> Impls s
forall a b. (a, b) -> b
snd
(((), Impls s) -> Impls s)
-> (Defaults s () -> ((), Impls s)) -> Defaults s () -> Impls s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer (Impls s) () -> ((), Impls s)
forall w a. Writer w a -> (a, w)
runWriter
(Writer (Impls s) () -> ((), Impls s))
-> (Defaults s () -> Writer (Impls s) ())
-> Defaults s ()
-> ((), Impls s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defaults s () -> Writer (Impls s) ()
forall s a. Defaults s a -> Writer (Impls s) a
unDefaults
scoreBy :: (a -> b) -> Defaults a t -> Defaults b t
scoreBy :: (a -> b) -> Defaults a t -> Defaults b t
scoreBy f :: a -> b
f = Writer (Impls b) t -> Defaults b t
forall s a. Writer (Impls s) a -> Defaults s a
Defaults (Writer (Impls b) t -> Defaults b t)
-> (Defaults a t -> Writer (Impls b) t)
-> Defaults a t
-> Defaults b t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identity (t, Impls a) -> Identity (t, Impls b))
-> WriterT (Impls a) Identity t -> Writer (Impls b) t
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT (((t, Impls a) -> (t, Impls b))
-> Identity (t, Impls a) -> Identity (t, Impls b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Impls a -> Impls b) -> (t, Impls a) -> (t, Impls b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Impls a -> Impls b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f))) (WriterT (Impls a) Identity t -> Writer (Impls b) t)
-> (Defaults a t -> WriterT (Impls a) Identity t)
-> Defaults a t
-> Writer (Impls b) t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defaults a t -> WriterT (Impls a) Identity t
forall s a. Defaults s a -> Writer (Impls s) a
unDefaults
newtype Function s a = Function (ReaderT String (Defaults s) a)
deriving (a -> Function s b -> Function s a
(a -> b) -> Function s a -> Function s b
(forall a b. (a -> b) -> Function s a -> Function s b)
-> (forall a b. a -> Function s b -> Function s a)
-> Functor (Function s)
forall a b. a -> Function s b -> Function s a
forall a b. (a -> b) -> Function s a -> Function s b
forall s a b. a -> Function s b -> Function s a
forall s a b. (a -> b) -> Function s a -> Function s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Function s b -> Function s a
$c<$ :: forall s a b. a -> Function s b -> Function s a
fmap :: (a -> b) -> Function s a -> Function s b
$cfmap :: forall s a b. (a -> b) -> Function s a -> Function s b
Functor, Functor (Function s)
a -> Function s a
Functor (Function s) =>
(forall a. a -> Function s a)
-> (forall a b.
Function s (a -> b) -> Function s a -> Function s b)
-> (forall a b c.
(a -> b -> c) -> Function s a -> Function s b -> Function s c)
-> (forall a b. Function s a -> Function s b -> Function s b)
-> (forall a b. Function s a -> Function s b -> Function s a)
-> Applicative (Function s)
Function s a -> Function s b -> Function s b
Function s a -> Function s b -> Function s a
Function s (a -> b) -> Function s a -> Function s b
(a -> b -> c) -> Function s a -> Function s b -> Function s c
forall s. Functor (Function s)
forall a. a -> Function s a
forall s a. a -> Function s a
forall a b. Function s a -> Function s b -> Function s a
forall a b. Function s a -> Function s b -> Function s b
forall a b. Function s (a -> b) -> Function s a -> Function s b
forall s a b. Function s a -> Function s b -> Function s a
forall s a b. Function s a -> Function s b -> Function s b
forall s a b. Function s (a -> b) -> Function s a -> Function s b
forall a b c.
(a -> b -> c) -> Function s a -> Function s b -> Function s c
forall s a b c.
(a -> b -> c) -> Function s a -> Function s b -> Function s c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Function s a -> Function s b -> Function s a
$c<* :: forall s a b. Function s a -> Function s b -> Function s a
*> :: Function s a -> Function s b -> Function s b
$c*> :: forall s a b. Function s a -> Function s b -> Function s b
liftA2 :: (a -> b -> c) -> Function s a -> Function s b -> Function s c
$cliftA2 :: forall s a b c.
(a -> b -> c) -> Function s a -> Function s b -> Function s c
<*> :: Function s (a -> b) -> Function s a -> Function s b
$c<*> :: forall s a b. Function s (a -> b) -> Function s a -> Function s b
pure :: a -> Function s a
$cpure :: forall s a. a -> Function s a
$cp1Applicative :: forall s. Functor (Function s)
Applicative, Applicative (Function s)
a -> Function s a
Applicative (Function s) =>
(forall a b. Function s a -> (a -> Function s b) -> Function s b)
-> (forall a b. Function s a -> Function s b -> Function s b)
-> (forall a. a -> Function s a)
-> Monad (Function s)
Function s a -> (a -> Function s b) -> Function s b
Function s a -> Function s b -> Function s b
forall s. Applicative (Function s)
forall a. a -> Function s a
forall s a. a -> Function s a
forall a b. Function s a -> Function s b -> Function s b
forall a b. Function s a -> (a -> Function s b) -> Function s b
forall s a b. Function s a -> Function s b -> Function s b
forall s a b. Function s a -> (a -> Function s b) -> Function s b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Function s a
$creturn :: forall s a. a -> Function s a
>> :: Function s a -> Function s b -> Function s b
$c>> :: forall s a b. Function s a -> Function s b -> Function s b
>>= :: Function s a -> (a -> Function s b) -> Function s b
$c>>= :: forall s a b. Function s a -> (a -> Function s b) -> Function s b
$cp1Monad :: forall s. Applicative (Function s)
Monad)
function :: String -> Function s a -> Defaults s a
function :: String -> Function s a -> Defaults s a
function f :: String
f (Function x :: ReaderT String (Defaults s) a
x) = do
String -> Defaults s ()
forall s. String -> Defaults s ()
requireFunction String
f
ReaderT String (Defaults s) a -> String -> Defaults s a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT String (Defaults s) a
x String
f
requireFunction :: String -> Defaults s ()
requireFunction :: String -> Defaults s ()
requireFunction f :: String
f = String -> [ImplSpec s] -> Defaults s ()
forall s. String -> [ImplSpec s] -> Defaults s ()
addImplSpecs String
f []
#if !MIN_VERSION_template_haskell(2,8,0)
data Inline = NoInline | Inline | Inlinable
deriving (Eq, Show)
#endif
newtype Implementation s a = Implementation (State (Maybe s, S.Set String, Maybe Inline) a)
deriving (a -> Implementation s b -> Implementation s a
(a -> b) -> Implementation s a -> Implementation s b
(forall a b. (a -> b) -> Implementation s a -> Implementation s b)
-> (forall a b. a -> Implementation s b -> Implementation s a)
-> Functor (Implementation s)
forall a b. a -> Implementation s b -> Implementation s a
forall a b. (a -> b) -> Implementation s a -> Implementation s b
forall s a b. a -> Implementation s b -> Implementation s a
forall s a b. (a -> b) -> Implementation s a -> Implementation s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Implementation s b -> Implementation s a
$c<$ :: forall s a b. a -> Implementation s b -> Implementation s a
fmap :: (a -> b) -> Implementation s a -> Implementation s b
$cfmap :: forall s a b. (a -> b) -> Implementation s a -> Implementation s b
Functor, Functor (Implementation s)
a -> Implementation s a
Functor (Implementation s) =>
(forall a. a -> Implementation s a)
-> (forall a b.
Implementation s (a -> b)
-> Implementation s a -> Implementation s b)
-> (forall a b c.
(a -> b -> c)
-> Implementation s a -> Implementation s b -> Implementation s c)
-> (forall a b.
Implementation s a -> Implementation s b -> Implementation s b)
-> (forall a b.
Implementation s a -> Implementation s b -> Implementation s a)
-> Applicative (Implementation s)
Implementation s a -> Implementation s b -> Implementation s b
Implementation s a -> Implementation s b -> Implementation s a
Implementation s (a -> b)
-> Implementation s a -> Implementation s b
(a -> b -> c)
-> Implementation s a -> Implementation s b -> Implementation s c
forall s. Functor (Implementation s)
forall a. a -> Implementation s a
forall s a. a -> Implementation s a
forall a b.
Implementation s a -> Implementation s b -> Implementation s a
forall a b.
Implementation s a -> Implementation s b -> Implementation s b
forall a b.
Implementation s (a -> b)
-> Implementation s a -> Implementation s b
forall s a b.
Implementation s a -> Implementation s b -> Implementation s a
forall s a b.
Implementation s a -> Implementation s b -> Implementation s b
forall s a b.
Implementation s (a -> b)
-> Implementation s a -> Implementation s b
forall a b c.
(a -> b -> c)
-> Implementation s a -> Implementation s b -> Implementation s c
forall s a b c.
(a -> b -> c)
-> Implementation s a -> Implementation s b -> Implementation s c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Implementation s a -> Implementation s b -> Implementation s a
$c<* :: forall s a b.
Implementation s a -> Implementation s b -> Implementation s a
*> :: Implementation s a -> Implementation s b -> Implementation s b
$c*> :: forall s a b.
Implementation s a -> Implementation s b -> Implementation s b
liftA2 :: (a -> b -> c)
-> Implementation s a -> Implementation s b -> Implementation s c
$cliftA2 :: forall s a b c.
(a -> b -> c)
-> Implementation s a -> Implementation s b -> Implementation s c
<*> :: Implementation s (a -> b)
-> Implementation s a -> Implementation s b
$c<*> :: forall s a b.
Implementation s (a -> b)
-> Implementation s a -> Implementation s b
pure :: a -> Implementation s a
$cpure :: forall s a. a -> Implementation s a
$cp1Applicative :: forall s. Functor (Implementation s)
Applicative, Applicative (Implementation s)
a -> Implementation s a
Applicative (Implementation s) =>
(forall a b.
Implementation s a
-> (a -> Implementation s b) -> Implementation s b)
-> (forall a b.
Implementation s a -> Implementation s b -> Implementation s b)
-> (forall a. a -> Implementation s a)
-> Monad (Implementation s)
Implementation s a
-> (a -> Implementation s b) -> Implementation s b
Implementation s a -> Implementation s b -> Implementation s b
forall s. Applicative (Implementation s)
forall a. a -> Implementation s a
forall s a. a -> Implementation s a
forall a b.
Implementation s a -> Implementation s b -> Implementation s b
forall a b.
Implementation s a
-> (a -> Implementation s b) -> Implementation s b
forall s a b.
Implementation s a -> Implementation s b -> Implementation s b
forall s a b.
Implementation s a
-> (a -> Implementation s b) -> Implementation s b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Implementation s a
$creturn :: forall s a. a -> Implementation s a
>> :: Implementation s a -> Implementation s b -> Implementation s b
$c>> :: forall s a b.
Implementation s a -> Implementation s b -> Implementation s b
>>= :: Implementation s a
-> (a -> Implementation s b) -> Implementation s b
$c>>= :: forall s a b.
Implementation s a
-> (a -> Implementation s b) -> Implementation s b
$cp1Monad :: forall s. Applicative (Implementation s)
Monad)
implementation :: Implementation s (Q [Dec]) -> Function s ()
implementation :: Implementation s (Q [Dec]) -> Function s ()
implementation (Implementation x :: State (Maybe s, Set String, Maybe Inline) (Q [Dec])
x) = case State (Maybe s, Set String, Maybe Inline) (Q [Dec])
-> (Maybe s, Set String, Maybe Inline)
-> (Q [Dec], (Maybe s, Set String, Maybe Inline))
forall s a. State s a -> s -> (a, s)
runState State (Maybe s, Set String, Maybe Inline) (Q [Dec])
x (Maybe s
forall a. Maybe a
Nothing, Set String
forall a. Set a
S.empty, Maybe Inline
forall a. Maybe a
Nothing) of
(dec :: Q [Dec]
dec, (s :: Maybe s
s, deps :: Set String
deps, inl :: Maybe Inline
inl)) -> ReaderT String (Defaults s) () -> Function s ()
forall s a. ReaderT String (Defaults s) a -> Function s a
Function (ReaderT String (Defaults s) () -> Function s ())
-> ReaderT String (Defaults s) () -> Function s ()
forall a b. (a -> b) -> a -> b
$ do
String
fName <- ReaderT String (Defaults s) String
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
(String -> Defaults s ()) -> ReaderT String (Defaults s) ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (Defaults s () -> String -> Defaults s ()
forall a b. a -> b -> a
const (String -> ImplSpec s -> Defaults s ()
forall s. String -> ImplSpec s -> Defaults s ()
addImplSpec String
fName (Maybe s -> Set String -> Q [Dec] -> ImplSpec s
forall s. Maybe s -> Set String -> Q [Dec] -> ImplSpec s
ImplSpec Maybe s
s Set String
deps (String -> Maybe Inline -> Q [Dec] -> Q [Dec]
applyInline String
fName Maybe Inline
inl Q [Dec]
dec))))
applyInline :: String -> Maybe Inline -> Q [Dec] -> Q [Dec]
#if MIN_VERSION_template_haskell(2,8,0)
applyInline :: String -> Maybe Inline -> Q [Dec] -> Q [Dec]
applyInline n :: String
n (Just inl :: Inline
inl) = ([Dec] -> [Dec]) -> Q [Dec] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pragma -> Dec
PragmaD (Name -> Inline -> RuleMatch -> Phases -> Pragma
InlineP (String -> Name
mkName String
n) Inline
inl RuleMatch
FunLike Phases
AllPhases) Dec -> [Dec] -> [Dec]
forall a. a -> [a] -> [a]
:)
#elif MIN_VERSION_template_haskell(2,4,0)
applyInline n (Just inl)
| inl /= Inlinable = fmap (PragmaD (InlineP (mkName n) (InlineSpec (inl == Inline) False Nothing)) :)
#endif
applyInline _ _ = Q [Dec] -> Q [Dec]
forall a. a -> a
id
score :: s -> Implementation s ()
score :: s -> Implementation s ()
score s :: s
s = State (Maybe s, Set String, Maybe Inline) () -> Implementation s ()
forall s a.
State (Maybe s, Set String, Maybe Inline) a -> Implementation s a
Implementation (State (Maybe s, Set String, Maybe Inline) ()
-> Implementation s ())
-> State (Maybe s, Set String, Maybe Inline) ()
-> Implementation s ()
forall a b. (a -> b) -> a -> b
$ do
(oldS :: Maybe s
oldS, deps :: Set String
deps, inl :: Maybe Inline
inl) <- StateT
(Maybe s, Set String, Maybe Inline)
Identity
(Maybe s, Set String, Maybe Inline)
forall (m :: * -> *) s. Monad m => StateT s m s
get
case Maybe s
oldS of
Nothing -> (Maybe s, Set String, Maybe Inline)
-> State (Maybe s, Set String, Maybe Inline) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (s -> Maybe s
forall a. a -> Maybe a
Just s
s, Set String
deps, Maybe Inline
inl)
Just _ -> String -> State (Maybe s, Set String, Maybe Inline) ()
forall a. HasCallStack => String -> a
error "score: score was already set"
cost :: Num s => s -> Implementation s ()
cost :: s -> Implementation s ()
cost = s -> Implementation s ()
forall s. s -> Implementation s ()
score (s -> Implementation s ()) -> (s -> s) -> s -> Implementation s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
forall a. Num a => a -> a
negate
dependsOn :: String -> Implementation s ()
dependsOn :: String -> Implementation s ()
dependsOn dep :: String
dep = State (Maybe s, Set String, Maybe Inline) () -> Implementation s ()
forall s a.
State (Maybe s, Set String, Maybe Inline) a -> Implementation s a
Implementation (State (Maybe s, Set String, Maybe Inline) ()
-> Implementation s ())
-> State (Maybe s, Set String, Maybe Inline) ()
-> Implementation s ()
forall a b. (a -> b) -> a -> b
$ do
(s :: Maybe s
s, deps :: Set String
deps, inl :: Maybe Inline
inl) <- StateT
(Maybe s, Set String, Maybe Inline)
Identity
(Maybe s, Set String, Maybe Inline)
forall (m :: * -> *) s. Monad m => StateT s m s
get
(Maybe s, Set String, Maybe Inline)
-> State (Maybe s, Set String, Maybe Inline) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Maybe s
s, String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
S.insert String
dep Set String
deps, Maybe Inline
inl)
setInline :: Inline -> Implementation s ()
setInline :: Inline -> Implementation s ()
setInline inl :: Inline
inl = State (Maybe s, Set String, Maybe Inline) () -> Implementation s ()
forall s a.
State (Maybe s, Set String, Maybe Inline) a -> Implementation s a
Implementation (State (Maybe s, Set String, Maybe Inline) ()
-> Implementation s ())
-> State (Maybe s, Set String, Maybe Inline) ()
-> Implementation s ()
forall a b. (a -> b) -> a -> b
$ do
(s :: Maybe s
s, deps :: Set String
deps, _) <- StateT
(Maybe s, Set String, Maybe Inline)
Identity
(Maybe s, Set String, Maybe Inline)
forall (m :: * -> *) s. Monad m => StateT s m s
get
(Maybe s, Set String, Maybe Inline)
-> State (Maybe s, Set String, Maybe Inline) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Maybe s
s, Set String
deps, Inline -> Maybe Inline
forall a. a -> Maybe a
Just Inline
inl)
inline :: Implementation s ()
inlinable :: Implementation s ()
noinline :: Implementation s ()
inline :: Implementation s ()
inline = Inline -> Implementation s ()
forall s. Inline -> Implementation s ()
setInline Inline
Inline
inlinable :: Implementation s ()
inlinable = Inline -> Implementation s ()
forall s. Inline -> Implementation s ()
setInline Inline
Inlinable
noinline :: Implementation s ()
noinline = Inline -> Implementation s ()
forall s. Inline -> Implementation s ()
setInline Inline
NoInline