{-# LANGUAGE GADTs #-}
{-# LANGUAGE ConstraintKinds #-}
module Futhark.Analysis.Rephrase
( rephraseProg
, rephraseFunDef
, rephraseExp
, rephraseBody
, rephraseStm
, rephraseLambda
, rephrasePattern
, rephrasePatElem
, Rephraser (..)
)
where
import Futhark.Representation.AST
data Rephraser m from to
= Rephraser { Rephraser m from to -> ExpAttr from -> m (ExpAttr to)
rephraseExpLore :: ExpAttr from -> m (ExpAttr to)
, Rephraser m from to -> LetAttr from -> m (LetAttr to)
rephraseLetBoundLore :: LetAttr from -> m (LetAttr to)
, Rephraser m from to -> FParamAttr from -> m (FParamAttr to)
rephraseFParamLore :: FParamAttr from -> m (FParamAttr to)
, Rephraser m from to -> LParamAttr from -> m (LParamAttr to)
rephraseLParamLore :: LParamAttr from -> m (LParamAttr to)
, Rephraser m from to -> BodyAttr from -> m (BodyAttr to)
rephraseBodyLore :: BodyAttr from -> m (BodyAttr to)
, Rephraser m from to -> RetType from -> m (RetType to)
rephraseRetType :: RetType from -> m (RetType to)
, Rephraser m from to -> BranchType from -> m (BranchType to)
rephraseBranchType :: BranchType from -> m (BranchType to)
, Rephraser m from to -> Op from -> m (Op to)
rephraseOp :: Op from -> m (Op to)
}
rephraseProg :: Monad m => Rephraser m from to -> Prog from -> m (Prog to)
rephraseProg :: Rephraser m from to -> Prog from -> m (Prog to)
rephraseProg Rephraser m from to
rephraser (Prog Stms from
consts [FunDef from]
funs) =
Stms to -> [FunDef to] -> Prog to
forall lore. Stms lore -> [FunDef lore] -> Prog lore
Prog
(Stms to -> [FunDef to] -> Prog to)
-> m (Stms to) -> m ([FunDef to] -> Prog to)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Stm from -> m (Stm to)) -> Stms from -> m (Stms to)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Rephraser m from to -> Stm from -> m (Stm to)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Stm from -> m (Stm to)
rephraseStm Rephraser m from to
rephraser) Stms from
consts
m ([FunDef to] -> Prog to) -> m [FunDef to] -> m (Prog to)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FunDef from -> m (FunDef to)) -> [FunDef from] -> m [FunDef to]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Rephraser m from to -> FunDef from -> m (FunDef to)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> FunDef from -> m (FunDef to)
rephraseFunDef Rephraser m from to
rephraser) [FunDef from]
funs
rephraseFunDef :: Monad m => Rephraser m from to -> FunDef from -> m (FunDef to)
rephraseFunDef :: Rephraser m from to -> FunDef from -> m (FunDef to)
rephraseFunDef Rephraser m from to
rephraser FunDef from
fundec = do
Body to
body' <- Rephraser m from to -> Body from -> m (Body to)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Body from -> m (Body to)
rephraseBody Rephraser m from to
rephraser (Body from -> m (Body to)) -> Body from -> m (Body to)
forall a b. (a -> b) -> a -> b
$ FunDef from -> Body from
forall lore. FunDef lore -> BodyT lore
funDefBody FunDef from
fundec
[Param (FParamAttr to)]
params' <- (Param (FParamAttr from) -> m (Param (FParamAttr to)))
-> [Param (FParamAttr from)] -> m [Param (FParamAttr to)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((FParamAttr from -> m (FParamAttr to))
-> Param (FParamAttr from) -> m (Param (FParamAttr to))
forall (m :: * -> *) from to.
Monad m =>
(from -> m to) -> Param from -> m (Param to)
rephraseParam ((FParamAttr from -> m (FParamAttr to))
-> Param (FParamAttr from) -> m (Param (FParamAttr to)))
-> (FParamAttr from -> m (FParamAttr to))
-> Param (FParamAttr from)
-> m (Param (FParamAttr to))
forall a b. (a -> b) -> a -> b
$ Rephraser m from to -> FParamAttr from -> m (FParamAttr to)
forall (m :: * -> *) from to.
Rephraser m from to -> FParamAttr from -> m (FParamAttr to)
rephraseFParamLore Rephraser m from to
rephraser) ([Param (FParamAttr from)] -> m [Param (FParamAttr to)])
-> [Param (FParamAttr from)] -> m [Param (FParamAttr to)]
forall a b. (a -> b) -> a -> b
$ FunDef from -> [Param (FParamAttr from)]
forall lore. FunDef lore -> [FParam lore]
funDefParams FunDef from
fundec
[RetType to]
rettype' <- (RetType from -> m (RetType to))
-> [RetType from] -> m [RetType to]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Rephraser m from to -> RetType from -> m (RetType to)
forall (m :: * -> *) from to.
Rephraser m from to -> RetType from -> m (RetType to)
rephraseRetType Rephraser m from to
rephraser) ([RetType from] -> m [RetType to])
-> [RetType from] -> m [RetType to]
forall a b. (a -> b) -> a -> b
$ FunDef from -> [RetType from]
forall lore. FunDef lore -> [RetType lore]
funDefRetType FunDef from
fundec
FunDef to -> m (FunDef to)
forall (m :: * -> *) a. Monad m => a -> m a
return FunDef from
fundec { funDefBody :: Body to
funDefBody = Body to
body', funDefParams :: [Param (FParamAttr to)]
funDefParams = [Param (FParamAttr to)]
params', funDefRetType :: [RetType to]
funDefRetType = [RetType to]
rettype' }
rephraseExp :: Monad m => Rephraser m from to -> Exp from -> m (Exp to)
rephraseExp :: Rephraser m from to -> Exp from -> m (Exp to)
rephraseExp = Mapper from to m -> Exp from -> m (Exp to)
forall (m :: * -> *) flore tlore.
(Applicative m, Monad m) =>
Mapper flore tlore m -> Exp flore -> m (Exp tlore)
mapExpM (Mapper from to m -> Exp from -> m (Exp to))
-> (Rephraser m from to -> Mapper from to m)
-> Rephraser m from to
-> Exp from
-> m (Exp to)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rephraser m from to -> Mapper from to m
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Mapper from to m
mapper
rephraseStm :: Monad m => Rephraser m from to -> Stm from -> m (Stm to)
rephraseStm :: Rephraser m from to -> Stm from -> m (Stm to)
rephraseStm Rephraser m from to
rephraser (Let Pattern from
pat (StmAux Certificates
cs ExpAttr from
attr) Exp from
e) =
Pattern to -> StmAux (ExpAttr to) -> Exp to -> Stm to
forall lore.
Pattern lore -> StmAux (ExpAttr lore) -> Exp lore -> Stm lore
Let (Pattern to -> StmAux (ExpAttr to) -> Exp to -> Stm to)
-> m (Pattern to) -> m (StmAux (ExpAttr to) -> Exp to -> Stm to)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(LetAttr from -> m (LetAttr to)) -> Pattern from -> m (Pattern to)
forall (m :: * -> *) from to.
Monad m =>
(from -> m to) -> PatternT from -> m (PatternT to)
rephrasePattern (Rephraser m from to -> LetAttr from -> m (LetAttr to)
forall (m :: * -> *) from to.
Rephraser m from to -> LetAttr from -> m (LetAttr to)
rephraseLetBoundLore Rephraser m from to
rephraser) Pattern from
pat m (StmAux (ExpAttr to) -> Exp to -> Stm to)
-> m (StmAux (ExpAttr to)) -> m (Exp to -> Stm to)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Certificates -> ExpAttr to -> StmAux (ExpAttr to)
forall attr. Certificates -> attr -> StmAux attr
StmAux Certificates
cs (ExpAttr to -> StmAux (ExpAttr to))
-> m (ExpAttr to) -> m (StmAux (ExpAttr to))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rephraser m from to -> ExpAttr from -> m (ExpAttr to)
forall (m :: * -> *) from to.
Rephraser m from to -> ExpAttr from -> m (ExpAttr to)
rephraseExpLore Rephraser m from to
rephraser ExpAttr from
attr) m (Exp to -> Stm to) -> m (Exp to) -> m (Stm to)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
Rephraser m from to -> Exp from -> m (Exp to)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Exp from -> m (Exp to)
rephraseExp Rephraser m from to
rephraser Exp from
e
rephrasePattern :: Monad m =>
(from -> m to)
-> PatternT from
-> m (PatternT to)
rephrasePattern :: (from -> m to) -> PatternT from -> m (PatternT to)
rephrasePattern from -> m to
f (Pattern [PatElemT from]
context [PatElemT from]
values) =
[PatElemT to] -> [PatElemT to] -> PatternT to
forall attr. [PatElemT attr] -> [PatElemT attr] -> PatternT attr
Pattern ([PatElemT to] -> [PatElemT to] -> PatternT to)
-> m [PatElemT to] -> m ([PatElemT to] -> PatternT to)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PatElemT from] -> m [PatElemT to]
rephrase [PatElemT from]
context m ([PatElemT to] -> PatternT to)
-> m [PatElemT to] -> m (PatternT to)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [PatElemT from] -> m [PatElemT to]
rephrase [PatElemT from]
values
where rephrase :: [PatElemT from] -> m [PatElemT to]
rephrase = (PatElemT from -> m (PatElemT to))
-> [PatElemT from] -> m [PatElemT to]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((PatElemT from -> m (PatElemT to))
-> [PatElemT from] -> m [PatElemT to])
-> (PatElemT from -> m (PatElemT to))
-> [PatElemT from]
-> m [PatElemT to]
forall a b. (a -> b) -> a -> b
$ (from -> m to) -> PatElemT from -> m (PatElemT to)
forall (m :: * -> *) from to.
Monad m =>
(from -> m to) -> PatElemT from -> m (PatElemT to)
rephrasePatElem from -> m to
f
rephrasePatElem :: Monad m => (from -> m to) -> PatElemT from -> m (PatElemT to)
rephrasePatElem :: (from -> m to) -> PatElemT from -> m (PatElemT to)
rephrasePatElem from -> m to
rephraser (PatElem VName
ident from
from) =
VName -> to -> PatElemT to
forall attr. VName -> attr -> PatElemT attr
PatElem VName
ident (to -> PatElemT to) -> m to -> m (PatElemT to)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> from -> m to
rephraser from
from
rephraseParam :: Monad m => (from -> m to) -> Param from -> m (Param to)
rephraseParam :: (from -> m to) -> Param from -> m (Param to)
rephraseParam from -> m to
rephraser (Param VName
name from
from) =
VName -> to -> Param to
forall attr. VName -> attr -> Param attr
Param VName
name (to -> Param to) -> m to -> m (Param to)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> from -> m to
rephraser from
from
rephraseBody :: Monad m => Rephraser m from to -> Body from -> m (Body to)
rephraseBody :: Rephraser m from to -> Body from -> m (Body to)
rephraseBody Rephraser m from to
rephraser (Body BodyAttr from
lore Stms from
bnds Result
res) =
BodyAttr to -> Stms to -> Result -> Body to
forall lore. BodyAttr lore -> Stms lore -> Result -> BodyT lore
Body (BodyAttr to -> Stms to -> Result -> Body to)
-> m (BodyAttr to) -> m (Stms to -> Result -> Body to)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Rephraser m from to -> BodyAttr from -> m (BodyAttr to)
forall (m :: * -> *) from to.
Rephraser m from to -> BodyAttr from -> m (BodyAttr to)
rephraseBodyLore Rephraser m from to
rephraser BodyAttr from
lore m (Stms to -> Result -> Body to)
-> m (Stms to) -> m (Result -> Body to)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
([Stm to] -> Stms to
forall lore. [Stm lore] -> Stms lore
stmsFromList ([Stm to] -> Stms to) -> m [Stm to] -> m (Stms to)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Stm from -> m (Stm to)) -> [Stm from] -> m [Stm to]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Rephraser m from to -> Stm from -> m (Stm to)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Stm from -> m (Stm to)
rephraseStm Rephraser m from to
rephraser) (Stms from -> [Stm from]
forall lore. Stms lore -> [Stm lore]
stmsToList Stms from
bnds)) m (Result -> Body to) -> m Result -> m (Body to)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
Result -> m Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
res
rephraseLambda :: Monad m => Rephraser m from to -> Lambda from -> m (Lambda to)
rephraseLambda :: Rephraser m from to -> Lambda from -> m (Lambda to)
rephraseLambda Rephraser m from to
rephraser Lambda from
lam = do
Body to
body' <- Rephraser m from to -> Body from -> m (Body to)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Body from -> m (Body to)
rephraseBody Rephraser m from to
rephraser (Body from -> m (Body to)) -> Body from -> m (Body to)
forall a b. (a -> b) -> a -> b
$ Lambda from -> Body from
forall lore. LambdaT lore -> BodyT lore
lambdaBody Lambda from
lam
[Param (LParamAttr to)]
params' <- (Param (LParamAttr from) -> m (Param (LParamAttr to)))
-> [Param (LParamAttr from)] -> m [Param (LParamAttr to)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((LParamAttr from -> m (LParamAttr to))
-> Param (LParamAttr from) -> m (Param (LParamAttr to))
forall (m :: * -> *) from to.
Monad m =>
(from -> m to) -> Param from -> m (Param to)
rephraseParam ((LParamAttr from -> m (LParamAttr to))
-> Param (LParamAttr from) -> m (Param (LParamAttr to)))
-> (LParamAttr from -> m (LParamAttr to))
-> Param (LParamAttr from)
-> m (Param (LParamAttr to))
forall a b. (a -> b) -> a -> b
$ Rephraser m from to -> LParamAttr from -> m (LParamAttr to)
forall (m :: * -> *) from to.
Rephraser m from to -> LParamAttr from -> m (LParamAttr to)
rephraseLParamLore Rephraser m from to
rephraser) ([Param (LParamAttr from)] -> m [Param (LParamAttr to)])
-> [Param (LParamAttr from)] -> m [Param (LParamAttr to)]
forall a b. (a -> b) -> a -> b
$ Lambda from -> [Param (LParamAttr from)]
forall lore. LambdaT lore -> [LParam lore]
lambdaParams Lambda from
lam
Lambda to -> m (Lambda to)
forall (m :: * -> *) a. Monad m => a -> m a
return Lambda from
lam { lambdaBody :: Body to
lambdaBody = Body to
body', lambdaParams :: [Param (LParamAttr to)]
lambdaParams = [Param (LParamAttr to)]
params' }
mapper :: Monad m => Rephraser m from to -> Mapper from to m
mapper :: Rephraser m from to -> Mapper from to m
mapper Rephraser m from to
rephraser = Mapper Any Any m
forall (m :: * -> *) lore. Monad m => Mapper lore lore m
identityMapper {
mapOnBody :: Scope to -> Body from -> m (Body to)
mapOnBody = (Body from -> m (Body to)) -> Scope to -> Body from -> m (Body to)
forall a b. a -> b -> a
const ((Body from -> m (Body to))
-> Scope to -> Body from -> m (Body to))
-> (Body from -> m (Body to))
-> Scope to
-> Body from
-> m (Body to)
forall a b. (a -> b) -> a -> b
$ Rephraser m from to -> Body from -> m (Body to)
forall (m :: * -> *) from to.
Monad m =>
Rephraser m from to -> Body from -> m (Body to)
rephraseBody Rephraser m from to
rephraser
, mapOnRetType :: RetType from -> m (RetType to)
mapOnRetType = Rephraser m from to -> RetType from -> m (RetType to)
forall (m :: * -> *) from to.
Rephraser m from to -> RetType from -> m (RetType to)
rephraseRetType Rephraser m from to
rephraser
, mapOnBranchType :: BranchType from -> m (BranchType to)
mapOnBranchType = Rephraser m from to -> BranchType from -> m (BranchType to)
forall (m :: * -> *) from to.
Rephraser m from to -> BranchType from -> m (BranchType to)
rephraseBranchType Rephraser m from to
rephraser
, mapOnFParam :: FParam from -> m (FParam to)
mapOnFParam = (FParamAttr from -> m (FParamAttr to))
-> FParam from -> m (FParam to)
forall (m :: * -> *) from to.
Monad m =>
(from -> m to) -> Param from -> m (Param to)
rephraseParam (Rephraser m from to -> FParamAttr from -> m (FParamAttr to)
forall (m :: * -> *) from to.
Rephraser m from to -> FParamAttr from -> m (FParamAttr to)
rephraseFParamLore Rephraser m from to
rephraser)
, mapOnLParam :: LParam from -> m (LParam to)
mapOnLParam = (LParamAttr from -> m (LParamAttr to))
-> LParam from -> m (LParam to)
forall (m :: * -> *) from to.
Monad m =>
(from -> m to) -> Param from -> m (Param to)
rephraseParam (Rephraser m from to -> LParamAttr from -> m (LParamAttr to)
forall (m :: * -> *) from to.
Rephraser m from to -> LParamAttr from -> m (LParamAttr to)
rephraseLParamLore Rephraser m from to
rephraser)
, mapOnOp :: Op from -> m (Op to)
mapOnOp = Rephraser m from to -> Op from -> m (Op to)
forall (m :: * -> *) from to.
Rephraser m from to -> Op from -> m (Op to)
rephraseOp Rephraser m from to
rephraser
}