mirror of
https://github.com/zachjs/sv2v.git
synced 2026-09-03 08:33:46 +02:00
directory re-org; streamline build setup
This commit is contained in:
Zachary Snow
@@ -0,0 +1,24 @@
|
||||
{- sv2v
|
||||
- Author: Zachary Snow <[email protected]>
|
||||
-
|
||||
- Conversion for `always_comb` and `always_ff`
|
||||
-}
|
||||
|
||||
module Convert.AlwaysKW (convert) where
|
||||
|
||||
import Convert.Traverse
|
||||
import Language.SystemVerilog.AST
|
||||
|
||||
convert :: AST -> AST
|
||||
convert = traverseDescriptions $ traverseModuleItems replaceAlwaysKW
|
||||
|
||||
-- Conversions:
|
||||
-- `always_comb` -> `always @*`
|
||||
-- `always_ff` -> `always`
|
||||
|
||||
replaceAlwaysKW :: ModuleItem -> ModuleItem
|
||||
replaceAlwaysKW (AlwaysC AlwaysComb stmt) =
|
||||
AlwaysC Always $ Timing SenseStar stmt
|
||||
replaceAlwaysKW (AlwaysC AlwaysFF stmt) =
|
||||
AlwaysC Always stmt
|
||||
replaceAlwaysKW other = other
|
||||
@@ -0,0 +1,57 @@
|
||||
{- sv2v
|
||||
- Author: Zachary Snow <[email protected]>
|
||||
-
|
||||
- Conversion for `casez` and `casex`
|
||||
-
|
||||
- Note that this conversion does not completely replicate the behavior of
|
||||
- `casex` and `casez` in cases where that case expression itself (rather than
|
||||
- just the case item patterns) contains wildcard values. This is apparently
|
||||
- rarely ever intentionally done.
|
||||
-}
|
||||
|
||||
module Convert.CaseKW (convert) where
|
||||
|
||||
import Convert.Traverse
|
||||
import Language.SystemVerilog.AST
|
||||
|
||||
convert :: AST -> AST
|
||||
convert = traverseDescriptions (traverseModuleItems (traverseStmts convertStmt))
|
||||
|
||||
-- Conversions:
|
||||
-- `casez` -> `case` with wildcards (?, z) expanded
|
||||
-- `casex` -> `case` with wildcards (?, z, x) expanded
|
||||
-- to be either 0 or 1
|
||||
|
||||
wildcards :: CaseKW -> [Char]
|
||||
wildcards CaseN = [] -- CaseN == `case`
|
||||
wildcards CaseZ = ['?', 'z', 'Z']
|
||||
wildcards CaseX = ['?', 'z', 'Z', 'x', 'X']
|
||||
|
||||
possibilities :: [Char]
|
||||
possibilities = ['0', '1']
|
||||
|
||||
explodeBy :: [Char] -> String -> [String]
|
||||
explodeBy _ "" = [""]
|
||||
explodeBy wilds (x : xs) =
|
||||
(map (:) chars) <*> (explodeBy wilds xs)
|
||||
where chars = if elem x wilds then possibilities else [x]
|
||||
|
||||
expandExpr :: [Char] -> Expr -> [Expr]
|
||||
expandExpr wilds (Number s) = map Number $ explodeBy wilds s
|
||||
expandExpr [] other = [other]
|
||||
-- TODO: Hopefully they only give us constant expressions...
|
||||
-- TODO: We could be given a constant identifier...
|
||||
expandExpr _ other = error $ "CaseKW conversion encountered case that was not a number, which is dubious..." ++ (show other)
|
||||
|
||||
-- Note that we don't have to convert the statements within the cases, as the
|
||||
-- conversion template takes care of that for us.
|
||||
convertStmt :: Stmt -> Stmt
|
||||
convertStmt (Case kw expr cases def) =
|
||||
Case CaseN expr cases' def
|
||||
where
|
||||
wilds = wildcards kw
|
||||
cases' = map convertCase cases
|
||||
convertCase :: Case -> Case
|
||||
convertCase (exprs, stmt) = (exprs', stmt)
|
||||
where exprs' = concat $ map (expandExpr wilds) exprs
|
||||
convertStmt other = other
|
||||
@@ -0,0 +1,46 @@
|
||||
{- sv2v
|
||||
- Author: Zachary Snow <[email protected]>
|
||||
-
|
||||
- Conversion for `logic`
|
||||
-}
|
||||
|
||||
-- Regarding `logic` conversion: The SystemVerilog grammar has the concept of a
|
||||
-- `data_declaration`, which seems to cover things much more generally. While
|
||||
-- obviously `logic` can appear as module items or ports, they can also be
|
||||
-- function arguments, for example.
|
||||
|
||||
-- It seems like logic only becomes reg if it is assigned to in an always block.
|
||||
|
||||
module Convert.Logic (convert) where
|
||||
|
||||
import Control.Monad.Writer
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import Convert.Traverse
|
||||
import Language.SystemVerilog.AST
|
||||
|
||||
type RegIdents = Set.Set String
|
||||
|
||||
convert :: AST -> AST
|
||||
convert = traverseDescriptions convertDescription
|
||||
|
||||
convertDescription :: Description -> Description
|
||||
convertDescription orig =
|
||||
traverseModuleItems convertModuleItem orig
|
||||
where
|
||||
idents = execWriter (collectModuleItemsM regIdents orig)
|
||||
convertModuleItem :: ModuleItem -> ModuleItem
|
||||
convertModuleItem (MIDecl (Variable dir (Logic mr) ident a me)) =
|
||||
MIDecl $ Variable dir (t mr) ident a me
|
||||
where t = if Set.member ident idents then Reg else Wire
|
||||
convertModuleItem other = other
|
||||
|
||||
regIdents :: ModuleItem -> Writer RegIdents ()
|
||||
regIdents (AlwaysC _ stmt) = collectStmtLHSsM idents stmt
|
||||
where
|
||||
idents :: LHS -> Writer RegIdents ()
|
||||
idents (LHS vx ) = tell $ Set.singleton vx
|
||||
idents (LHSBit vx _) = tell $ Set.singleton vx
|
||||
idents (LHSRange vx _) = tell $ Set.singleton vx
|
||||
idents (LHSConcat lhss) = mapM idents lhss >>= \_ -> return ()
|
||||
regIdents _ = return ()
|
||||
@@ -0,0 +1,285 @@
|
||||
{- sv2v
|
||||
- Author: Zachary Snow <[email protected]>
|
||||
-
|
||||
- Conversion for flattening multi-dimensional packed arrays
|
||||
-
|
||||
- This removes one dimension per identifier at a time. This works fine because
|
||||
- the conversions are repeatedly applied.
|
||||
-
|
||||
- TODO: This assumes that the first range index is the upper bound. We could
|
||||
- probably get arround this with some cleverness in the generate block. I don't
|
||||
- think it's urgent to have support for "backwards" ragnes.
|
||||
-}
|
||||
|
||||
module Convert.PackedArray (convert) where
|
||||
|
||||
import Control.Monad.State
|
||||
import Data.List (partition)
|
||||
import qualified Data.Map.Strict as Map
|
||||
|
||||
import Convert.Traverse
|
||||
import Language.SystemVerilog.AST
|
||||
|
||||
type DirMap = Map.Map Identifier Direction
|
||||
type DimMap = Map.Map Identifier (Type, Range)
|
||||
|
||||
convert :: AST -> AST
|
||||
convert = traverseDescriptions convertDescription
|
||||
|
||||
convertDescription :: Description -> Description
|
||||
convertDescription description =
|
||||
hoistPortDecls $
|
||||
traverseModuleItems (flattenModuleItem info . convertModuleItem dimMap') description
|
||||
where
|
||||
info = execState
|
||||
(collectModuleItemsM collectDecl description)
|
||||
(Map.empty, Map.empty)
|
||||
dimMap' = Map.restrictKeys (fst info) (Map.keysSet $ snd info)
|
||||
|
||||
-- collects port direction and packed-array dimension info into the state
|
||||
collectDecl :: ModuleItem -> State (DimMap, DirMap) ()
|
||||
collectDecl (MIDecl (Variable dir t ident _ _)) = do
|
||||
let (tf, rs) = typeDims t
|
||||
if length rs > 1
|
||||
then modify $ \(m, r) -> (Map.insert ident (tf $ tail rs, head rs) m, r)
|
||||
else return ()
|
||||
if dir /= Local
|
||||
then modify $ \(m, r) -> (m, Map.insert ident dir r)
|
||||
else return ()
|
||||
collectDecl _ = return ()
|
||||
|
||||
-- VCS doesn't like port declarations inside of `generate` blocks, so we hoist
|
||||
-- them out with this function. This obviously isn't ideal, but it's a
|
||||
-- relatively straightforward transformation, and testing in VCS is important.
|
||||
hoistPortDecls :: Description -> Description
|
||||
hoistPortDecls (Module name ports items) =
|
||||
Module name ports (concat $ map explode items)
|
||||
where
|
||||
explode :: ModuleItem -> [ModuleItem]
|
||||
explode (Generate genItems) =
|
||||
portDecls ++ [Generate rest]
|
||||
where
|
||||
(wrappedPortDecls, rest) = partition isPortDecl genItems
|
||||
portDecls = map (\(GenModuleItem item) -> item) wrappedPortDecls
|
||||
isPortDecl :: GenItem -> Bool
|
||||
isPortDecl (GenModuleItem (MIDecl (Variable dir _ _ _ _))) =
|
||||
dir /= Local
|
||||
isPortDecl _ = False
|
||||
explode other = [other]
|
||||
hoistPortDecls other = other
|
||||
|
||||
-- rewrite a module item if it contains a declaration to flatten
|
||||
flattenModuleItem :: (DimMap, DirMap) -> ModuleItem -> ModuleItem
|
||||
flattenModuleItem (dimMap, dirMap) (orig @ (MIDecl (Variable dir t ident a me))) =
|
||||
-- if it doesn't need any mapping
|
||||
if Map.notMember ident dimMap then
|
||||
-- Skip!
|
||||
orig
|
||||
-- if it's not a port
|
||||
else if Map.notMember ident dirMap then
|
||||
-- move the packed dimension to the unpacked side
|
||||
MIDecl $ Variable dir (tf $ tail rs) ident (a ++ [head rs]) me
|
||||
-- if it is a port, but it's not the typed declaration
|
||||
else if typeIsImplicit t then
|
||||
-- flatten the ranges
|
||||
newDecl -- see below
|
||||
-- if it is a port, and it is the typed declaration of that por
|
||||
else
|
||||
-- do the fancy flatten-unflatten mapping
|
||||
Generate $ (GenModuleItem newDecl) : genItems
|
||||
where
|
||||
(tf, rs) = typeDims t
|
||||
t' = tf $ flattenRanges rs
|
||||
flipGen = Map.lookup ident dirMap == Just Input
|
||||
genItems = unflattener flipGen ident (dimMap Map.! ident)
|
||||
newDecl = MIDecl $ Variable dir t' ident a me
|
||||
typeIsImplicit :: Type -> Bool
|
||||
typeIsImplicit (Implicit _) = True
|
||||
typeIsImplicit _ = False
|
||||
flattenModuleItem _ other = other
|
||||
|
||||
-- produces a generate block for creating a local unflattened copy of the given
|
||||
-- port-exposed flattened array
|
||||
unflattener :: Bool -> Identifier -> (Type, Range) -> [GenItem]
|
||||
unflattener shouldFlip arr (t, (majorHi, majorLo)) =
|
||||
[ GenModuleItem $ Comment $ "sv2v packed-array-flatten unflattener for " ++ arr
|
||||
, GenModuleItem $ MIDecl $ Variable Local t arrUnflat [(majorHi, majorLo)] Nothing
|
||||
, GenModuleItem $ Genvar index
|
||||
, GenModuleItem $ MIDecl $ Variable Local IntegerT (arrUnflat ++ "_repeater_index") [] Nothing
|
||||
, GenFor
|
||||
(index, majorLo)
|
||||
(BinOp Le (Ident index) majorHi)
|
||||
(index, BinOp Add (Ident index) (Number "1"))
|
||||
(prefix "unflatten")
|
||||
[ localparam startBit
|
||||
(simplify $ BinOp Add majorLo
|
||||
(BinOp Mul (Ident index) size))
|
||||
, GenModuleItem $ (uncurry Assign) $
|
||||
if shouldFlip
|
||||
then (LHSBit arrUnflat $ Ident index, IdentRange arr origRange)
|
||||
else (LHSRange arr origRange, IdentBit arrUnflat $ Ident index)
|
||||
]
|
||||
]
|
||||
where
|
||||
startBit = prefix "_tmp_start"
|
||||
arrUnflat = prefix arr
|
||||
index = prefix "_tmp_index"
|
||||
(minorHi, minorLo) = head $ snd $ typeDims t
|
||||
size = simplify $ BinOp Add (BinOp Sub minorHi minorLo) (Number "1")
|
||||
localparam :: Identifier -> Expr -> GenItem
|
||||
localparam x v = GenModuleItem $ MIDecl $ Localparam (Implicit []) x v
|
||||
origRange = ( (BinOp Add (Ident startBit)
|
||||
(BinOp Sub size (Number "1")))
|
||||
, Ident startBit )
|
||||
|
||||
-- basic expression simplfication utility to help us generate nicer code in the
|
||||
-- common case of ranges like `[FOO-1:0]`
|
||||
simplify :: Expr -> Expr
|
||||
simplify (BinOp op e1 e2) =
|
||||
case (op, e1', e2') of
|
||||
(Add, Number "0", e) -> e
|
||||
(Add, e, Number "0") -> e
|
||||
(Sub, e, Number "0") -> e
|
||||
(Add, BinOp Sub e (Number "1"), Number "1") -> e
|
||||
(Add, e, BinOp Sub (Number "0") (Number "1")) -> BinOp Sub e (Number "1")
|
||||
_ -> BinOp op e1' e2'
|
||||
where
|
||||
e1' = simplify e1
|
||||
e2' = simplify e2
|
||||
simplify other = other
|
||||
|
||||
-- prefix a string with a namespace of sorts
|
||||
prefix :: Identifier -> Identifier
|
||||
prefix ident = "_sv2v_" ++ ident
|
||||
|
||||
|
||||
-- TODO FIXME XXX: There is a huge opportunity here to simplify the code after
|
||||
-- this point in the module. Each of these mappings have a bit of their own
|
||||
-- quirks. They cover all LHSs, expressions, and statements, at every level.
|
||||
|
||||
|
||||
rewriteRange :: DimMap -> Range -> Range
|
||||
rewriteRange dimMap (a, b) = (r a, r b)
|
||||
where r = rewriteExpr dimMap
|
||||
|
||||
rewriteIdentifier :: DimMap -> Identifier -> Identifier
|
||||
rewriteIdentifier dimMap x =
|
||||
if Map.member x dimMap
|
||||
then prefix x
|
||||
else x
|
||||
|
||||
rewriteExpr :: DimMap -> Expr -> Expr
|
||||
rewriteExpr dimMap = rewriteExpr'
|
||||
where
|
||||
ri :: Identifier -> Identifier
|
||||
ri = rewriteIdentifier dimMap
|
||||
re = rewriteExpr'
|
||||
rewriteExpr' :: Expr -> Expr
|
||||
rewriteExpr' (String s) = String s
|
||||
rewriteExpr' (Number s) = Number s
|
||||
rewriteExpr' (ConstBool b) = ConstBool b
|
||||
rewriteExpr' (Ident i ) = Ident (ri i)
|
||||
rewriteExpr' (IdentRange i (r @ (s, e))) =
|
||||
case Map.lookup i dimMap of
|
||||
Nothing -> IdentRange (ri i) (rewriteRange dimMap r)
|
||||
Just (t, _) ->
|
||||
IdentRange i (simplify s', simplify e')
|
||||
where
|
||||
(a, b) = head $ snd $ typeDims t
|
||||
size = BinOp Add (BinOp Sub a b) (Number "1")
|
||||
s' = BinOp Sub (BinOp Mul size (BinOp Add s (Number "1"))) (Number "1")
|
||||
e' = BinOp Mul size e
|
||||
rewriteExpr' (IdentBit i e) = IdentBit (ri i) (re e)
|
||||
rewriteExpr' (Repeat e l) = Repeat (re e) (map re l)
|
||||
rewriteExpr' (Concat l ) = Concat (map re l)
|
||||
rewriteExpr' (Call f l) = Call f (map re l)
|
||||
rewriteExpr' (UniOp o e) = UniOp o (re e)
|
||||
rewriteExpr' (BinOp o e1 e2) = BinOp o (re e1) (re e2)
|
||||
rewriteExpr' (Mux e1 e2 e3) = Mux (re e1) (re e2) (re e3)
|
||||
rewriteExpr' (Bit e n) = Bit (re e) n
|
||||
rewriteExpr' (Cast t e) = Cast t (re e)
|
||||
|
||||
-- combines (flattens) the bottom two ranges in the given list of ranges
|
||||
flattenRanges :: [Range] -> [Range]
|
||||
flattenRanges rs =
|
||||
if length rs >= 2
|
||||
then rs'
|
||||
else error $ "flattenRanges on too small list: " ++ (show rs)
|
||||
where
|
||||
(s1, e1) = head rs
|
||||
(s2, e2) = head $ tail rs
|
||||
size1 = BinOp Add (BinOp Sub s1 e1) (Number "1")
|
||||
size2 = BinOp Add (BinOp Sub s2 e2) (Number "1")
|
||||
upper = BinOp Add (BinOp Mul size1 size2) (BinOp Sub e1 (Number "1"))
|
||||
r' = (simplify upper, e1)
|
||||
rs' = (tail $ tail rs) ++ [r']
|
||||
|
||||
rewriteLHS :: DimMap -> LHS -> LHS
|
||||
rewriteLHS dimMap (LHS x ) = LHS (rewriteIdentifier dimMap x)
|
||||
rewriteLHS dimMap (LHSBit x e) = LHSBit (rewriteIdentifier dimMap x) (rewriteExpr dimMap e)
|
||||
rewriteLHS dimMap (LHSRange x r) = LHSRange (rewriteIdentifier dimMap x) (rewriteRange dimMap r)
|
||||
rewriteLHS dimMap (LHSConcat ls) = LHSConcat $ map (rewriteLHS dimMap) ls
|
||||
|
||||
rewriteStmt :: DimMap -> Stmt -> Stmt
|
||||
rewriteStmt dimMap orig = rs orig
|
||||
where
|
||||
rs :: Stmt -> Stmt
|
||||
rs (Block decls stmts) = Block decls (map rs stmts)
|
||||
rs (Case kw e cases def) = Case kw e' cases' def'
|
||||
where
|
||||
re :: Expr -> Expr
|
||||
re = rewriteExpr dimMap
|
||||
rc :: Case -> Case
|
||||
rc (exprs, stmt) = (map re exprs, rs stmt)
|
||||
e' = re e
|
||||
cases' = map rc cases
|
||||
def' = fmap rs def
|
||||
rs (AsgnBlk lhs expr) = convertAssignment AsgnBlk lhs expr
|
||||
rs (Asgn lhs expr) = convertAssignment Asgn lhs expr
|
||||
rs (For (x1, e1) cc (x2, e2) stmt) = For (x1, e1') cc' (x2, e2') (rs stmt)
|
||||
where
|
||||
e1' = rewriteExpr dimMap e1
|
||||
e2' = rewriteExpr dimMap e2
|
||||
cc' = rewriteExpr dimMap cc
|
||||
rs (If cc s1 s2) = If (rewriteExpr dimMap cc) (rs s1) (rs s2)
|
||||
rs (Timing sense stmt) = Timing sense (rs stmt)
|
||||
rs (Null) = Null
|
||||
convertAssignment :: (LHS -> Expr -> Stmt) -> LHS -> Expr -> Stmt
|
||||
convertAssignment constructor (lhs @ (LHS ident)) (expr @ (Repeat _ exprs)) =
|
||||
case Map.lookup ident dimMap of
|
||||
Nothing -> constructor (rewriteLHS dimMap lhs) (rewriteExpr dimMap expr)
|
||||
Just (_, (a, b)) ->
|
||||
For inir chkr incr assign
|
||||
where
|
||||
index = prefix $ ident ++ "_repeater_index"
|
||||
assign = constructor
|
||||
(LHSBit (prefix ident) (Ident index))
|
||||
(Concat exprs)
|
||||
inir = (index, b)
|
||||
chkr = BinOp Le (Ident index) a
|
||||
incr = (index, BinOp Add (Ident index) (Number "1"))
|
||||
convertAssignment constructor lhs expr =
|
||||
constructor (rewriteLHS dimMap lhs) (rewriteExpr dimMap expr)
|
||||
|
||||
convertModuleItem :: DimMap -> ModuleItem -> ModuleItem
|
||||
convertModuleItem dimMap (MIDecl (Variable d t x a me)) =
|
||||
MIDecl $ Variable d t x a' me'
|
||||
where
|
||||
a' = map (rewriteRange dimMap) a
|
||||
me' = fmap (rewriteExpr dimMap) me
|
||||
convertModuleItem dimMap (Assign lhs expr) =
|
||||
Assign (rewriteLHS dimMap lhs) (rewriteExpr dimMap expr)
|
||||
convertModuleItem dimMap (AlwaysC kw stmt) =
|
||||
AlwaysC kw (rewriteStmt dimMap stmt)
|
||||
convertModuleItem dimMap (Function ret f decls stmt) =
|
||||
Function ret f decls (rewriteStmt dimMap stmt)
|
||||
convertModuleItem dimMap (Instance m params x ml) =
|
||||
Instance m params x $ fmap (map convertPortBinding) ml
|
||||
where
|
||||
convertPortBinding :: PortBinding -> PortBinding
|
||||
convertPortBinding (p, Nothing) = (p, Nothing)
|
||||
convertPortBinding (p, Just e) = (p, Just $ rewriteExpr dimMap e)
|
||||
convertModuleItem _ (Comment x) = Comment x
|
||||
convertModuleItem _ (Genvar x) = Genvar x
|
||||
convertModuleItem _ (MIDecl x) = MIDecl x
|
||||
convertModuleItem _ (Generate x) = Generate x
|
||||
@@ -0,0 +1,28 @@
|
||||
{- sv2v
|
||||
- Author: Zachary Snow <[email protected]>
|
||||
-
|
||||
- Conversion for splitting up complex port declarations. VTR doesn't support:
|
||||
- `input wire foo;` but does suport: `input foo; wire foo;`.
|
||||
-}
|
||||
|
||||
module Convert.SplitPortDecl (convert) where
|
||||
|
||||
import Convert.Traverse
|
||||
import Language.SystemVerilog.AST
|
||||
|
||||
convert :: AST -> AST
|
||||
convert = traverseDescriptions convertDescription
|
||||
|
||||
convertDescription :: Description -> Description
|
||||
convertDescription (Module name ports items) =
|
||||
Module name ports (concat $ map splitPortDecl items)
|
||||
convertDescription other = other
|
||||
|
||||
splitPortDecl :: ModuleItem -> [ModuleItem]
|
||||
splitPortDecl (orig @ (MIDecl (Variable Local _ _ _ _))) = [orig]
|
||||
splitPortDecl (orig @ (MIDecl (Variable _ (Implicit _) _ _ _))) = [orig]
|
||||
splitPortDecl (MIDecl (Variable d t x a me)) =
|
||||
[ MIDecl $ Variable d (Implicit r) x a Nothing
|
||||
, MIDecl $ Variable Local t x a me ]
|
||||
where (_, r) = typeDims t
|
||||
splitPortDecl other = [other]
|
||||
@@ -0,0 +1,32 @@
|
||||
{- sv2v
|
||||
- Author: Zachary Snow <[email protected]>
|
||||
-
|
||||
- Conversion for `.*` in module instantiation
|
||||
-}
|
||||
|
||||
module Convert.StarPort (convert) where
|
||||
|
||||
import Control.Monad.Writer
|
||||
import qualified Data.Map.Strict as Map
|
||||
|
||||
import Convert.Traverse
|
||||
import Language.SystemVerilog.AST
|
||||
|
||||
convert :: AST -> AST
|
||||
convert descriptions =
|
||||
traverseDescriptions (traverseModuleItems mapInstance) descriptions
|
||||
where
|
||||
modulePorts = execWriter $ collectDescriptionsM getPorts descriptions
|
||||
getPorts :: Description -> Writer (Map.Map Identifier [Identifier]) ()
|
||||
getPorts (Module name ports _) = tell $ Map.singleton name ports
|
||||
getPorts _ = return ()
|
||||
|
||||
mapInstance :: ModuleItem -> ModuleItem
|
||||
mapInstance (Instance m p x Nothing) =
|
||||
Instance m p x (Just portBindings)
|
||||
where
|
||||
ports = case Map.lookup m modulePorts of
|
||||
Nothing -> error $ "could not convert `.*` in instantiation of " ++ m
|
||||
Just l -> l
|
||||
portBindings = map (\port -> (port, Just $ Ident port)) ports
|
||||
mapInstance other = other
|
||||
@@ -0,0 +1,137 @@
|
||||
{- sv2v
|
||||
- Author: Zachary Snow <[email protected]>
|
||||
-
|
||||
- Utilities for traversing AST transformations.
|
||||
-}
|
||||
|
||||
module Convert.Traverse
|
||||
( MapperM
|
||||
, Mapper
|
||||
, unmonad
|
||||
, collectify
|
||||
, traverseDescriptionsM
|
||||
, traverseDescriptions
|
||||
, collectDescriptionsM
|
||||
, traverseModuleItemsM
|
||||
, traverseModuleItems
|
||||
, collectModuleItemsM
|
||||
, traverseStmtsM
|
||||
, traverseStmts
|
||||
, collectStmtsM
|
||||
, traverseStmtLHSsM
|
||||
, traverseStmtLHSs
|
||||
, collectStmtLHSsM
|
||||
) where
|
||||
|
||||
import Control.Monad.State
|
||||
import Language.SystemVerilog.AST
|
||||
|
||||
type MapperM m t = t -> m t
|
||||
type Mapper t = t -> t
|
||||
type CollectorM m t = t -> m ()
|
||||
|
||||
unmonad :: (MapperM (State ()) a -> MapperM (State ()) b) -> Mapper a -> Mapper b
|
||||
unmonad traverser mapper thing =
|
||||
evalState (traverser (return . mapper) thing) ()
|
||||
|
||||
collectify :: Monad m => (MapperM m a -> MapperM m b) -> CollectorM m a -> CollectorM m b
|
||||
collectify traverser collector thing =
|
||||
traverser mapper thing >>= \_ -> return ()
|
||||
where mapper x = collector x >>= \() -> return x
|
||||
|
||||
traverseDescriptionsM :: Monad m => MapperM m Description -> MapperM m AST
|
||||
traverseDescriptionsM mapper descriptions =
|
||||
mapM mapper descriptions
|
||||
|
||||
traverseDescriptions :: Mapper Description -> Mapper AST
|
||||
traverseDescriptions = unmonad traverseDescriptionsM
|
||||
collectDescriptionsM :: Monad m => CollectorM m Description -> CollectorM m AST
|
||||
collectDescriptionsM = collectify traverseDescriptionsM
|
||||
|
||||
maybeDo :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b)
|
||||
maybeDo _ Nothing = return Nothing
|
||||
maybeDo fun (Just val) = fun val >>= return . Just
|
||||
|
||||
traverseModuleItemsM :: Monad m => MapperM m ModuleItem -> MapperM m Description
|
||||
traverseModuleItemsM mapper (Module name ports items) =
|
||||
mapM fullMapper items >>= return . Module name ports
|
||||
where
|
||||
fullMapper (Generate genItems) =
|
||||
mapM genItemMapper genItems >>= mapper . Generate
|
||||
fullMapper other = mapper other
|
||||
-- maps all ModuleItems within the given GenItem
|
||||
genItemMapper (GenBlock x subItems) =
|
||||
mapM genItemMapper subItems >>= return . GenBlock x
|
||||
genItemMapper (GenFor a b c d subItems) =
|
||||
mapM genItemMapper subItems >>= return . GenFor a b c d
|
||||
genItemMapper (GenIf e i1 i2) = do
|
||||
i1' <- genItemMapper i1
|
||||
i2' <- genItemMapper i2
|
||||
return $ GenIf e i1' i2'
|
||||
genItemMapper (GenNull) = return GenNull
|
||||
genItemMapper (GenModuleItem moduleItem) = do
|
||||
moduleItem' <- fullMapper moduleItem
|
||||
return $ case moduleItem' of
|
||||
Generate subItems -> GenBlock Nothing subItems
|
||||
_ -> GenModuleItem moduleItem'
|
||||
genItemMapper (GenCase e cases def) = do
|
||||
caseItems <- mapM (genItemMapper . snd) cases
|
||||
let cases' = zip (map fst cases) caseItems
|
||||
def' <- maybeDo genItemMapper def
|
||||
return $ GenCase e cases' def'
|
||||
traverseModuleItemsM _ orig = return orig
|
||||
|
||||
traverseModuleItems :: Mapper ModuleItem -> Mapper Description
|
||||
traverseModuleItems = unmonad traverseModuleItemsM
|
||||
collectModuleItemsM :: Monad m => CollectorM m ModuleItem -> CollectorM m Description
|
||||
collectModuleItemsM = collectify traverseModuleItemsM
|
||||
|
||||
traverseStmtsM :: Monad m => MapperM m Stmt -> MapperM m ModuleItem
|
||||
traverseStmtsM mapper = moduleItemMapper
|
||||
where
|
||||
moduleItemMapper (AlwaysC kw stmt) =
|
||||
fullMapper stmt >>= return . AlwaysC kw
|
||||
moduleItemMapper (Function ret name decls stmt) =
|
||||
fullMapper stmt >>= return . Function ret name decls
|
||||
moduleItemMapper other = return $ other
|
||||
fullMapper = traverseNestedStmtsM mapper
|
||||
|
||||
traverseStmts :: Mapper Stmt -> Mapper ModuleItem
|
||||
traverseStmts = unmonad traverseStmtsM
|
||||
collectStmtsM :: Monad m => CollectorM m Stmt -> CollectorM m ModuleItem
|
||||
collectStmtsM = collectify traverseStmtsM
|
||||
|
||||
-- private utility for turning a thing which maps over a single lever of
|
||||
-- statements into one that maps over the nested statements first, then the
|
||||
-- higher levels up
|
||||
traverseNestedStmtsM :: Monad m => MapperM m Stmt -> MapperM m Stmt
|
||||
traverseNestedStmtsM mapper = fullMapper
|
||||
where
|
||||
fullMapper stmt = mapper stmt >>= cs
|
||||
cs (Block decls stmts) = mapM fullMapper stmts >>= return . Block decls
|
||||
cs (Case kw expr cases def) = do
|
||||
caseStmts <- mapM fullMapper $ map snd cases
|
||||
let cases' = zip (map fst cases) caseStmts
|
||||
def' <- maybeDo fullMapper def
|
||||
return $ Case kw expr cases' def'
|
||||
cs (AsgnBlk lhs expr) = return $ AsgnBlk lhs expr
|
||||
cs (Asgn lhs expr) = return $ Asgn lhs expr
|
||||
cs (For a b c stmt) = fullMapper stmt >>= return . For a b c
|
||||
cs (If e s1 s2) = do
|
||||
s1' <- fullMapper s1
|
||||
s2' <- fullMapper s2
|
||||
return $ If e s1' s2'
|
||||
cs (Timing sense stmt) = fullMapper stmt >>= return . Timing sense
|
||||
cs (Null) = return Null
|
||||
|
||||
traverseStmtLHSsM :: Monad m => MapperM m LHS -> MapperM m Stmt
|
||||
traverseStmtLHSsM mapper = traverseNestedStmtsM stmtMapper
|
||||
where
|
||||
stmtMapper (AsgnBlk lhs expr) = mapper lhs >>= \lhs' -> return $ AsgnBlk lhs' expr
|
||||
stmtMapper (Asgn lhs expr) = mapper lhs >>= \lhs' -> return $ Asgn lhs' expr
|
||||
stmtMapper other = return other
|
||||
|
||||
traverseStmtLHSs :: Mapper LHS -> Mapper Stmt
|
||||
traverseStmtLHSs = unmonad traverseStmtLHSsM
|
||||
collectStmtLHSsM :: Monad m => CollectorM m LHS -> CollectorM m Stmt
|
||||
collectStmtLHSsM = collectify traverseStmtLHSsM
|
||||
@@ -0,0 +1,118 @@
|
||||
{- sv2v
|
||||
- Author: Zachary Snow <[email protected]>
|
||||
-
|
||||
- Conversion for `typedef`
|
||||
-
|
||||
- Aliased types can (probably) appear in all item declarations, including
|
||||
- modules, blocks, and function parameters.
|
||||
-}
|
||||
|
||||
module Convert.Typedef (convert) where
|
||||
|
||||
import Data.Maybe
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Language.SystemVerilog.AST
|
||||
|
||||
type Types = Map.Map Identifier Type
|
||||
|
||||
convert :: AST -> AST
|
||||
convert descriptions =
|
||||
filter (not . isTypedef) $ map (convertDescription types) descriptions
|
||||
where
|
||||
types = Map.fromList $ mapMaybe getTypedef descriptions
|
||||
getTypedef :: Description -> Maybe (Identifier, Type)
|
||||
getTypedef (Typedef a b) = Just (b, a)
|
||||
getTypedef _ = Nothing
|
||||
|
||||
isTypedef :: Description -> Bool
|
||||
isTypedef (Typedef _ _) = True
|
||||
isTypedef _ = False
|
||||
|
||||
convertDescription :: Types -> Description -> Description
|
||||
convertDescription types (Module name ports items) =
|
||||
Module name ports $ map (convertModuleItem types) items
|
||||
convertDescription _ other = other
|
||||
|
||||
resolveType :: Types -> Type -> Type
|
||||
resolveType _ (Reg rs) = Reg rs
|
||||
resolveType _ (Wire rs) = Wire rs
|
||||
resolveType _ (Logic rs) = Logic rs
|
||||
resolveType _ (Implicit rs) = Implicit rs
|
||||
resolveType _ (IntegerT ) = IntegerT
|
||||
resolveType _ (Enum Nothing vals rs) = Enum Nothing vals rs
|
||||
resolveType types (Enum (Just t) vals rs) = Enum (Just $ resolveType types t) vals rs
|
||||
resolveType types (Alias st rs1) =
|
||||
case resolveType types $ types Map.! st of
|
||||
(Reg rs2) -> Reg $ rs2 ++ rs1
|
||||
(Wire rs2) -> Wire $ rs2 ++ rs1
|
||||
(Logic rs2) -> Logic $ rs2 ++ rs1
|
||||
(Enum t v rs2) -> Enum t v $ rs2 ++ rs1
|
||||
(Implicit rs2) -> Implicit $ rs2 ++ rs1
|
||||
(IntegerT ) -> error $ "resolveType encountered packed `integer` on " ++ st
|
||||
(Alias _ _) -> error $ "resolveType invariant failed on " ++ st
|
||||
|
||||
convertDecl :: Types -> Decl -> Decl
|
||||
convertDecl types decl =
|
||||
case decl of
|
||||
Parameter t x e -> Parameter (rt t) x (re e)
|
||||
Localparam t x e -> Localparam (rt t) x (re e)
|
||||
Variable d t x a me -> Variable d (rt t) x a me'
|
||||
where me' = if isJust me then Just (re $ fromJust me) else me
|
||||
where
|
||||
rt = resolveType types
|
||||
re = convertExpr types
|
||||
|
||||
convertModuleItem :: Types -> ModuleItem -> ModuleItem
|
||||
convertModuleItem types (MIDecl decl) =
|
||||
MIDecl $ convertDecl types decl
|
||||
convertModuleItem types (Function t x decls stmt) =
|
||||
Function (resolveType types t) x
|
||||
(map (convertDecl types) decls)
|
||||
(convertStmt types stmt)
|
||||
convertModuleItem types (Assign lhs expr) =
|
||||
Assign lhs (convertExpr types expr)
|
||||
convertModuleItem types (AlwaysC kw stmt) =
|
||||
AlwaysC kw (convertStmt types stmt)
|
||||
convertModuleItem _ other = other
|
||||
|
||||
convertStmt :: Types -> Stmt -> Stmt
|
||||
convertStmt types = rs
|
||||
where
|
||||
rd = convertDecl types
|
||||
re = convertExpr types
|
||||
rs :: Stmt -> Stmt
|
||||
rs (Block header stmts) =
|
||||
Block header' (map rs stmts)
|
||||
where header' = fmap (\(x, decls) -> (x, map rd decls)) header
|
||||
rs (Case kw e cases def) = Case kw (re e)
|
||||
(map convertCase cases) (fmap rs def)
|
||||
where
|
||||
convertCase (exprs, stmt) = (map re exprs, rs stmt)
|
||||
rs (AsgnBlk lhs expr) = AsgnBlk lhs (re expr)
|
||||
rs (Asgn lhs expr) = Asgn lhs (re expr)
|
||||
rs (For (x1, e1) e (x2, e2) stmt) =
|
||||
For (x1, re e1) (re e) (x2, re e2) (rs stmt)
|
||||
rs (If e s1 s2) = If (re e) (rs s1) (rs s2)
|
||||
rs (Timing sense stmt) = Timing sense (rs stmt)
|
||||
rs (Null) = Null
|
||||
|
||||
convertExpr :: Types -> Expr -> Expr
|
||||
convertExpr types = re
|
||||
where
|
||||
re :: Expr -> Expr
|
||||
re (String s) = String s
|
||||
re (Number s) = Number s
|
||||
re (ConstBool b) = ConstBool b
|
||||
re (Ident i ) = Ident i
|
||||
re (IdentRange i r) = IdentRange i r
|
||||
re (IdentBit i e) = IdentBit i (re e)
|
||||
re (Repeat e l) = Repeat (re e) (map re l)
|
||||
re (Concat l ) = Concat (map re l)
|
||||
re (Call f l) = Call f (map re l)
|
||||
re (UniOp o e) = UniOp o (re e)
|
||||
re (BinOp o e1 e2) = BinOp o (re e1) (re e2)
|
||||
re (Mux e1 e2 e3) = Mux (re e1) (re e2) (re e3)
|
||||
re (Bit e n) = Bit (re e) n
|
||||
-- This is the reason we have to convert expressions in this module.
|
||||
re (Cast t e) = Cast (resolveType types t) (re e)
|
||||
Reference in New Issue
Block a user