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 String
"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 String
"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 String
"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 String
"topLet" HasCallStack => NormRewrite
NormRewrite
topLet)
recLetRec :: NormRewrite
recLetRec = String -> NormRewrite -> NormRewrite
forall extra. String -> Rewrite extra -> Rewrite extra
apply String
"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 String
"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 String
"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 String
"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 String
"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 String
"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 String
"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 String
"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 String
"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 [(String
"caseCon" , HasCallStack => NormRewrite
NormRewrite
caseCon)
,(String
"bindConstantVar", HasCallStack => NormRewrite
NormRewrite
bindConstantVar)
,(String
"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 String
"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 String
"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 String
"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 String
"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 String
"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 String
"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 String
"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 String
"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 String
"constantSpec" HasCallStack => NormRewrite
NormRewrite
constantSpec)
transPropagateAndInline :: [(String,NormRewrite)]
transPropagateAndInline :: [(String, NormRewrite)]
transPropagateAndInline =
[ (String
"applicationPropagation", HasCallStack => NormRewrite
NormRewrite
appPropFast )
, (String
"bindConstantVar" , HasCallStack => NormRewrite
NormRewrite
bindConstantVar )
, (String
"caseLet" , HasCallStack => NormRewrite
NormRewrite
caseLet )
, (String
"caseCase" , HasCallStack => NormRewrite
NormRewrite
caseCase )
, (String
"caseCon" , HasCallStack => NormRewrite
NormRewrite
caseCon )
, (String
"elemExistentials" , HasCallStack => NormRewrite
NormRewrite
elemExistentials )
, (String
"caseElemNonReachable" , HasCallStack => NormRewrite
NormRewrite
caseElemNonReachable )
, (String
"removeUnusedExpr" , HasCallStack => NormRewrite
NormRewrite
removeUnusedExpr )
, (String
"inlineWorkFree" , HasCallStack => NormRewrite
NormRewrite
inlineWorkFree)
, (String
"inlineSmall" , HasCallStack => NormRewrite
NormRewrite
inlineSmall)
, (String
"bindOrLiftNonRep", HasCallStack => NormRewrite
NormRewrite
inlineOrLiftNonRep)
, (String
"reduceNonRepPrim", HasCallStack => NormRewrite
NormRewrite
reduceNonRepPrim)
, (String
"caseCast" , HasCallStack => NormRewrite
NormRewrite
caseCast)
, (String
"letCast" , HasCallStack => NormRewrite
NormRewrite
letCast)
, (String
"splitCastWork" , HasCallStack => NormRewrite
NormRewrite
splitCastWork)
, (String
"argCastSpec" , HasCallStack => NormRewrite
NormRewrite
argCastSpec)
, (String
"inlineCast" , HasCallStack => NormRewrite
NormRewrite
inlineCast)
, (String
"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 String
"inlineNonRep" HasCallStack => NormRewrite
NormRewrite
inlineNonRep)
specTransformations :: [(String,NormRewrite)]
specTransformations :: [(String, NormRewrite)]
specTransformations =
[ (String
"typeSpec" , HasCallStack => NormRewrite
NormRewrite
typeSpec)
, (String
"nonRepSpec" , HasCallStack => NormRewrite
NormRewrite
nonRepSpec)
]
topdownSucR :: Rewrite extra -> Rewrite extra
topdownSucR :: Rewrite extra -> Rewrite extra
topdownSucR 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 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 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 #-}