hacky, preliminary support for port declarations in module header

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)
 

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] }
-
-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 }
+| ModuleItems ModuleItem  { $1 ++ $2 }
+
+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
+
 }
 

Language/SystemVerilog/Simulator.hs

-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 ()
-

sv2v.hs

@@ -19,6 +19,7 @@ main = do
     case res of
         Left  err -> do
             hPrint stderr err
-            exitFailure
+            exitSuccess
+            --exitFailure
         Right _ -> do
             exitSuccess