module Clash.Normalize.Strategy where
import Clash.Normalize.Transformations
import Clash.Normalize.Types
import Clash.Rewrite.Combinators
import Clash.Rewrite.Types
import Clash.Rewrite.Util
normalization :: NormRewrite
normalization :: NormRewrite
normalization = NormRewrite
rmDeadcode NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-> NormRewrite
constantPropagation NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-> NormRewrite
rmUnusedExpr NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-!-> NormRewrite
anf NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-!-> NormRewrite
rmDeadcode NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>->
NormRewrite
bindConst NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-> NormRewrite
letTL NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-> NormRewrite
evalConst NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-!-> NormRewrite
cse NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-!-> NormRewrite
cleanup NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>->
NormRewrite
xOptim NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-> NormRewrite
rmDeadcode NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>->
NormRewrite
cleanup NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-> NormRewrite
recLetRec NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-> NormRewrite
splitArgs
where
anf :: NormRewrite
anf = NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m
topdownR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "nonRepANF" HasCallStack => NormRewrite
NormRewrite
nonRepANF) NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-> String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "ANF" HasCallStack => NormRewrite
NormRewrite
makeANF NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-> NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m
topdownR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "caseCon" HasCallStack => NormRewrite
NormRewrite
caseCon)
letTL :: NormRewrite
letTL = NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m
topdownSucR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "topLet" HasCallStack => NormRewrite
NormRewrite
topLet)
recLetRec :: NormRewrite
recLetRec = String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "recToLetRec" HasCallStack => NormRewrite
NormRewrite
recToLetRec
rmUnusedExpr :: NormRewrite
rmUnusedExpr = NormRewrite -> NormRewrite
forall (m :: Type -> Type). Monad m => Transform m -> Transform m
bottomupR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "removeUnusedExpr" HasCallStack => NormRewrite
NormRewrite
removeUnusedExpr)
rmDeadcode :: NormRewrite
rmDeadcode = NormRewrite -> NormRewrite
forall (m :: Type -> Type). Monad m => Transform m -> Transform m
bottomupR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "deadcode" HasCallStack => NormRewrite
NormRewrite
deadCode)
bindConst :: NormRewrite
bindConst = NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m
topdownR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "bindConstantVar" HasCallStack => NormRewrite
NormRewrite
bindConstantVar)
evalConst :: NormRewrite
evalConst = NormRewrite -> NormRewrite
forall (m :: Type -> Type). Monad m => Transform m -> Transform m
bottomupR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "evalConst" HasCallStack => NormRewrite
NormRewrite
reduceConst)
cse :: NormRewrite
cse = NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m
topdownR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "CSE" HasCallStack => NormRewrite
NormRewrite
simpleCSE)
xOptim :: NormRewrite
xOptim = NormRewrite -> NormRewrite
forall (m :: Type -> Type). Monad m => Transform m -> Transform m
bottomupR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "xOptimize" HasCallStack => NormRewrite
NormRewrite
xOptimize)
cleanup :: NormRewrite
cleanup = NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m
topdownR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "etaExpandSyn" HasCallStack => NormRewrite
NormRewrite
etaExpandSyn) NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>->
NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m
topdownSucR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "inlineCleanup" HasCallStack => NormRewrite
NormRewrite
inlineCleanup) NormRewrite -> NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m -> Rewrite m
!->
NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m
innerMost ([(String, NormRewrite)] -> NormRewrite
forall extra. [(String, Rewrite extra)] -> Rewrite extra
applyMany [("caseCon" , HasCallStack => NormRewrite
NormRewrite
caseCon)
,("bindConstantVar", HasCallStack => NormRewrite
NormRewrite
bindConstantVar)
,("letFlat" , HasCallStack => NormRewrite
NormRewrite
flattenLet)])
NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-> NormRewrite
rmDeadcode NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-> NormRewrite
letTL
splitArgs :: NormRewrite
splitArgs = NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m
topdownR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "separateArguments" HasCallStack => NormRewrite
NormRewrite
separateArguments) NormRewrite -> NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m -> Rewrite m
!->
NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m
topdownR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "caseCon" HasCallStack => NormRewrite
NormRewrite
caseCon)
constantPropagation :: NormRewrite
constantPropagation :: NormRewrite
constantPropagation = NormRewrite
inlineAndPropagate NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>->
NormRewrite
caseFlattening NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-> NormRewrite
etaTL NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-> NormRewrite
dec NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-> NormRewrite
spec NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-> NormRewrite
dec NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>->
NormRewrite
conSpec
where
etaTL :: NormRewrite
etaTL = String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "etaTL" HasCallStack => NormRewrite
NormRewrite
etaExpansionTL NormRewrite -> NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m -> Rewrite m
!-> NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m
topdownR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "applicationPropagation" HasCallStack => NormRewrite
NormRewrite
appPropFast)
inlineAndPropagate :: NormRewrite
inlineAndPropagate = NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m
repeatR (NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m
topdownR ([(String, NormRewrite)] -> NormRewrite
forall extra. [(String, Rewrite extra)] -> Rewrite extra
applyMany [(String, NormRewrite)]
transPropagateAndInline) NormRewrite -> NormRewrite -> NormRewrite
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
>-> NormRewrite
inlineNR)
spec :: NormRewrite
spec = NormRewrite -> NormRewrite
forall (m :: Type -> Type). Monad m => Transform m -> Transform m
bottomupR ([(String, NormRewrite)] -> NormRewrite
forall extra. [(String, Rewrite extra)] -> Rewrite extra
applyMany [(String, NormRewrite)]
specTransformations)
caseFlattening :: NormRewrite
caseFlattening = NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m
repeatR (NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m
topdownR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "caseFlat" HasCallStack => NormRewrite
NormRewrite
caseFlat))
dec :: NormRewrite
dec = NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m
repeatR (NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m
topdownR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "DEC" HasCallStack => NormRewrite
NormRewrite
disjointExpressionConsolidation))
conSpec :: NormRewrite
conSpec = NormRewrite -> NormRewrite
forall (m :: Type -> Type). Monad m => Transform m -> Transform m
bottomupR ((String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "appPropCS" HasCallStack => NormRewrite
NormRewrite
appPropFast NormRewrite -> NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m -> Rewrite m
!->
NormRewrite -> NormRewrite
forall (m :: Type -> Type). Monad m => Transform m -> Transform m
bottomupR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "constantSpec" HasCallStack => NormRewrite
NormRewrite
constantSpec)) NormRewrite -> NormRewrite -> NormRewrite
forall m. Rewrite m -> Rewrite m -> Rewrite m
>-!
String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "constantSpec" HasCallStack => NormRewrite
NormRewrite
constantSpec)
transPropagateAndInline :: [(String,NormRewrite)]
transPropagateAndInline :: [(String, NormRewrite)]
transPropagateAndInline =
[ ("applicationPropagation", HasCallStack => NormRewrite
NormRewrite
appPropFast )
, ("bindConstantVar" , HasCallStack => NormRewrite
NormRewrite
bindConstantVar )
, ("caseLet" , HasCallStack => NormRewrite
NormRewrite
caseLet )
, ("caseCase" , HasCallStack => NormRewrite
NormRewrite
caseCase )
, ("caseCon" , HasCallStack => NormRewrite
NormRewrite
caseCon )
, ("elemExistentials" , HasCallStack => NormRewrite
NormRewrite
elemExistentials )
, ("caseElemNonReachable" , HasCallStack => NormRewrite
NormRewrite
caseElemNonReachable )
, ("removeUnusedExpr" , HasCallStack => NormRewrite
NormRewrite
removeUnusedExpr )
, ("inlineWorkFree" , HasCallStack => NormRewrite
NormRewrite
inlineWorkFree)
, ("inlineSmall" , HasCallStack => NormRewrite
NormRewrite
inlineSmall)
, ("bindOrLiftNonRep", HasCallStack => NormRewrite
NormRewrite
inlineOrLiftNonRep)
, ("reduceNonRepPrim", HasCallStack => NormRewrite
NormRewrite
reduceNonRepPrim)
, ("caseCast" , HasCallStack => NormRewrite
NormRewrite
caseCast)
, ("letCast" , HasCallStack => NormRewrite
NormRewrite
letCast)
, ("splitCastWork" , HasCallStack => NormRewrite
NormRewrite
splitCastWork)
, ("argCastSpec" , HasCallStack => NormRewrite
NormRewrite
argCastSpec)
, ("inlineCast" , HasCallStack => NormRewrite
NormRewrite
inlineCast)
, ("eliminateCastCast",HasCallStack => NormRewrite
NormRewrite
eliminateCastCast)
]
inlineNR :: NormRewrite
inlineNR :: NormRewrite
inlineNR = NormRewrite -> NormRewrite
forall (m :: Type -> Type). Monad m => Transform m -> Transform m
bottomupR (String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply "inlineNonRep" HasCallStack => NormRewrite
NormRewrite
inlineNonRep)
specTransformations :: [(String,NormRewrite)]
specTransformations :: [(String, NormRewrite)]
specTransformations =
[ ("typeSpec" , HasCallStack => NormRewrite
NormRewrite
typeSpec)
, ("nonRepSpec" , HasCallStack => NormRewrite
NormRewrite
nonRepSpec)
]
topdownSucR :: Rewrite extra -> Rewrite extra
topdownSucR :: Rewrite extra -> Rewrite extra
topdownSucR r :: Rewrite extra
r = Rewrite extra
r Rewrite extra -> Rewrite extra -> Rewrite extra
forall m. Rewrite m -> Rewrite m -> Rewrite m
>-! (Rewrite extra -> Rewrite extra
forall (m :: Type -> Type). Monad m => Transform m -> Transform m
allR (Rewrite extra -> Rewrite extra
forall m. Rewrite m -> Rewrite m
topdownSucR Rewrite extra
r))
{-# INLINE topdownSucR #-}
topdownRR :: Rewrite extra -> Rewrite extra
topdownRR :: Rewrite extra -> Rewrite extra
topdownRR r :: Rewrite extra
r = Rewrite extra -> Rewrite extra
forall m. Rewrite m -> Rewrite m
repeatR (Rewrite extra -> Rewrite extra
forall m. Rewrite m -> Rewrite m
topdownR Rewrite extra
r)
{-# INLINE topdownRR #-}
innerMost :: Rewrite extra -> Rewrite extra
innerMost :: Rewrite extra -> Rewrite extra
innerMost = let go :: Rewrite extra -> Rewrite extra
go r :: Rewrite extra
r = Rewrite extra -> Rewrite extra
forall (m :: Type -> Type). Monad m => Transform m -> Transform m
bottomupR (Rewrite extra
r Rewrite extra -> Rewrite extra -> Rewrite extra
forall m. Rewrite m -> Rewrite m -> Rewrite m
!-> Rewrite extra -> Rewrite extra
forall m. Rewrite m -> Rewrite m
innerMost Rewrite extra
r) in Rewrite extra -> Rewrite extra
forall m. Rewrite m -> Rewrite m
go
{-# INLINE innerMost #-}
applyMany :: [(String,Rewrite extra)] -> Rewrite extra
applyMany :: [(String, Rewrite extra)] -> Rewrite extra
applyMany = (Rewrite extra -> Rewrite extra -> Rewrite extra)
-> [Rewrite extra] -> Rewrite extra
forall (t :: Type -> Type) a.
Foldable t =>
(a -> a -> a) -> t a -> a
foldr1 Rewrite extra -> Rewrite extra -> Rewrite extra
forall (m :: Type -> Type).
Monad m =>
Transform m -> Transform m -> Transform m
(>->) ([Rewrite extra] -> Rewrite extra)
-> ([(String, Rewrite extra)] -> [Rewrite extra])
-> [(String, Rewrite extra)]
-> Rewrite extra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Rewrite extra) -> Rewrite extra)
-> [(String, Rewrite extra)] -> [Rewrite extra]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Rewrite extra -> Rewrite extra)
-> (String, Rewrite extra) -> Rewrite extra
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Rewrite extra -> Rewrite extra
forall extra. String -> Rewrite extra -> Rewrite extra
apply)
{-# INLINE applyMany #-}