--------------------------------------------------------------------------------
-- |
-- Module       :  Language.Netlist.Inline
-- Copyright    :  (c) Signali Corp. 2010
-- License      :  All rights reserved
--
-- Maintainer   : pweaver@signalicorp.com
-- Stability    : experimental
-- Portability  : non-portable
--
-- A simple inliner for a Netlist AST ('Language.Netlist.AST').
--------------------------------------------------------------------------------

{-# LANGUAGE Rank2Types, PatternGuards #-}

module Language.Netlist.Inline ( inlineModule ) where

import Data.Generics
--import Data.List
import Data.Maybe
import Data.Map (Map)
import qualified Data.Map as Map

import Language.Netlist.AST

-- -----------------------------------------------------------------------------

-- | Produce a new module in which some variables have been inlined.  An
-- expression is inlined (and it\'s declaration removed) if it only used in one
-- place in the entire module.
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'

-- given a list of identifier-to-expression bindings, replace the identifiers
-- everywhere in an AST.  Note: "everywhere" applies bottom-up.  We want
-- everywhere', which is top-down.
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' -- replaceExprs bs e'
      | Bool
otherwise      = ConstExpr
e

-- this is essentially a DCE pass.  it removes the declarations that have been inlined.
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

-- -----------------------------------------------------------------------------
-- utility functions

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
      -- always inline trivial expressions regardless of the number of users.
      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
      -- ExprSliceOff _ _ _        -> True

      -- never inline case expressions.  as far as we know, there's no case
      -- /expression/ in Verilog.  we leave ExprCase alone here so that it may
      -- be easier to translate to, for example, a case /statement/ in a
      -- combinational process in HDL.
      ExprCase {}               -> Bool
False

      -- any complex expressions should only be inlined if they're used once.
      ConstExpr
_                         -> Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1

  | Bool
otherwise
  = Bool
False
  where
    -- returns Nothing if this identifier cannot be inlined because it is
    -- referred to by a Index/Project/FuncCall.  returns Just n if the only
    -- users are 'n' number of ExprVar expressions.
    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

-- map each identifier to every expression that directly refers to that identifier.
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

-- generically get a list of all terms of a certain type.
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)

-- if an expression references an identifier directly, return the identifier.
-- note that subexpressions are not counted here!
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

-- -----------------------------------------------------------------------------