{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Futhark.Builder
(
BuilderT,
runBuilderT,
runBuilderT_,
runBuilderT',
runBuilderT'_,
BuilderOps (..),
Builder,
runBuilder,
runBuilder_,
runBodyBuilder,
runLambdaBuilder,
module Futhark.Builder.Class,
)
where
import Control.Arrow (second)
import Control.Monad.Error.Class
import Control.Monad.Reader
import Control.Monad.State.Strict
import Control.Monad.Writer
import Data.Map.Strict qualified as M
import Futhark.Builder.Class
import Futhark.IR
class ASTRep rep => BuilderOps rep where
mkExpDecB ::
(MonadBuilder m, Rep m ~ rep) =>
Pat (LetDec rep) ->
Exp rep ->
m (ExpDec rep)
mkBodyB ::
(MonadBuilder m, Rep m ~ rep) =>
Stms rep ->
Result ->
m (Body rep)
mkLetNamesB ::
(MonadBuilder m, Rep m ~ rep) =>
[VName] ->
Exp rep ->
m (Stm rep)
default mkExpDecB ::
(MonadBuilder m, Buildable rep) =>
Pat (LetDec rep) ->
Exp rep ->
m (ExpDec rep)
mkExpDecB Pat (LetDec rep)
pat Exp rep
e = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k).
Buildable rep =>
Pat (LetDec rep) -> Exp rep -> ExpDec rep
mkExpDec Pat (LetDec rep)
pat Exp rep
e
default mkBodyB ::
(MonadBuilder m, Buildable rep) =>
Stms rep ->
Result ->
m (Body rep)
mkBodyB Stms rep
stms Result
res = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k).
Buildable rep =>
Stms rep -> Result -> Body rep
mkBody Stms rep
stms Result
res
default mkLetNamesB ::
(MonadBuilder m, Rep m ~ rep, Buildable rep) =>
[VName] ->
Exp rep ->
m (Stm rep)
mkLetNamesB = forall {k} (rep :: k) (m :: * -> *).
(Buildable rep, MonadFreshNames m, HasScope rep m) =>
[VName] -> Exp rep -> m (Stm rep)
mkLetNames
newtype BuilderT rep m a = BuilderT (StateT (Stms rep, Scope rep) m a)
deriving (forall k (rep :: k) (m :: * -> *) a b.
Functor m =>
a -> BuilderT rep m b -> BuilderT rep m a
forall k (rep :: k) (m :: * -> *) a b.
Functor m =>
(a -> b) -> BuilderT rep m a -> BuilderT rep m b
forall a b. a -> BuilderT rep m b -> BuilderT rep m a
forall a b. (a -> b) -> BuilderT rep m a -> BuilderT rep m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> BuilderT rep m b -> BuilderT rep m a
$c<$ :: forall k (rep :: k) (m :: * -> *) a b.
Functor m =>
a -> BuilderT rep m b -> BuilderT rep m a
fmap :: forall a b. (a -> b) -> BuilderT rep m a -> BuilderT rep m b
$cfmap :: forall k (rep :: k) (m :: * -> *) a b.
Functor m =>
(a -> b) -> BuilderT rep m a -> BuilderT rep m b
Functor, forall a. a -> BuilderT rep m a
forall {k} {rep :: k} {m :: * -> *}.
Monad m =>
Applicative (BuilderT rep m)
forall k (rep :: k) (m :: * -> *) a.
Monad m =>
a -> BuilderT rep m a
forall k (rep :: k) (m :: * -> *) a b.
Monad m =>
BuilderT rep m a -> BuilderT rep m b -> BuilderT rep m b
forall k (rep :: k) (m :: * -> *) a b.
Monad m =>
BuilderT rep m a -> (a -> BuilderT rep m b) -> BuilderT rep m b
forall a b.
BuilderT rep m a -> BuilderT rep m b -> BuilderT rep m b
forall a b.
BuilderT rep m a -> (a -> BuilderT rep m b) -> BuilderT rep m 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 :: forall a. a -> BuilderT rep m a
$creturn :: forall k (rep :: k) (m :: * -> *) a.
Monad m =>
a -> BuilderT rep m a
>> :: forall a b.
BuilderT rep m a -> BuilderT rep m b -> BuilderT rep m b
$c>> :: forall k (rep :: k) (m :: * -> *) a b.
Monad m =>
BuilderT rep m a -> BuilderT rep m b -> BuilderT rep m b
>>= :: forall a b.
BuilderT rep m a -> (a -> BuilderT rep m b) -> BuilderT rep m b
$c>>= :: forall k (rep :: k) (m :: * -> *) a b.
Monad m =>
BuilderT rep m a -> (a -> BuilderT rep m b) -> BuilderT rep m b
Monad, forall a. a -> BuilderT rep m a
forall {k} {rep :: k} {m :: * -> *}.
Monad m =>
Functor (BuilderT rep m)
forall k (rep :: k) (m :: * -> *) a.
Monad m =>
a -> BuilderT rep m a
forall k (rep :: k) (m :: * -> *) a b.
Monad m =>
BuilderT rep m a -> BuilderT rep m b -> BuilderT rep m a
forall k (rep :: k) (m :: * -> *) a b.
Monad m =>
BuilderT rep m a -> BuilderT rep m b -> BuilderT rep m b
forall k (rep :: k) (m :: * -> *) a b.
Monad m =>
BuilderT rep m (a -> b) -> BuilderT rep m a -> BuilderT rep m b
forall k (rep :: k) (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> BuilderT rep m a -> BuilderT rep m b -> BuilderT rep m c
forall a b.
BuilderT rep m a -> BuilderT rep m b -> BuilderT rep m a
forall a b.
BuilderT rep m a -> BuilderT rep m b -> BuilderT rep m b
forall a b.
BuilderT rep m (a -> b) -> BuilderT rep m a -> BuilderT rep m b
forall a b c.
(a -> b -> c)
-> BuilderT rep m a -> BuilderT rep m b -> BuilderT rep m 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
<* :: forall a b.
BuilderT rep m a -> BuilderT rep m b -> BuilderT rep m a
$c<* :: forall k (rep :: k) (m :: * -> *) a b.
Monad m =>
BuilderT rep m a -> BuilderT rep m b -> BuilderT rep m a
*> :: forall a b.
BuilderT rep m a -> BuilderT rep m b -> BuilderT rep m b
$c*> :: forall k (rep :: k) (m :: * -> *) a b.
Monad m =>
BuilderT rep m a -> BuilderT rep m b -> BuilderT rep m b
liftA2 :: forall a b c.
(a -> b -> c)
-> BuilderT rep m a -> BuilderT rep m b -> BuilderT rep m c
$cliftA2 :: forall k (rep :: k) (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> BuilderT rep m a -> BuilderT rep m b -> BuilderT rep m c
<*> :: forall a b.
BuilderT rep m (a -> b) -> BuilderT rep m a -> BuilderT rep m b
$c<*> :: forall k (rep :: k) (m :: * -> *) a b.
Monad m =>
BuilderT rep m (a -> b) -> BuilderT rep m a -> BuilderT rep m b
pure :: forall a. a -> BuilderT rep m a
$cpure :: forall k (rep :: k) (m :: * -> *) a.
Monad m =>
a -> BuilderT rep m a
Applicative)
instance MonadTrans (BuilderT rep) where
lift :: forall (m :: * -> *) a. Monad m => m a -> BuilderT rep m a
lift = forall {k} (rep :: k) (m :: * -> *) a.
StateT (Stms rep, Scope rep) m a -> BuilderT rep m a
BuilderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
type Builder rep = BuilderT rep (State VNameSource)
instance MonadFreshNames m => MonadFreshNames (BuilderT rep m) where
getNameSource :: BuilderT rep m VNameSource
getNameSource = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadFreshNames m => m VNameSource
getNameSource
putNameSource :: VNameSource -> BuilderT rep m ()
putNameSource = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadFreshNames m => VNameSource -> m ()
putNameSource
instance (ASTRep rep, Monad m) => HasScope rep (BuilderT rep m) where
lookupType :: VName -> BuilderT rep m Type
lookupType VName
name = do
Maybe (NameInfo rep)
t <- forall {k} (rep :: k) (m :: * -> *) a.
StateT (Stms rep, Scope rep) m a -> BuilderT rep m a
BuilderT forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
case Maybe (NameInfo rep)
t of
Maybe (NameInfo rep)
Nothing -> do
[VName]
known <- forall {k} (rep :: k) (m :: * -> *) a.
StateT (Stms rep, Scope rep) m a -> BuilderT rep m a
BuilderT forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
M.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
forall a. HasCallStack => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$
[ [Char]
"BuilderT.lookupType: unknown variable " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyString VName
name,
[Char]
"Known variables: ",
[[Char]] -> [Char]
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> [Char]
prettyString [VName]
known
]
Just NameInfo rep
t' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t. Typed t => t -> Type
typeOf NameInfo rep
t'
askScope :: BuilderT rep m (Scope rep)
askScope = forall {k} (rep :: k) (m :: * -> *) a.
StateT (Stms rep, Scope rep) m a -> BuilderT rep m a
BuilderT forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a, b) -> b
snd
instance (ASTRep rep, Monad m) => LocalScope rep (BuilderT rep m) where
localScope :: forall a. Scope rep -> BuilderT rep m a -> BuilderT rep m a
localScope Scope rep
types (BuilderT StateT (Stms rep, Scope rep) m a
m) = forall {k} (rep :: k) (m :: * -> *) a.
StateT (Stms rep, Scope rep) m a -> BuilderT rep m a
BuilderT forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Scope rep
types)
a
x <- StateT (Stms rep, Scope rep) m a
m
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Scope rep
types)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
instance
(MonadFreshNames m, BuilderOps rep) =>
MonadBuilder (BuilderT rep m)
where
type Rep (BuilderT rep m) = rep
mkExpDecM :: Pat (LetDec (Rep (BuilderT rep m)))
-> Exp (Rep (BuilderT rep m))
-> BuilderT rep m (ExpDec (Rep (BuilderT rep m)))
mkExpDecM = forall rep (m :: * -> *).
(BuilderOps rep, MonadBuilder m, Rep m ~ rep) =>
Pat (LetDec rep) -> Exp rep -> m (ExpDec rep)
mkExpDecB
mkBodyM :: Stms (Rep (BuilderT rep m))
-> Result -> BuilderT rep m (Body (Rep (BuilderT rep m)))
mkBodyM = forall rep (m :: * -> *).
(BuilderOps rep, MonadBuilder m, Rep m ~ rep) =>
Stms rep -> Result -> m (Body rep)
mkBodyB
mkLetNamesM :: [VName]
-> Exp (Rep (BuilderT rep m))
-> BuilderT rep m (Stm (Rep (BuilderT rep m)))
mkLetNamesM = forall rep (m :: * -> *).
(BuilderOps rep, MonadBuilder m, Rep m ~ rep) =>
[VName] -> Exp rep -> m (Stm rep)
mkLetNamesB
addStms :: Stms (Rep (BuilderT rep m)) -> BuilderT rep m ()
addStms Stms (Rep (BuilderT rep m))
stms =
forall {k} (rep :: k) (m :: * -> *) a.
StateT (Stms rep, Scope rep) m a -> BuilderT rep m a
BuilderT forall a b. (a -> b) -> a -> b
$
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \(Stms rep
cur_stms, Map VName (NameInfo rep)
scope) ->
(Stms rep
cur_stms forall a. Semigroup a => a -> a -> a
<> Stms (Rep (BuilderT rep m))
stms, Map VName (NameInfo rep)
scope forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` forall {k} (rep :: k) a. Scoped rep a => a -> Scope rep
scopeOf Stms (Rep (BuilderT rep m))
stms)
collectStms :: forall a.
BuilderT rep m a -> BuilderT rep m (a, Stms (Rep (BuilderT rep m)))
collectStms BuilderT rep m a
m = do
(Stms rep
old_stms, Map VName (NameInfo rep)
old_scope) <- forall {k} (rep :: k) (m :: * -> *) a.
StateT (Stms rep, Scope rep) m a -> BuilderT rep m a
BuilderT forall s (m :: * -> *). MonadState s m => m s
get
forall {k} (rep :: k) (m :: * -> *) a.
StateT (Stms rep, Scope rep) m a -> BuilderT rep m a
BuilderT forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => s -> m ()
put (forall a. Monoid a => a
mempty, Map VName (NameInfo rep)
old_scope)
a
x <- BuilderT rep m a
m
(Stms rep
new_stms, Map VName (NameInfo rep)
_) <- forall {k} (rep :: k) (m :: * -> *) a.
StateT (Stms rep, Scope rep) m a -> BuilderT rep m a
BuilderT forall s (m :: * -> *). MonadState s m => m s
get
forall {k} (rep :: k) (m :: * -> *) a.
StateT (Stms rep, Scope rep) m a -> BuilderT rep m a
BuilderT forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => s -> m ()
put (Stms rep
old_stms, Map VName (NameInfo rep)
old_scope)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x, Stms rep
new_stms)
runBuilderT ::
MonadFreshNames m =>
BuilderT rep m a ->
Scope rep ->
m (a, Stms rep)
runBuilderT :: forall {k} (m :: * -> *) (rep :: k) a.
MonadFreshNames m =>
BuilderT rep m a -> Scope rep -> m (a, Stms rep)
runBuilderT (BuilderT StateT (Stms rep, Scope rep) m a
m) Scope rep
scope = do
(a
x, (Stms rep
stms, Scope rep
_)) <- forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT (Stms rep, Scope rep) m a
m (forall a. Monoid a => a
mempty, Scope rep
scope)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x, Stms rep
stms)
runBuilderT_ ::
MonadFreshNames m =>
BuilderT rep m () ->
Scope rep ->
m (Stms rep)
runBuilderT_ :: forall {k} (m :: * -> *) (rep :: k).
MonadFreshNames m =>
BuilderT rep m () -> Scope rep -> m (Stms rep)
runBuilderT_ BuilderT rep m ()
m = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (m :: * -> *) (rep :: k) a.
MonadFreshNames m =>
BuilderT rep m a -> Scope rep -> m (a, Stms rep)
runBuilderT BuilderT rep m ()
m
runBuilderT' ::
(MonadFreshNames m, HasScope somerep m, SameScope somerep rep) =>
BuilderT rep m a ->
m (a, Stms rep)
runBuilderT' :: forall {k} {k} (m :: * -> *) (somerep :: k) (rep :: k) a.
(MonadFreshNames m, HasScope somerep m, SameScope somerep rep) =>
BuilderT rep m a -> m (a, Stms rep)
runBuilderT' BuilderT rep m a
m = do
Scope somerep
scope <- forall {k} (rep :: k) (m :: * -> *).
HasScope rep m =>
m (Scope rep)
askScope
forall {k} (m :: * -> *) (rep :: k) a.
MonadFreshNames m =>
BuilderT rep m a -> Scope rep -> m (a, Stms rep)
runBuilderT BuilderT rep m a
m forall a b. (a -> b) -> a -> b
$ forall {k1} {k2} (fromrep :: k1) (torep :: k2).
SameScope fromrep torep =>
Scope fromrep -> Scope torep
castScope Scope somerep
scope
runBuilderT'_ ::
(MonadFreshNames m, HasScope somerep m, SameScope somerep rep) =>
BuilderT rep m a ->
m (Stms rep)
runBuilderT'_ :: forall {k} {k} (m :: * -> *) (somerep :: k) (rep :: k) a.
(MonadFreshNames m, HasScope somerep m, SameScope somerep rep) =>
BuilderT rep m a -> m (Stms rep)
runBuilderT'_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (m :: * -> *) (somerep :: k) (rep :: k) a.
(MonadFreshNames m, HasScope somerep m, SameScope somerep rep) =>
BuilderT rep m a -> m (a, Stms rep)
runBuilderT'
runBuilder ::
(MonadFreshNames m, HasScope somerep m, SameScope somerep rep) =>
Builder rep a ->
m (a, Stms rep)
runBuilder :: forall {k} {k} (m :: * -> *) (somerep :: k) (rep :: k) a.
(MonadFreshNames m, HasScope somerep m, SameScope somerep rep) =>
Builder rep a -> m (a, Stms rep)
runBuilder Builder rep a
m = do
Scope somerep
types <- forall {k} (rep :: k) (m :: * -> *).
HasScope rep m =>
m (Scope rep)
askScope
forall (m :: * -> *) a.
MonadFreshNames m =>
(VNameSource -> (a, VNameSource)) -> m a
modifyNameSource forall a b. (a -> b) -> a -> b
$ forall s a. State s a -> s -> (a, s)
runState forall a b. (a -> b) -> a -> b
$ forall {k} (m :: * -> *) (rep :: k) a.
MonadFreshNames m =>
BuilderT rep m a -> Scope rep -> m (a, Stms rep)
runBuilderT Builder rep a
m forall a b. (a -> b) -> a -> b
$ forall {k1} {k2} (fromrep :: k1) (torep :: k2).
SameScope fromrep torep =>
Scope fromrep -> Scope torep
castScope Scope somerep
types
runBuilder_ ::
(MonadFreshNames m, HasScope somerep m, SameScope somerep rep) =>
Builder rep a ->
m (Stms rep)
runBuilder_ :: forall {k} {k} (m :: * -> *) (somerep :: k) (rep :: k) a.
(MonadFreshNames m, HasScope somerep m, SameScope somerep rep) =>
Builder rep a -> m (Stms rep)
runBuilder_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (m :: * -> *) (somerep :: k) (rep :: k) a.
(MonadFreshNames m, HasScope somerep m, SameScope somerep rep) =>
Builder rep a -> m (a, Stms rep)
runBuilder
runBodyBuilder ::
( Buildable rep,
MonadFreshNames m,
HasScope somerep m,
SameScope somerep rep
) =>
Builder rep (Body rep) ->
m (Body rep)
runBodyBuilder :: forall {k} {k} (rep :: k) (m :: * -> *) (somerep :: k).
(Buildable rep, MonadFreshNames m, HasScope somerep m,
SameScope somerep rep) =>
Builder rep (Body rep) -> m (Body rep)
runBodyBuilder = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {k} (rep :: k).
Buildable rep =>
Stms rep -> Body rep -> Body rep
insertStms) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (m :: * -> *) (somerep :: k) (rep :: k) a.
(MonadFreshNames m, HasScope somerep m, SameScope somerep rep) =>
Builder rep a -> m (a, Stms rep)
runBuilder
runLambdaBuilder ::
( Buildable rep,
MonadFreshNames m,
HasScope somerep m,
SameScope somerep rep
) =>
[LParam rep] ->
Builder rep Result ->
m (Lambda rep)
runLambdaBuilder :: forall {k} {k} (rep :: k) (m :: * -> *) (somerep :: k).
(Buildable rep, MonadFreshNames m, HasScope somerep m,
SameScope somerep rep) =>
[LParam rep] -> Builder rep Result -> m (Lambda rep)
runLambdaBuilder [LParam rep]
params Builder rep Result
m = do
((Result
res, [Type]
ret), Stms rep
stms) <- forall {k} {k} (m :: * -> *) (somerep :: k) (rep :: k) a.
(MonadFreshNames m, HasScope somerep m, SameScope somerep rep) =>
Builder rep a -> m (a, Stms rep)
runBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (rep :: k) (m :: * -> *) a.
LocalScope rep m =>
Scope rep -> m a -> m a
localScope (forall {k} (rep :: k) dec.
(LParamInfo rep ~ dec) =>
[Param dec] -> Scope rep
scopeOfLParams [LParam rep]
params) forall a b. (a -> b) -> a -> b
$ do
Result
res <- Builder rep Result
m
[Type]
ret <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {k} (t :: k) (m :: * -> *).
HasScope t m =>
SubExpRes -> m Type
subExpResType Result
res
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result
res, [Type]
ret)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k).
[LParam rep] -> Body rep -> [Type] -> Lambda rep
Lambda [LParam rep]
params (forall {k} (rep :: k).
Buildable rep =>
Stms rep -> Result -> Body rep
mkBody Stms rep
stms Result
res) [Type]
ret
mapInner ::
Monad m =>
( m (a, (Stms rep, Scope rep)) ->
m (b, (Stms rep, Scope rep))
) ->
BuilderT rep m a ->
BuilderT rep m b
mapInner :: forall {k} (m :: * -> *) a (rep :: k) b.
Monad m =>
(m (a, (Stms rep, Scope rep)) -> m (b, (Stms rep, Scope rep)))
-> BuilderT rep m a -> BuilderT rep m b
mapInner m (a, (Stms rep, Scope rep)) -> m (b, (Stms rep, Scope rep))
f (BuilderT StateT (Stms rep, Scope rep) m a
m) = forall {k} (rep :: k) (m :: * -> *) a.
StateT (Stms rep, Scope rep) m a -> BuilderT rep m a
BuilderT forall a b. (a -> b) -> a -> b
$ do
(Stms rep, Scope rep)
s <- forall s (m :: * -> *). MonadState s m => m s
get
(b
x, (Stms rep, Scope rep)
s') <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ m (a, (Stms rep, Scope rep)) -> m (b, (Stms rep, Scope rep))
f forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT (Stms rep, Scope rep) m a
m (Stms rep, Scope rep)
s
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Stms rep, Scope rep)
s'
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
x
instance MonadReader r m => MonadReader r (BuilderT rep m) where
ask :: BuilderT rep m r
ask = forall {k} (rep :: k) (m :: * -> *) a.
StateT (Stms rep, Scope rep) m a -> BuilderT rep m a
BuilderT forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
local :: forall a. (r -> r) -> BuilderT rep m a -> BuilderT rep m a
local r -> r
f = forall {k} (m :: * -> *) a (rep :: k) b.
Monad m =>
(m (a, (Stms rep, Scope rep)) -> m (b, (Stms rep, Scope rep)))
-> BuilderT rep m a -> BuilderT rep m b
mapInner forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f
instance MonadState s m => MonadState s (BuilderT rep m) where
get :: BuilderT rep m s
get = forall {k} (rep :: k) (m :: * -> *) a.
StateT (Stms rep, Scope rep) m a -> BuilderT rep m a
BuilderT forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
get
put :: s -> BuilderT rep m ()
put = forall {k} (rep :: k) (m :: * -> *) a.
StateT (Stms rep, Scope rep) m a -> BuilderT rep m a
BuilderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put
instance MonadWriter w m => MonadWriter w (BuilderT rep m) where
tell :: w -> BuilderT rep m ()
tell = forall {k} (rep :: k) (m :: * -> *) a.
StateT (Stms rep, Scope rep) m a -> BuilderT rep m a
BuilderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
pass :: forall a. BuilderT rep m (a, w -> w) -> BuilderT rep m a
pass = forall {k} (m :: * -> *) a (rep :: k) b.
Monad m =>
(m (a, (Stms rep, Scope rep)) -> m (b, (Stms rep, Scope rep)))
-> BuilderT rep m a -> BuilderT rep m b
mapInner forall a b. (a -> b) -> a -> b
$ \m ((a, w -> w), (Stms rep, Scope rep))
m -> forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass forall a b. (a -> b) -> a -> b
$ do
((a
x, w -> w
f), (Stms rep, Scope rep)
s) <- m ((a, w -> w), (Stms rep, Scope rep))
m
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a
x, (Stms rep, Scope rep)
s), w -> w
f)
listen :: forall a. BuilderT rep m a -> BuilderT rep m (a, w)
listen = forall {k} (m :: * -> *) a (rep :: k) b.
Monad m =>
(m (a, (Stms rep, Scope rep)) -> m (b, (Stms rep, Scope rep)))
-> BuilderT rep m a -> BuilderT rep m b
mapInner forall a b. (a -> b) -> a -> b
$ \m (a, (Stms rep, Scope rep))
m -> do
((a
x, (Stms rep, Scope rep)
s), w
y) <- forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen m (a, (Stms rep, Scope rep))
m
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a
x, w
y), (Stms rep, Scope rep)
s)
instance MonadError e m => MonadError e (BuilderT rep m) where
throwError :: forall a. e -> BuilderT rep m a
throwError = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
catchError :: forall a.
BuilderT rep m a -> (e -> BuilderT rep m a) -> BuilderT rep m a
catchError (BuilderT StateT (Stms rep, Scope rep) m a
m) e -> BuilderT rep m a
f =
forall {k} (rep :: k) (m :: * -> *) a.
StateT (Stms rep, Scope rep) m a -> BuilderT rep m a
BuilderT forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError StateT (Stms rep, Scope rep) m a
m forall a b. (a -> b) -> a -> b
$ forall {k} {rep :: k} {m :: * -> *} {a}.
BuilderT rep m a -> StateT (Stms rep, Scope rep) m a
unBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> BuilderT rep m a
f
where
unBuilder :: BuilderT rep m a -> StateT (Stms rep, Scope rep) m a
unBuilder (BuilderT StateT (Stms rep, Scope rep) m a
m') = StateT (Stms rep, Scope rep) m a
m'