Commit 50b7bf28 by Zachary Snow

huge pass at revamping AST to be more general, easy to work with

parent e795109f
......@@ -34,8 +34,8 @@ getStmtLHSs :: Stmt -> [LHS]
getStmtLHSs (Block _ stmts) = concat $ map getStmtLHSs stmts
getStmtLHSs (Case kw e cases (Just stmt)) = (getStmtLHSs stmt) ++ (getStmtLHSs $ Case kw e cases Nothing)
getStmtLHSs (Case _ _ cases Nothing) = concat $ map getStmtLHSs $ map snd cases
getStmtLHSs (BlockingAssignment lhs _) = [lhs]
getStmtLHSs (NonBlockingAssignment lhs _) = [lhs]
getStmtLHSs (AsgnBlk lhs _) = [lhs]
getStmtLHSs (Asgn lhs _) = [lhs]
getStmtLHSs (For _ _ _ stmt) = getStmtLHSs stmt
getStmtLHSs (If _ s1 s2) = (getStmtLHSs s1) ++ (getStmtLHSs s2)
getStmtLHSs (Timing _ s) = getStmtLHSs s
......@@ -56,8 +56,8 @@ getRegIdents (AlwaysC _ stmt) =
getRegIdents _ = Set.empty
convertModuleItem :: RegIdents -> ModuleItem -> ModuleItem
convertModuleItem idents (LocalNet (Logic mr) ident val) =
LocalNet (t mr) ident val
convertModuleItem idents (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 idents (Generate items) = Generate $ map (convertGenItem $ convertModuleItem idents) items
......
......@@ -40,7 +40,7 @@ convert = map convertDescription
convertDescription :: Description -> Description
convertDescription (Module name ports items) =
-- Insert the new items right after the LocalNet for the item to preserve
-- Insert the new items right after the Variable for the item to preserve
-- declaration order, which some toolchains care about.
Module name ports $ concat $ map addUnflattener items'
where
......@@ -49,18 +49,18 @@ convertDescription (Module name ports items) =
items' = map (convertModuleItem dimMap) items
outputs = Set.fromList $ mapMaybe getOutput items
getOutput :: ModuleItem -> Maybe Identifier
getOutput (PortDecl Output _ ident) = Just ident
getOutput (MIDecl (Variable Output _ ident _ _)) = Just ident
getOutput _ = Nothing
getExtraDims :: ModuleItem -> Maybe (Identifier, (Type, Range))
getExtraDims (LocalNet t ident _) =
getExtraDims (MIDecl (Variable _ t ident _ _)) =
if length rs > 1
then Just (ident, (tf $ tail rs, head rs))
else Nothing
where (tf, rs) = typeDims t
getExtraDims _ = Nothing
addUnflattener :: ModuleItem -> [ModuleItem]
addUnflattener (LocalNet t ident val) =
LocalNet t ident val :
addUnflattener (orig @ (MIDecl (Variable _ _ ident _ _))) =
orig :
case Map.lookup ident dimMap of
Nothing -> []
Just desc -> unflattener outputs (ident, desc)
......@@ -84,10 +84,10 @@ simplify other = other
unflattener :: Set.Set Identifier -> (Identifier, (Type, Range)) -> [ModuleItem]
unflattener outputs (arr, (t, (majorHi, majorLo))) =
[ Comment $ "sv2v packed-array-flatten unflattener for " ++ arr
, LocalNet t arrUnflat (Left [(majorHi, majorLo)])
, MIDecl $ Variable Local t arrUnflat [(majorHi, majorLo)] Nothing
, Generate
[ GenModuleItem $ Genvar index
, GenModuleItem $ MIIntegerV $ IntegerV (arrUnflat ++ "_repeater_index") (Right Nothing)
, GenModuleItem $ MIDecl $ Variable Local IntegerT (arrUnflat ++ "_repeater_index") [] Nothing
, GenFor
(index, majorLo)
(BinOp Le (Ident index) majorHi)
......@@ -110,7 +110,7 @@ unflattener outputs (arr, (t, (majorHi, majorLo))) =
(minorHi, minorLo) = head $ snd $ typeDims t
size = simplify $ BinOp Add (BinOp Sub minorHi minorLo) (Number "1")
localparam :: Identifier -> Expr -> GenItem
localparam x v = GenModuleItem $ MILocalparam $ Localparam Nothing x v
localparam x v = GenModuleItem $ MIDecl $ Localparam (Implicit []) x v
origRange = ( (BinOp Add (Ident startBit)
(BinOp Sub size (Number "1")))
, Ident startBit )
......@@ -120,16 +120,13 @@ typeDims (Reg r) = (Reg , r)
typeDims (Wire r) = (Wire , r)
typeDims (Logic r) = (Logic , r)
typeDims (Alias t r) = (Alias t, r)
typeDims (Implicit r) = (Implicit, r)
typeDims (IntegerT ) = (error "ranges cannot be applied to IntegerT", [])
typeDims (Enum t v r) = (Enum t v, r)
prefix :: Identifier -> Identifier
prefix ident = "_sv2v_" ++ ident
rewriteRangesOrAssignment :: DimMap -> RangesOrAssignment -> RangesOrAssignment
rewriteRangesOrAssignment dimMap (Right (Just e)) =
Right $ Just $ rewriteExpr dimMap e
rewriteRangesOrAssignment _ other = other
rewriteRange :: DimMap -> Range -> Range
rewriteRange dimMap (a, b) = (r a, r b)
where r = rewriteExpr dimMap
......@@ -208,8 +205,8 @@ rewriteStmt dimMap orig = rs orig
case def of
Nothing -> Nothing
Just stmt -> Just $ rs stmt
rs (BlockingAssignment lhs expr) = convertAssignment BlockingAssignment lhs expr
rs (NonBlockingAssignment lhs expr) = convertAssignment NonBlockingAssignment lhs expr
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
......@@ -236,18 +233,15 @@ rewriteStmt dimMap orig = rs orig
constructor (rewriteLHS dimMap lhs) (rewriteExpr dimMap expr)
convertModuleItem :: DimMap -> ModuleItem -> ModuleItem
convertModuleItem dimMap (LocalNet t x val) =
convertModuleItem dimMap (MIDecl (Variable d t x a me)) =
if Map.member x dimMap
then LocalNet t' x val'
else LocalNet t x val'
then MIDecl $ Variable d t' x a' me'
else MIDecl $ Variable d t x a' me'
where
(tf, rs) = typeDims t
t' = tf $ flattenRanges rs
val' = rewriteRangesOrAssignment dimMap val
convertModuleItem dimMap (PortDecl dir rs x) =
if Map.member x dimMap
then PortDecl dir (flattenRanges rs) x
else PortDecl dir rs x
a' = map (rewriteRange dimMap) a
me' = maybe Nothing (Just . rewriteExpr dimMap) me
convertModuleItem dimMap (Generate items) =
Generate $ map (convertGenItem dimMap) items
convertModuleItem dimMap (Assign lhs expr) =
......@@ -266,9 +260,7 @@ convertModuleItem dimMap (Instance m params x (Just l)) =
convertPortBinding (p, Just e) = (p, Just $ rewriteExpr dimMap e)
convertModuleItem _ (Comment x) = Comment x
convertModuleItem _ (Genvar x) = Genvar x
convertModuleItem _ (MIParameter x) = MIParameter x
convertModuleItem _ (MILocalparam x) = MILocalparam x
convertModuleItem _ (MIIntegerV x) = MIIntegerV x
convertModuleItem _ (MIDecl x) = MIDecl x
convertGenItem :: DimMap -> GenItem -> GenItem
convertGenItem dimMap item = convertGenItem' item
......
......@@ -32,11 +32,9 @@ convertStmt f = f . convertStmt'
Case kw expr cases' def'
where
cases' = map (\(exprs, stmt) -> (exprs, cs stmt)) cases
def' = case def of
Nothing -> Nothing
Just stmt -> Just (cs stmt)
convertStmt' (BlockingAssignment lhs expr) = BlockingAssignment lhs expr
convertStmt' (NonBlockingAssignment lhs expr) = NonBlockingAssignment lhs expr
def' = maybe Nothing (Just . cs) def
convertStmt' (AsgnBlk lhs expr) = AsgnBlk lhs expr
convertStmt' (Asgn lhs expr) = Asgn lhs expr
convertStmt' (For a b c stmt) = For a b c (cs stmt)
convertStmt' (If e s1 s2) = If e (cs s1) (cs s2)
convertStmt' (Timing sense stmt) = Timing sense (cs stmt)
......
......@@ -2,13 +2,11 @@
- Author: Zachary Snow <zach@zachjs.com>
-
- Conversion for `typedef`
-
- Aliased types can (probably) appear in all item declarations, including
- modules, blocks, and function parameters.
-}
-- TODO: Right now we only support typedefs for module data items. Function
-- parameters, block items, etc., probably support typedefs, too.
-- TODO FIXME XXX: `Cast` contains a type, which we'll need to resolve/convert?
module Convert.Typedef (convert) where
import Data.Maybe
......@@ -40,6 +38,8 @@ 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) =
......@@ -48,9 +48,72 @@ resolveType types (Alias st 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 (LocalNet t ident val) =
LocalNet (resolveType types t) ident val
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' = maybe Nothing (\(x, decls) -> Just (x, map rd decls)) header
rs (Case kw e cases def) = Case kw (re e)
(map convertCase cases) def'
where
convertCase (exprs, stmt) = (map re exprs, rs stmt)
def' = maybe Nothing (Just . rs) def
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)
......@@ -10,19 +10,15 @@ module Language.SystemVerilog.AST
, UniOp (..)
, BinOp (..)
, Sense (..)
, BlockItemDeclaration (..)
, Parameter (..)
, Localparam (..)
, IntegerV (..)
, GenItem (..)
, AlwaysKW (..)
, CaseKW (..)
, Decl (..)
, AST
, PortBinding
, Case
, Range
, GenCase
, RangesOrAssignment
) where
import Data.List
......@@ -65,18 +61,22 @@ data Direction
= Input
| Output
| Inout
| Local
deriving Eq
instance Show Direction where
show Input = "input"
show Output = "output"
show Inout = "inout"
show Local = ""
data Type
= Reg [Range]
| Wire [Range]
| Logic [Range]
| Alias String [Range]
| Alias Identifier [Range]
| Implicit [Range]
| IntegerT
| Enum (Maybe Type) [(Identifier, Maybe Expr)] [Range]
deriving Eq
......@@ -85,29 +85,40 @@ instance Show Type where
show (Wire r) = "wire" ++ (showRanges r)
show (Logic r) = "logic" ++ (showRanges r)
show (Alias t r) = t ++ (showRanges r)
show (Implicit r) = (showRanges r)
show (IntegerT ) = "integer"
show (Enum mt vals r) = printf "enum %s{%s}%s" tStr (commas $ map showVal vals) (showRanges r)
where
tStr = case mt of
Nothing -> ""
Just t -> (show t) ++ " "
tStr = maybe "" showPad mt
showVal :: (Identifier, Maybe Expr) -> String
showVal (x, e) = x ++ (showAssignment e)
data Decl
= Parameter Type Identifier Expr
| Localparam Type Identifier Expr
| Variable Direction Type Identifier [Range] (Maybe Expr)
deriving Eq
instance Show Decl where
showList l _ = unlines' $ map show l
show (Parameter t x e) = printf "parameter %s%s = %s;" (showPad t) x (show e)
show (Localparam t x e) = printf "localparam %s%s = %s;" (showPad t) x (show e)
show (Variable d t x a me) = printf "%s%s %s%s%s;" (showPad d) (show t) x (showRanges a) (showAssignment me)
data ModuleItem
= Comment String
| MIParameter Parameter
| MILocalparam Localparam
| MIIntegerV IntegerV
| PortDecl Direction [Range] Identifier
| LocalNet Type Identifier RangesOrAssignment
| MIDecl Decl
| AlwaysC AlwaysKW Stmt
| Assign LHS Expr
| Instance Identifier [PortBinding] Identifier (Maybe [PortBinding]) -- `Nothing` represents `.*`
| Function (Maybe FuncRet) Identifier [(Bool, BlockItemDeclaration)] Stmt
| Function Type Identifier [Decl] Stmt
| Genvar Identifier
| Generate [GenItem]
deriving Eq
-- "function inputs and outputs are inferred to be of type reg if no internal
-- data types for the ports are declared"
data AlwaysKW
= Always
| AlwaysComb
......@@ -121,61 +132,29 @@ instance Show AlwaysKW where
show AlwaysFF = "always_ff"
show AlwaysLatch = "always_latch"
-- "function inputs and outputs are inferred to be of type reg if no internal
-- data types for the ports are declared"
type PortBinding = (Identifier, Maybe Expr)
data Parameter = Parameter (Maybe Range) Identifier Expr deriving Eq
instance Show Parameter where
show (Parameter r n e) = printf "parameter %s%s = %s;" (showRange r) n (show e)
data Localparam = Localparam (Maybe Range) Identifier Expr deriving Eq
instance Show Localparam where
show (Localparam r n e) = printf "localparam %s%s = %s;" (showRange r) n (show e)
data IntegerV = IntegerV Identifier RangesOrAssignment deriving Eq
instance Show IntegerV where
show (IntegerV x v ) = printf "integer %s%s;" x (showRangesOrAssignment v)
instance Show ModuleItem where
show thing = case thing of
Comment c -> "// " ++ c
MIParameter nest -> show nest
MILocalparam nest -> show nest
MIIntegerV nest -> show nest
PortDecl d r x -> printf "%s%s %s;" (show d) (showRanges r) x
LocalNet t x v -> printf "%s %s%s;" (show t) x (showRangesOrAssignment v)
MIDecl nest -> show nest
AlwaysC k b -> printf "%s %s" (show k) (show b)
Assign a b -> printf "assign %s = %s;" (show a) (show b)
Instance m params i ports
| null params -> printf "%s %s%s;" m i (showMaybePorts ports)
| otherwise -> printf "%s #%s %s%s;" m (showPorts params) i (showMaybePorts ports)
Function t x i b -> printf "function %s%s;\n%s\n%s\nendfunction" (showFuncRet t) x (indent $ unlines' $ map showFunctionItem i) (indent $ show b)
Function t x i b -> printf "function %s%s;\n%s\n%s\nendfunction" (showPad t) x (indent $ show i) (indent $ show b)
Genvar x -> printf "genvar %s;" x
Generate b -> printf "generate\n%s\nendgenerate" (indent $ unlines' $ map show b)
where
showMaybePorts :: Maybe [(Identifier, Maybe Expr)] -> String
showMaybePorts Nothing = "(.*)"
showMaybePorts (Just ports) = showPorts ports
showPorts :: [(Identifier, Maybe Expr)] -> String
showPorts ports = indentedParenList [ if i == "" then show (fromJust arg) else printf ".%s(%s)" i (if isJust arg then show $ fromJust arg else "") | (i, arg) <- ports ]
showFunctionItem :: (Bool, BlockItemDeclaration) -> String
showFunctionItem (b, item) = prefix ++ (show item)
where prefix = if b then "input " else ""
type FuncRet = Either Range ()
showFuncRet :: Maybe FuncRet -> String
showFuncRet Nothing = ""
showFuncRet (Just (Left r)) = showRange $ Just r
showFuncRet (Just (Right ())) = "integer "
type RangesOrAssignment = Either [Range] (Maybe Expr)
showRangesOrAssignment :: Either [Range] (Maybe Expr) -> String
showRangesOrAssignment (Left ranges) = showRanges ranges
showRangesOrAssignment (Right val) = showAssignment val
showMaybePorts = maybe "(.*)" showPorts
showPorts :: [PortBinding] -> String
showPorts ports = indentedParenList $ map showPort ports
showPort :: PortBinding -> String
showPort (i, arg) =
if i == ""
then show (fromJust arg)
else printf ".%s(%s)" i (if isJust arg then show $ fromJust arg else "")
showAssignment :: Maybe Expr -> String
showAssignment Nothing = ""
......@@ -190,6 +169,13 @@ showRange :: Maybe Range -> String
showRange Nothing = ""
showRange (Just (h, l)) = printf "[%s:%s] " (show h) (show l)
showPad :: Show t => t -> String
showPad x =
if str == ""
then ""
else str ++ " "
where str = show x
indent :: String -> String
indent a = '\t' : f a
where
......@@ -331,11 +317,11 @@ instance Show CaseKW where
show CaseX = "casex"
data Stmt
= Block (Maybe (Identifier, [BlockItemDeclaration])) [Stmt]
= Block (Maybe (Identifier, [Decl])) [Stmt]
| Case CaseKW Expr [Case] (Maybe Stmt)
| BlockingAssignment LHS Expr
| NonBlockingAssignment LHS Expr
| For (Identifier, Expr) Expr (Identifier, Expr) Stmt
| AsgnBlk LHS Expr
| Asgn LHS Expr
| If Expr Stmt Stmt
| Timing Sense Stmt
| Null
......@@ -345,33 +331,28 @@ commas :: [String] -> String
commas = intercalate ", "
instance Show Stmt where
show (Block Nothing b ) = printf "begin\n%s\nend" $ indent $ unlines' $ map show b
show (Block (Just (a, i)) b ) = printf "begin : %s\n%s\nend" a $ indent $ unlines' $ (map show i ++ map show b)
show (Case kw a b Nothing ) = printf "%s (%s)\n%s\nendcase" (show kw) (show a) (indent $ unlines' $ map showCase b)
show (Case kw a b (Just c) ) = printf "%s (%s)\n%s\n\tdefault:\n%s\nendcase" (show kw) (show a) (indent $ unlines' $ map showCase b) (indent $ indent $ show c)
show (BlockingAssignment a b ) = printf "%s = %s;" (show a) (show b)
show (NonBlockingAssignment a b ) = printf "%s <= %s;" (show a) (show b)
show (For (a, b) c (d, e) f) = printf "for (%s = %s; %s; %s = %s)\n%s" a (show b) (show c) d (show e) $ indent $ show f
show (If a b Null ) = printf "if (%s)\n%s" (show a) (indent $ show b)
show (Block header stmts) =
printf "begin%s\n%s\nend" extra (block stmts)
where
block :: Show t => [t] -> String
block = indent . unlines' . map show
extra = case header of
Nothing -> ""
Just (x, i) -> printf " : %s\n%s" x (block i)
show (Case kw e cs def) =
printf "%s (%s)\n%s%s\nendcase" (show kw) (show e) (indent $ unlines' $ map showCase cs) defStr
where
defStr = case def of
Nothing -> ""
Just c -> printf "\n\tdefault:\n%s" (indent $ indent $ show c)
show (For (a,b) c (d,e) f) = printf "for (%s = %s; %s; %s = %s)\n%s" a (show b) (show c) d (show e) $ indent $ show f
show (AsgnBlk v e) = printf "%s = %s;" (show v) (show e)
show (Asgn v e) = printf "%s <= %s;" (show v) (show e)
show (If a b Null) = printf "if (%s)\n%s" (show a) (indent $ show b)
show (If a b c ) = printf "if (%s)\n%s\nelse\n%s" (show a) (indent $ show b) (indent $ show c)
show (Timing t s ) = printf "@(%s) %s" (show t) (show s)
show (Null ) = ";"
data BlockItemDeclaration
-- TODO: Maybe BIDReg should use [Range] for the first arg as well, but it's
-- really not clear to me what *useful* purpose this would have.
= BIDReg (Maybe Range) Identifier [Range]
| BIDParameter Parameter
| BIDLocalparam Localparam
| BIDIntegerV IntegerV
deriving Eq
instance Show BlockItemDeclaration where
show (BIDReg mr x rs) = printf "reg %s%s%s;" (showRange mr) x (showRanges rs)
show (BIDParameter nest) = show nest
show (BIDLocalparam nest) = show nest
show (BIDIntegerV nest) = show nest
type Case = ([Expr], Stmt)
showCase :: (Show x, Show y) => ([x], y) -> String
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment