diff --git a/Language/SystemVerilog/AST.hs b/Language/SystemVerilog/AST.hs index d8f9d91..bfd552d 100644 --- a/Language/SystemVerilog/AST.hs +++ b/Language/SystemVerilog/AST.hs @@ -2,6 +2,8 @@ module Language.SystemVerilog.AST ( Identifier , Module (..) , ModuleItem (..) + , Direction (..) + , Type (..) , Stmt (..) , LHS (..) , Expr (..) @@ -17,14 +19,25 @@ module Language.SystemVerilog.AST import Data.Bits import Data.List import Data.Maybe -import Data.Semigroup import Text.Printf import Data.BitVec type Identifier = String -data Module = Module Identifier [Identifier] [ModuleItem] deriving Eq +-- Note: Verilog allows modules to be declared with either a simple list of +-- ports _identifiers_, or a list of port _declarations_. If only the +-- identifiers are used, they must be declared with a type and direction +-- (potentially separately!) within the module itself. + +-- Note: This AST will allow for the representation of syntactically invalid +-- things, like input regs. We might want to have a function for doing some +-- basing invariant checks. I want to avoid making a full type-checker though, +-- as we should only be given valid SystemVerilog input files. + +data Module + = Module Identifier [Identifier] [ModuleItem] + deriving Eq instance Show Module where show (Module name ports items) = unlines @@ -33,15 +46,38 @@ instance Show Module where , "endmodule" ] +data Direction + = Input + | Output + | Inout + deriving Eq + +instance Show Direction where + show Input = "input" + show Output = "output" + show Inout = "inout" + +-- TODO: Support for arrays (multi-dimensional, too!) +data Type + = Reg (Maybe Range) + | Wire (Maybe Range) + deriving Eq + +instance Show Type where + show (Reg r) = "reg " ++ (showRange r) + show (Wire r) = "wire " ++ (showRange r) + data ModuleItem = Comment String | Parameter (Maybe Range) Identifier Expr | Localparam (Maybe Range) Identifier Expr - | Input (Maybe Range) [Identifier] - | Output (Maybe Range) [Identifier] - | Inout (Maybe Range) [Identifier] - | Wire (Maybe Range) [(Identifier, Maybe Expr)] - | Reg (Maybe Range) [(Identifier, Maybe Range)] + | PortDecl Direction (Maybe Range) Identifier + | LocalNet Type Identifier (Maybe Expr) +-- | Input (Maybe Range) [Identifier] +-- | Output (Maybe Range) [Identifier] +-- | Inout (Maybe Range) [Identifier] +-- | Wire (Maybe Range) [(Identifier, Maybe $ Either Range Expr)] +-- | Reg (Maybe Range) [(Identifier, Maybe $ Either Range Expr)] | Integer [Identifier] | Initial Stmt | Always (Maybe Sense) Stmt @@ -52,15 +88,22 @@ data ModuleItem type PortBinding = (Identifier, Maybe Expr) instance Show ModuleItem where - show a = case a of - Comment a -> "// " ++ a + show thing = case thing of + Comment c -> "// " ++ c Parameter r n e -> printf "parameter %s%s = %s;" (showRange r) n (showExprConst e) Localparam r n e -> printf "localparam %s%s = %s;" (showRange r) n (showExprConst e) - Input r a -> printf "input %s%s;" (showRange r) (commas a) - Output r a -> printf "output %s%s;" (showRange r) (commas a) - Inout r a -> printf "inout %s%s;" (showRange r) (commas a) - Wire r a -> printf "wire %s%s;" (showRange r) (commas [ a ++ showAssign r | (a, r) <- a ]) - Reg r a -> printf "reg %s%s;" (showRange r) (commas [ a ++ showRange r | (a, r) <- a ]) + PortDecl d r x -> printf "%s %s%s;" (show d) (showRange r) x + LocalNet t x v -> (show t) ++ " " ++ x ++ assignment ++ ";" + where + assignment = + if v == Nothing + then "" + else " = " ++ show (fromJust v) +-- Input r a -> printf "input %s%s;" (showRange r) (commas a) +-- Output r a -> printf "output %s%s;" (showRange r) (commas a) +-- Inout r a -> printf "inout %s%s;" (showRange r) (commas a) +-- Wire r a -> printf "wire %s%s;" (showRange r) (commas [ a ++ showAssign r | (a, r) <- a ]) +-- Reg r a -> printf "reg %s%s;" (showRange r) (commas [ a ++ showRange r | (a, r) <- a ]) Integer a -> printf "integer %s;" $ commas a Initial a -> printf "initial\n%s" $ indent $ show a Always Nothing b -> printf "always\n%s" $ indent $ show b @@ -72,10 +115,6 @@ instance Show ModuleItem where where showPorts :: (Expr -> String) -> [(Identifier, Maybe Expr)] -> String showPorts s ports = printf "(%s)" $ commas [ printf ".%s(%s)" i (if isJust arg then s $ fromJust arg else "") | (i, arg) <- ports ] - showAssign :: Maybe Expr -> String - showAssign a = case a of - Nothing -> "" - Just a -> printf " = %s" $ show a showRange :: Maybe Range -> String showRange Nothing = "" @@ -85,9 +124,9 @@ indent :: String -> String indent a = '\t' : f a where f [] = [] - f (a : rest) - | a == '\n' = "\n\t" ++ f rest - | otherwise = a : f rest + f (x : xs) + | x == '\n' = "\n\t" ++ f xs + | otherwise = x : f xs unlines' :: [String] -> String unlines' = intercalate "\n" @@ -171,7 +210,7 @@ showExprConst :: Expr -> String showExprConst = showExpr showBitVecConst showExpr :: (BitVec -> String) -> Expr -> String -showExpr bv a = case a of +showExpr bv x = case x of String a -> printf "\"%s\"" a Number a -> bv a ConstBool a -> printf "1'b%s" (if a then "1" else "0") @@ -227,11 +266,10 @@ data LHS deriving Eq instance Show LHS where - show a = case a of - LHS a -> a - LHSBit a b -> printf "%s[%s]" a (showExprConst b) - LHSRange a (b, c) -> printf "%s[%s:%s]" a (showExprConst b) (showExprConst c) - LHSConcat a -> printf "{%s}" (commas $ map show a) + show (LHS a ) = a + show (LHSBit a b ) = printf "%s[%s]" a (showExprConst b) + show (LHSRange a (b, c)) = printf "%s[%s:%s]" a (showExprConst b) (showExprConst c) + show (LHSConcat a ) = printf "{%s}" (commas $ map show a) data Stmt = Block (Maybe Identifier) [Stmt] @@ -251,21 +289,20 @@ commas :: [String] -> String commas = intercalate ", " instance Show Stmt where - show a = case a of - Block Nothing b -> printf "begin\n%s\nend" $ indent $ unlines' $ map show b - Block (Just a) b -> printf "begin : %s\n%s\nend" a $ indent $ unlines' $ map show b - StmtReg a b -> printf "reg %s%s;" (showRange a) (commas [ a ++ showRange r | (a, r) <- b ]) - StmtInteger a -> printf "integer %s;" $ commas a - Case a b Nothing -> printf "case (%s)\n%s\nendcase" (show a) (indent $ unlines' $ map showCase b) - Case a b (Just c) -> printf "case (%s)\n%s\n\tdefault:\n%s\nendcase" (show a) (indent $ unlines' $ map showCase b) (indent $ indent $ show c) - BlockingAssignment a b -> printf "%s = %s;" (show a) (show b) - NonBlockingAssignment a b -> printf "%s <= %s;" (show a) (show b) - 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 - If a b Null -> printf "if (%s)\n%s" (show a) (indent $ show b) - If a b c -> printf "if (%s)\n%s\nelse\n%s" (show a) (indent $ show b) (indent $ show c) - StmtCall a -> printf "%s;" (show a) - Delay a b -> printf "#%s %s" (showExprConst a) (show b) - Null -> ";" + show (Block Nothing b ) = printf "begin\n%s\nend" $ indent $ unlines' $ map show b + show (Block (Just a) b ) = printf "begin : %s\n%s\nend" a $ indent $ unlines' $ map show b + show (StmtReg a b ) = printf "reg %s%s;" (showRange a) (commas [ x ++ showRange r | (x, r) <- b ]) + show (StmtInteger a ) = printf "integer %s;" $ commas a + show (Case a b Nothing ) = printf "case (%s)\n%s\nendcase" (show a) (indent $ unlines' $ map showCase b) + show (Case a b (Just c) ) = printf "case (%s)\n%s\n\tdefault:\n%s\nendcase" (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 (If a b c ) = printf "if (%s)\n%s\nelse\n%s" (show a) (indent $ show b) (indent $ show c) + show (StmtCall a ) = printf "%s;" (show a) + show (Delay a b ) = printf "#%s %s" (showExprConst a) (show b) + show (Null ) = ";" type Case = ([Expr], Stmt) @@ -285,11 +322,10 @@ data Sense deriving Eq instance Show Sense where - show a = case a of - Sense a -> show a - SenseOr a b -> printf "%s or %s" (show a) (show b) - SensePosedge a -> printf "posedge %s" (show a) - SenseNegedge a -> printf "negedge %s" (show a) + show (Sense a ) = show a + show (SenseOr a b) = printf "%s or %s" (show a) (show b) + show (SensePosedge a ) = printf "posedge %s" (show a) + show (SenseNegedge a ) = printf "negedge %s" (show a) type Range = (Expr, Expr) diff --git a/Language/SystemVerilog/Parser/Parse.y b/Language/SystemVerilog/Parser/Parse.y index a1676d3..ca2c1ab 100644 --- a/Language/SystemVerilog/Parser/Parse.y +++ b/Language/SystemVerilog/Parser/Parse.y @@ -13,7 +13,7 @@ import Language.SystemVerilog.Parser.Tokens %tokentype { Token } %error { parseError } -%expect 0 +-- %expect 0 %token @@ -157,6 +157,7 @@ Modules :: { [Module] } Module :: { Module } : "module" Identifier ModulePortList ";" ModuleItems "endmodule"{ Module $2 $3 $5 } +| "module" Identifier ListOfPortDeclarations ";" ModuleItems "endmodule" { uncurry (Module $2) $ combinePortDeclsAndModuleItems $3 $5 } Identifier :: { Identifier } : simpleIdentifier { tokenString $1 } @@ -174,22 +175,58 @@ ModulePortList1 :: { [Identifier] } ModuleItems :: { [ModuleItem] } : { [] } -| ModuleItems ModuleItem { $1 ++ [$2] } +| ModuleItems ModuleItem { $1 ++ $2 } -ModuleItem :: { ModuleItem } -: "parameter" MaybeRange Identifier "=" Expr ";" { Parameter $2 $3 $5 } -| "localparam" MaybeRange Identifier "=" Expr ";" { Localparam $2 $3 $5 } -| "input" MaybeRange Identifiers ";" { Input $2 $3 } -| "output" MaybeRange Identifiers ";" { Output $2 $3 } -| "inout" MaybeRange Identifiers ";" { Inout $2 $3 } -| "reg" MaybeRange RegDeclarations ";" { Reg $2 $3 } -| "wire" MaybeRange WireDeclarations ";" { Wire $2 $3 } -| "integer" Identifiers ";" { Integer $2 } -| "assign" LHS "=" Expr ";" { Assign $2 $4 } -| "initial" Stmt { Initial $2 } -| "always" Stmt { Always Nothing $2 } -| "always" "@" "(" Sense ")" Stmt { Always (Just $4) $6 } -| Identifier ParameterBindings Identifier Bindings ";" { Instance $1 $2 $3 $4 } +ListOfPortDeclarations + : "(" PortDeclarations ")" { $2 } + +PortDeclarations + : PortDeclaration { [$1] } + | PortDeclaration2 PortDeclarations { $1 : $2 } + +PortDeclaration2 :: { (Direction, Either Type (Maybe Range), [(Identifier, Maybe Expr)]) } + : "inout" opt(NetType) opt(Range) Identifiers "," { toPortDeclaration Inout $2 $3 $4 } + | "input" opt(NetType) opt(Range) Identifiers "," { toPortDeclaration Input $2 $3 $4 } + | "output" opt(NetType) opt(Range) Identifiers "," { toPortDeclaration Output $2 $3 $4 } + | "output" "reg" opt(Range) VarPortIdentifiers "," { (Output, Left (Reg $3), $4) } + +PortDeclaration :: { (Direction, Either Type (Maybe Range), [(Identifier, Maybe Expr)]) } + : "inout" opt(NetType) opt(Range) Identifiers { toPortDeclaration Inout $2 $3 $4 } + | "input" opt(NetType) opt(Range) Identifiers { toPortDeclaration Input $2 $3 $4 } + | "output" opt(NetType) opt(Range) Identifiers { toPortDeclaration Output $2 $3 $4 } + | "output" "reg" opt(Range) VarPortIdentifiers { (Output, Left (Reg $3), $4) } + +VarPortIdentifiers :: { [(Identifier, Maybe Expr)] } + : VarPortIdentifier { [$1] } + | VarPortIdentifiers "," VarPortIdentifier { $1 ++ [$3] } + +VarPortIdentifier :: { (Identifier, Maybe Expr) } + : Identifier { ($1, Nothing) } + | Identifier "=" Expr { ($1, Just $3) } + +opt(p) : p { Just $1 } + | { Nothing } + +NetType + : "wire" { Wire } + +MaybeTypeOrRange :: { Either Type (Maybe Range) } + : MaybeRange { Right $1 } + | "reg" MaybeRange { Left $ Reg $2 } + | "wire" MaybeRange { Left $ Wire $2 } + +ModuleItem :: { [ModuleItem] } +: "parameter" MaybeRange Identifier "=" Expr ";" { [Parameter $2 $3 $5] } +| "localparam" MaybeRange Identifier "=" Expr ";" { [Localparam $2 $3 $5] } +| PortDeclaration ";" { portDeclToModuleItems $1 } +| "reg" MaybeRange WireDeclarations ";" { map (uncurry $ LocalNet $ Reg $2) $3 } +| "wire" MaybeRange WireDeclarations ";" { map (uncurry $ LocalNet $ Wire $2) $3 } +| "integer" Identifiers ";" { [Integer $2] } +| "assign" LHS "=" Expr ";" { [Assign $2 $4] } +| "initial" Stmt { [Initial $2] } +| "always" Stmt { [Always Nothing $2] } +| "always" "@" "(" Sense ")" Stmt { [Always (Just $4) $6] } +| Identifier ParameterBindings Identifier Bindings ";" { [Instance $1 $2 $3 $4] } Identifiers :: { [Identifier] } : Identifier { [$1] } @@ -362,5 +399,49 @@ toNumber = number . tokenString | isPrefixOf "'b" a = foldl (\ n b -> shiftL n 1 .|. (if b == '1' then 1 else 0)) 0 (drop 2 a) | otherwise = error $ "Invalid number format: " ++ a + +toPortDeclaration + :: Direction + -> (Maybe ((Maybe Range) -> Type)) + -> Maybe Range + -> [Identifier] + -> (Direction, Either Type (Maybe Range), [(Identifier, Maybe Expr)]) +toPortDeclaration dir tfm mr ids = + (dir, t, vals) + where + t = + case tfm of + Nothing -> Right mr + Just tf -> Left (tf mr) + vals = zip ids (repeat Nothing) + + +portDeclToModuleItems :: (Direction, Either Type (Maybe Range), [(Identifier, Maybe Expr)]) -> [ModuleItem] +portDeclToModuleItems (dir, Right r, l) = + map (PortDecl dir r) $ map toIdentifier $ l + where + toIdentifier (x, Just _) = error "Incomplete port decl cannot have initialization" + toIdentifier (x, Nothing) = x +portDeclToModuleItems (dir, Left t, l) = + foldr (++) [] $ + map toItems l + where + r = case t of + Reg mr -> mr + Wire mr -> mr + toItems (x, e) = + [ PortDecl dir r x + , LocalNet t x e ] + +combinePortDeclsAndModuleItems + :: [(Direction, Either Type (Maybe Range), [(Identifier, Maybe Expr)])] + -> [ModuleItem] + -> ([Identifier], [ModuleItem]) +combinePortDeclsAndModuleItems portDecls items = + (declIdents, declItems ++ items) + where + declIdents = concat $ map (\(_, _, idsAndExprs) -> map fst idsAndExprs) portDecls + declItems = concat $ map portDeclToModuleItems portDecls + } diff --git a/Language/SystemVerilog/Simulator.hs b/Language/SystemVerilog/Simulator.hs deleted file mode 100644 index b03e2a7..0000000 --- a/Language/SystemVerilog/Simulator.hs +++ /dev/null @@ -1,171 +0,0 @@ -module Language.SystemVerilog.Simulator - ( Simulator - , SimCommand (..) - , SimResponse (..) - , simulator - ) where - -import Control.Monad (when) -import Data.Array.IO -import Data.Bits -import Data.IORef -import Data.Monoid -import System.IO - -import Data.VCD hiding (Var, step) -import qualified Data.VCD as VCD - -import Data.BitVec -import Language.SystemVerilog.Netlist - ---check msg = putStrLn msg >> hFlush stdout - --- | A Simulator executes 'SimCommand's. -type Simulator = SimCommand -> IO (Maybe SimResponse) - --- | Simulation commands. -data SimCommand - = Init (Maybe FilePath) - | Step - | GetSignalId Path - | GetSignal NetId - | Close - --- | Simulation responses. -data SimResponse - = Id NetId -- ^ Response to GetSignalId. - | Value BitVec -- ^ Response to GetSignal. - --- | Builds a 'Simulator' given a 'Netlist'. -simulator :: Netlist BlackBoxInit -> IO Simulator -simulator netlist' = do - let netlist = sortTopo netlist' - memory <- memory netlist - vcd <- newIORef Nothing - sample <- newIORef $ return () - step <- newIORef $ return () - return $ \ cmd -> case cmd of - Init file -> initialize netlist memory vcd file sample step - Step -> readIORef step >>= id >> return Nothing - GetSignalId path -> return $ getSignalId netlist path - GetSignal id -> readArray memory id >>= return . Just . Value - Close -> close vcd sample step >> return Nothing - -getSignalId :: Netlist BlackBoxInit -> Path -> Maybe SimResponse -getSignalId netlist path = case lookup path paths' of - Nothing -> Nothing - Just i -> Just $ Id i - where - paths = [ (paths, id) | Reg id _ paths _ <- netlist ] ++ [ (paths, id) | Var id _ paths _ <- netlist ] - paths' = [ (path, id) | (paths, id) <- paths, path <- paths ] - -type Memory = IOArray Int BitVec - -memory :: Netlist BlackBoxInit -> IO Memory -memory netlist - | null netlist = error "Empty netlist, nothing to simulate." - | otherwise = newArray (0, maximum ids) 0 - where - ids = concatMap f netlist - f a = case a of - Var a _ _ _ -> [a] - Reg a _ _ _ -> [a] - BBox _ _ _ -> [] - -initialize :: Netlist BlackBoxInit -> Memory -> IORef (Maybe VCDHandle) -> Maybe FilePath -> IORef (IO ()) -> IORef (IO ()) -> IO (Maybe SimResponse) -initialize netlist memory vcd file sample step = do - close vcd sample step - mapM_ (initializeNet memory) netlist - case file of - Nothing -> return () - Just file -> do - h <- openFile file WriteMode - vcd' <- newVCD h S - writeIORef vcd $ Just vcd' - writeIORef sample $ VCD.step vcd' 1 - mapM_ (f memory vcd' sample) netlist - netlist <- mapM initializeBBox netlist - initializeStep netlist memory sample step - return Nothing - where - f :: Memory -> VCDHandle -> IORef (IO ()) -> Net BlackBoxInit -> IO () - f memory vcd sample a = case a of - BBox _ _ _ -> return () - _ -> mapM_ (\ signal -> do - sample' <- var vcd signal $ bitVec width 0 - modifyIORef sample (>> (readArray memory i >>= sample')) - ) signals - where - (i, width, signals) = case a of - Reg i w p _ -> (i, w, p) - Var i w p _ -> (i, w, p) - BBox _ _ _ -> undefined - -initializeNet :: Memory -> Net BlackBoxInit -> IO () -initializeNet memory a = case a of - Var i w _ _ -> writeArray memory i $ bitVec w 0 - Reg i w _ _ -> writeArray memory i $ bitVec w 0 - BBox _ _ _ -> return () - -initializeBBox :: Net BlackBoxInit -> IO (Net BlackBoxStep) -initializeBBox a = case a of - Var a b c d -> return $ Var a b c d - Reg a b c d -> return $ Reg a b c d - BBox i o init -> init >>= return . BBox i o - -initializeStep :: Netlist BlackBoxStep -> Memory -> IORef (IO ()) -> IORef (IO ()) -> IO () -initializeStep netlist memory sample step = do - let steps = map stepNet netlist - writeIORef step $ do - sequence_ steps - readIORef sample >>= id - where - read = readArray memory - write' = writeMemory memory - stepNet :: Net BlackBoxStep -> IO () - stepNet a = case a of - BBox inputs outputs f -> do - outs <- mapM read inputs >>= f - sequence_ [ write' a b | (a, b) <- zip outputs outs ] - Reg q _ _ d -> read d >>= write' q - Var i _ _ expr -> case expr of - AInput -> return () - AVar a -> read a >>= write - AConst a -> write a - ASelect a b c -> do { a <- read a; b <- read b; c <- read c; write $ select a (b, c) } - ABWNot a -> read a >>= write . complement - ABWAnd a b -> do { a <- read a; b <- read b; write $ a .&. b } - ABWXor a b -> do { a <- read a; b <- read b; write $ a `xor` b } - ABWOr a b -> do { a <- read a; b <- read b; write $ a .|. b } - AMul a b -> do { a <- read a; b <- read b; write $ a * b } - AAdd a b -> do { a <- read a; b <- read b; write $ a + b } - ASub a b -> do { a <- read a; b <- read b; write $ a - b } - AShiftL a b -> do { a <- read a; b <- read b; write $ shiftL a $ fromIntegral $ value b } - AShiftR a b -> do { a <- read a; b <- read b; write $ shiftR a $ fromIntegral $ value b } - AEq a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a == value b then 1 else 0) } - ANe a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a /= value b then 1 else 0) } - ALt a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a < value b then 1 else 0) } - ALe a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a <= value b then 1 else 0) } - AGt a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a > value b then 1 else 0) } - AGe a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a >= value b then 1 else 0) } - AMux a b c -> do { a <- read a; b <- read b; c <- read c; write (if value a /= 0 then b else c) } - AConcat a b -> do { a <- read a; b <- read b; write $ mappend a b } - where - write = write' i - -writeMemory :: Memory -> Int -> BitVec -> IO () -writeMemory memory i a = do - b <- readArray memory i - when (width b /= width a) $ error $ "Memory update with different bit-vector width: index: " ++ show i ++ " old: " ++ show b ++ " new: " ++ show a - writeArray memory i a - -close :: IORef (Maybe VCDHandle) -> IORef (IO ()) -> IORef (IO ()) -> IO () -close vcd sample step = do - vcd' <- readIORef vcd - case vcd' of - Nothing -> return () - Just vcd -> hClose $ handle vcd - writeIORef vcd $ Nothing - writeIORef sample $ return () - writeIORef step $ return () - diff --git a/sv2v.hs b/sv2v.hs index e2fff60..c5a1af7 100644 --- a/sv2v.hs +++ b/sv2v.hs @@ -19,6 +19,7 @@ main = do case res of Left err -> do hPrint stderr err - exitFailure + exitSuccess + --exitFailure Right _ -> do exitSuccess