{-# LANGUAGE UndecidableInstances #-}
module Futhark.MonadFreshNames
( MonadFreshNames (..),
modifyNameSource,
newName,
newNameFromString,
newVName,
newIdent,
newIdent',
newParam,
module Futhark.FreshNames,
)
where
import Control.Monad.Except
import Control.Monad.RWS.Lazy qualified
import Control.Monad.RWS.Strict qualified
import Control.Monad.Reader
import Control.Monad.State.Lazy qualified
import Control.Monad.State.Strict qualified
import Control.Monad.Trans.Maybe qualified
import Control.Monad.Writer.Lazy qualified
import Control.Monad.Writer.Strict qualified
import Futhark.FreshNames hiding (newName)
import Futhark.FreshNames qualified as FreshNames
import Futhark.IR.Syntax
class Monad m => MonadFreshNames m where
getNameSource :: m VNameSource
putNameSource :: VNameSource -> m ()
instance Monad im => MonadFreshNames (Control.Monad.State.Lazy.StateT VNameSource im) where
getNameSource :: StateT VNameSource im VNameSource
getNameSource = forall s (m :: * -> *). MonadState s m => m s
Control.Monad.State.Lazy.get
putNameSource :: VNameSource -> StateT VNameSource im ()
putNameSource = forall s (m :: * -> *). MonadState s m => s -> m ()
Control.Monad.State.Lazy.put
instance Monad im => MonadFreshNames (Control.Monad.State.Strict.StateT VNameSource im) where
getNameSource :: StateT VNameSource im VNameSource
getNameSource = forall s (m :: * -> *). MonadState s m => m s
Control.Monad.State.Strict.get
putNameSource :: VNameSource -> StateT VNameSource im ()
putNameSource = forall s (m :: * -> *). MonadState s m => s -> m ()
Control.Monad.State.Strict.put
instance
(Monad im, Monoid w) =>
MonadFreshNames (Control.Monad.RWS.Lazy.RWST r w VNameSource im)
where
getNameSource :: RWST r w VNameSource im VNameSource
getNameSource = forall s (m :: * -> *). MonadState s m => m s
Control.Monad.RWS.Lazy.get
putNameSource :: VNameSource -> RWST r w VNameSource im ()
putNameSource = forall s (m :: * -> *). MonadState s m => s -> m ()
Control.Monad.RWS.Lazy.put
instance
(Monad im, Monoid w) =>
MonadFreshNames (Control.Monad.RWS.Strict.RWST r w VNameSource im)
where
getNameSource :: RWST r w VNameSource im VNameSource
getNameSource = forall s (m :: * -> *). MonadState s m => m s
Control.Monad.RWS.Strict.get
putNameSource :: VNameSource -> RWST r w VNameSource im ()
putNameSource = forall s (m :: * -> *). MonadState s m => s -> m ()
Control.Monad.RWS.Strict.put
modifyNameSource :: MonadFreshNames m => (VNameSource -> (a, VNameSource)) -> m a
modifyNameSource :: forall (m :: * -> *) a.
MonadFreshNames m =>
(VNameSource -> (a, VNameSource)) -> m a
modifyNameSource VNameSource -> (a, VNameSource)
m = do
VNameSource
src <- forall (m :: * -> *). MonadFreshNames m => m VNameSource
getNameSource
let (a
x, VNameSource
src') = VNameSource -> (a, VNameSource)
m VNameSource
src
forall (m :: * -> *). MonadFreshNames m => VNameSource -> m ()
putNameSource VNameSource
src'
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
newName :: MonadFreshNames m => VName -> m VName
newName :: forall (m :: * -> *). MonadFreshNames m => VName -> m VName
newName = forall (m :: * -> *) a.
MonadFreshNames m =>
(VNameSource -> (a, VNameSource)) -> m a
modifyNameSource forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip VNameSource -> VName -> (VName, VNameSource)
FreshNames.newName
newNameFromString :: MonadFreshNames m => String -> m VName
newNameFromString :: forall (m :: * -> *). MonadFreshNames m => String -> m VName
newNameFromString String
s = forall (m :: * -> *). MonadFreshNames m => VName -> m VName
newName forall a b. (a -> b) -> a -> b
$ Name -> Int -> VName
VName (String -> Name
nameFromString String
s) Int
0
newID :: MonadFreshNames m => Name -> m VName
newID :: forall (m :: * -> *). MonadFreshNames m => Name -> m VName
newID Name
s = forall (m :: * -> *). MonadFreshNames m => VName -> m VName
newName forall a b. (a -> b) -> a -> b
$ Name -> Int -> VName
VName Name
s Int
0
newVName :: MonadFreshNames m => String -> m VName
newVName :: forall (m :: * -> *). MonadFreshNames m => String -> m VName
newVName = forall (m :: * -> *). MonadFreshNames m => Name -> m VName
newID forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
nameFromString
newIdent ::
MonadFreshNames m =>
String ->
Type ->
m Ident
newIdent :: forall (m :: * -> *).
MonadFreshNames m =>
String -> Type -> m Ident
newIdent String
s Type
t = do
VName
s' <- forall (m :: * -> *). MonadFreshNames m => Name -> m VName
newID forall a b. (a -> b) -> a -> b
$ String -> Name
nameFromString String
s
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ VName -> Type -> Ident
Ident VName
s' Type
t
newIdent' ::
MonadFreshNames m =>
(String -> String) ->
Ident ->
m Ident
newIdent' :: forall (m :: * -> *).
MonadFreshNames m =>
(String -> String) -> Ident -> m Ident
newIdent' String -> String
f Ident
ident =
forall (m :: * -> *).
MonadFreshNames m =>
String -> Type -> m Ident
newIdent
(String -> String
f forall a b. (a -> b) -> a -> b
$ Name -> String
nameToString forall a b. (a -> b) -> a -> b
$ VName -> Name
baseName forall a b. (a -> b) -> a -> b
$ Ident -> VName
identName Ident
ident)
(Ident -> Type
identType Ident
ident)
newParam ::
MonadFreshNames m =>
String ->
dec ->
m (Param dec)
newParam :: forall (m :: * -> *) dec.
MonadFreshNames m =>
String -> dec -> m (Param dec)
newParam String
s dec
t = do
VName
s' <- forall (m :: * -> *). MonadFreshNames m => Name -> m VName
newID forall a b. (a -> b) -> a -> b
$ String -> Name
nameFromString String
s
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall dec. Attrs -> VName -> dec -> Param dec
Param forall a. Monoid a => a
mempty VName
s' dec
t
instance MonadFreshNames m => MonadFreshNames (ReaderT s m) where
getNameSource :: ReaderT s 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 -> ReaderT s 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
(MonadFreshNames m, Monoid s) =>
MonadFreshNames (Control.Monad.Writer.Lazy.WriterT s m)
where
getNameSource :: WriterT s 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 -> WriterT s 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
(MonadFreshNames m, Monoid s) =>
MonadFreshNames (Control.Monad.Writer.Strict.WriterT s m)
where
getNameSource :: WriterT s 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 -> WriterT s 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
MonadFreshNames m =>
MonadFreshNames (Control.Monad.Trans.Maybe.MaybeT m)
where
getNameSource :: MaybeT 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 -> MaybeT 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
MonadFreshNames m =>
MonadFreshNames (ExceptT e m)
where
getNameSource :: ExceptT e 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 -> ExceptT e 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