{-# LANGUAGE Rank2Types, PatternGuards #-}
module Language.Netlist.Inline ( inlineModule ) where
import Data.Generics
import Data.Maybe
import Data.Map (Map)
import qualified Data.Map as Map
import Language.Netlist.AST
inlineModule :: Module -> Module
inlineModule :: Module -> Module
inlineModule (Module Ident
name [(Ident, Maybe Range)]
inputs [(Ident, Maybe Range)]
outputs [(Ident, ConstExpr)]
statics [Decl]
decls)
= Ident
-> [(Ident, Maybe Range)]
-> [(Ident, Maybe Range)]
-> [(Ident, ConstExpr)]
-> [Decl]
-> Module
Module Ident
name [(Ident, Maybe Range)]
inputs [(Ident, Maybe Range)]
outputs [(Ident, ConstExpr)]
statics [Decl]
decls''
where
deps :: Map Ident [ConstExpr]
deps = [Decl] -> Map Ident [ConstExpr]
forall a. Data a => a -> Map Ident [ConstExpr]
getIdentExprs [Decl]
decls
bs :: Map Ident ConstExpr
bs = [Decl] -> Map Ident ConstExpr
getBindings [Decl]
decls
bs' :: Map Ident ConstExpr
bs' = (Ident -> ConstExpr -> Bool)
-> Map Ident ConstExpr -> Map Ident ConstExpr
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey ([Ident] -> Map Ident [ConstExpr] -> Ident -> ConstExpr -> Bool
shouldInline (((Ident, Maybe Range) -> Ident)
-> [(Ident, Maybe Range)] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map (Ident, Maybe Range) -> Ident
forall a b. (a, b) -> a
fst [(Ident, Maybe Range)]
outputs) Map Ident [ConstExpr]
deps) Map Ident ConstExpr
bs
decls' :: [Decl]
decls' = Map Ident ConstExpr -> [Decl] -> [Decl]
forall a. Data a => Map Ident ConstExpr -> a -> a
replaceExprs Map Ident ConstExpr
bs' [Decl]
decls
decls'' :: [Decl]
decls'' = [Ident] -> [Decl] -> [Decl]
removeDecls (Map Ident ConstExpr -> [Ident]
forall k a. Map k a -> [k]
Map.keys Map Ident ConstExpr
bs') [Decl]
decls'
replaceExprs :: forall a. (Data a) => Map Ident Expr -> a -> a
replaceExprs :: Map Ident ConstExpr -> a -> a
replaceExprs Map Ident ConstExpr
bs a
a = (forall a. Data a => a -> a) -> a -> a
(forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere' ((ConstExpr -> ConstExpr) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT ConstExpr -> ConstExpr
f) a
a
where
f :: ConstExpr -> ConstExpr
f ConstExpr
e
| ExprVar Ident
x <- ConstExpr
e, Just ConstExpr
e' <- Ident -> Map Ident ConstExpr -> Maybe ConstExpr
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
x Map Ident ConstExpr
bs
= ConstExpr
e'
| Bool
otherwise = ConstExpr
e
removeDecls :: [Ident] -> [Decl] -> [Decl]
removeDecls :: [Ident] -> [Decl] -> [Decl]
removeDecls [Ident]
xs = (Decl -> Maybe Decl) -> [Decl] -> [Decl]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Decl -> Maybe Decl
f
where
f :: Decl -> Maybe Decl
f d :: Decl
d@(NetDecl Ident
x Maybe Range
_ Maybe ConstExpr
_)
= if Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Ident
x [Ident]
xs then Maybe Decl
forall a. Maybe a
Nothing else Decl -> Maybe Decl
forall a. a -> Maybe a
Just Decl
d
f d :: Decl
d@(NetAssign Ident
x ConstExpr
_)
= if Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Ident
x [Ident]
xs then Maybe Decl
forall a. Maybe a
Nothing else Decl -> Maybe Decl
forall a. a -> Maybe a
Just Decl
d
f Decl
decl
= Decl -> Maybe Decl
forall a. a -> Maybe a
Just Decl
decl
getBindings :: [Decl] -> Map Ident Expr
getBindings :: [Decl] -> Map Ident ConstExpr
getBindings = [Map Ident ConstExpr] -> Map Ident ConstExpr
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions ([Map Ident ConstExpr] -> Map Ident ConstExpr)
-> ([Decl] -> [Map Ident ConstExpr])
-> [Decl]
-> Map Ident ConstExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Decl -> Map Ident ConstExpr) -> [Decl] -> [Map Ident ConstExpr]
forall a b. (a -> b) -> [a] -> [b]
map Decl -> Map Ident ConstExpr
getDeclBinding
getDeclBinding :: Decl -> Map Ident Expr
getDeclBinding :: Decl -> Map Ident ConstExpr
getDeclBinding (NetDecl Ident
x Maybe Range
_ (Just ConstExpr
expr))
= Ident -> ConstExpr -> Map Ident ConstExpr
forall k a. k -> a -> Map k a
Map.singleton Ident
x ConstExpr
expr
getDeclBinding (NetAssign Ident
x ConstExpr
expr)
= Ident -> ConstExpr -> Map Ident ConstExpr
forall k a. k -> a -> Map k a
Map.singleton Ident
x ConstExpr
expr
getDeclBinding Decl
_
= Map Ident ConstExpr
forall k a. Map k a
Map.empty
shouldInline :: [Ident] -> Map Ident [Expr] -> Ident -> Expr -> Bool
shouldInline :: [Ident] -> Map Ident [ConstExpr] -> Ident -> ConstExpr -> Bool
shouldInline [Ident]
ignore Map Ident [ConstExpr]
deps Ident
x ConstExpr
e
| Ident
x Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Ident]
ignore, Just Int
n <- Maybe Int
checkUsers
= case ConstExpr
e of
ExprLit Maybe Int
_ ExprLit
_ -> Bool
True
ExprString Ident
_ -> Bool
True
ExprVar Ident
_ -> Bool
True
ExprIndex Ident
_ ConstExpr
_ -> Bool
True
ExprSlice Ident
_ ConstExpr
_ ConstExpr
_ -> Bool
True
ExprCase {} -> Bool
False
ConstExpr
_ -> Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
| Bool
otherwise
= Bool
False
where
checkUsers :: Maybe Int
checkUsers
= if (ConstExpr -> Bool) -> [ConstExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ConstExpr -> Bool
checkUser [ConstExpr]
zs then Int -> Maybe Int
forall a. a -> Maybe a
Just ([ConstExpr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ConstExpr]
zs) else Maybe Int
forall a. Maybe a
Nothing
where
zs :: [ConstExpr]
zs = [ConstExpr] -> Maybe [ConstExpr] -> [ConstExpr]
forall a. a -> Maybe a -> a
fromMaybe [] (Ident -> Map Ident [ConstExpr] -> Maybe [ConstExpr]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
x Map Ident [ConstExpr]
deps)
checkUser :: ConstExpr -> Bool
checkUser (ExprVar Ident
_) = Bool
True
checkUser ConstExpr
_ = Bool
False
getIdentExprs :: forall a. (Data a) => a -> Map Ident [Expr]
getIdentExprs :: a -> Map Ident [ConstExpr]
getIdentExprs a
a = Map Ident [ConstExpr] -> [ConstExpr] -> Map Ident [ConstExpr]
f Map Ident [ConstExpr]
forall k a. Map k a
Map.empty (a -> [ConstExpr]
forall a b. (Data a, Typeable b) => a -> [b]
getAll a
a)
where
f :: Map Ident [Expr] -> [Expr] -> Map Ident [Expr]
f :: Map Ident [ConstExpr] -> [ConstExpr] -> Map Ident [ConstExpr]
f Map Ident [ConstExpr]
m [] = Map Ident [ConstExpr]
m
f Map Ident [ConstExpr]
m (ConstExpr
expr:[ConstExpr]
rest)
= Map Ident [ConstExpr] -> [ConstExpr] -> Map Ident [ConstExpr]
f Map Ident [ConstExpr]
m' [ConstExpr]
rest
where m' :: Map Ident [ConstExpr]
m' = case ConstExpr -> Maybe Ident
maybeExprIdent ConstExpr
expr of
Just Ident
v -> ([ConstExpr] -> [ConstExpr] -> [ConstExpr])
-> Ident
-> [ConstExpr]
-> Map Ident [ConstExpr]
-> Map Ident [ConstExpr]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [ConstExpr] -> [ConstExpr] -> [ConstExpr]
forall a. [a] -> [a] -> [a]
(++) Ident
v [ConstExpr
expr] Map Ident [ConstExpr]
m
Maybe Ident
Nothing -> Map Ident [ConstExpr]
m
getAll :: forall a b. (Data a, Typeable b) => a -> [b]
getAll :: a -> [b]
getAll = (b -> Bool) -> GenericQ [b]
forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify (\b
_ -> Bool
True)
maybeExprIdent :: Expr -> Maybe Ident
maybeExprIdent :: ConstExpr -> Maybe Ident
maybeExprIdent (ExprVar Ident
x) = Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
x
maybeExprIdent (ExprIndex Ident
x ConstExpr
_) = Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
x
maybeExprIdent (ExprSlice Ident
x ConstExpr
_ ConstExpr
_) = Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
x
maybeExprIdent (ExprSliceOff Ident
x ConstExpr
_ Int
_) = Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
x
maybeExprIdent (ExprFunCall Ident
x [ConstExpr]
_) = Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
x
maybeExprIdent ConstExpr
_ = Maybe Ident
forall a. Maybe a
Nothing