{-# LANGUAGE GADTs #-}
{-# LANGUAGE ConstraintKinds #-}
-- | Facilities for changing the lore of some fragment, with no context.
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
  }