logic conversion fixes produced reg-to-output bindings

- generally cleaned up and documented the Logic conversion
- made exprToLHS a shared helper function, now uses Maybe
- ported existing local exprToLHS helpers to the new one

src/Convert/Interface.hs

@@ -249,7 +249,7 @@ inlineInterface (ports, items) (instanceName, instancePorts) =
         portBindingItem (ident, Just expr) =
             Just $ if declDirs Map.! ident == Input
                 then Assign Nothing (LHSIdent ident) expr
-                else Assign Nothing (exprToLHS expr) (Ident ident)
+                else Assign Nothing (toLHS expr) (Ident ident)
         portBindingItem (_, Nothing) = Nothing
 
         declDirs = execWriter $
@@ -261,12 +261,9 @@ inlineInterface (ports, items) (instanceName, instancePorts) =
                 else return ()
         collectDeclDir _ = return ()
 
-        exprToLHS :: Expr -> LHS
+        toLHS :: Expr -> LHS
-        exprToLHS (Ident   x  ) = LHSIdent x
+        toLHS expr =
-        exprToLHS (Bit   l e  ) = LHSBit   (exprToLHS l) e
+            case exprToLHS expr of
-        exprToLHS (Range l m r) = LHSRange (exprToLHS l) m r
+                Just lhs -> lhs
-        exprToLHS (Dot   l x  ) = LHSDot   (exprToLHS l) x
+                Nothing  -> error $ "trying to bind an interface output to " ++
-        exprToLHS (Concat ls  ) = LHSConcat $ map exprToLHS ls
+                                show expr ++ " but that can't be an LHS"
-        exprToLHS other =
-            error $ "trying to bind (part of) an interface output to " ++
-                show other ++ " but that can't be an LHS"

src/Convert/Logic.hs

@@ -1,31 +1,61 @@
 {- sv2v
  - Author: Zachary Snow <zach@zachjs.com>
  -
- - Conversion for `logic`
+ - Conversion from `logic` to `wire` or `reg`
+ -
+ - We convert a module-level logic to a reg if it is assigned to in an always or
+ - initial block. Other module-level logics become wires. All other logics
+ - (i.e., in a function) become regs.
+ -
+ - The struct conversion and Verilog-2005's lack of permissive net vs. variable
+ - resolution leads to some interesting special cases for this conversion, as
+ - parts of a struct may be used as a variable, while other parts may be used as
+ - a net.
+ -
+ - 1) If a reg, or a portion thereof, is assigned by a continuous assignment
+ - item, then that assignment is converted to a procedural assignment within an
+ - added `always_comb` item.
+ -
+ - 2) If a reg, or a portion thereof, is bound to an output port, then that
+ - binding is replaced by a temporary net declaration, and a procedural
+ - assignment is added which updates the reg to the value of the new net.
  -}
 
--- 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.Map.Strict as Map
 import qualified Data.Set as Set
 
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
 type Idents = Set.Set Identifier
+type Ports = Map.Map (Identifier, Identifier) Direction
 
 convert :: AST -> AST
-convert = traverseDescriptions convertDescription
+convert ast =
+    traverseDescriptions (convertDescription ports) ast
+    where
+        ports = execWriter $ collectDescriptionsM collectPortsM ast
+        collectPortsM :: Description -> Writer Ports ()
+        collectPortsM (orig @ (Part _ _ _ name portNames _)) =
+            collectModuleItemsM collectPortDirsM orig
+            where
+                collectPortDirsM :: ModuleItem -> Writer Ports ()
+                collectPortDirsM (MIDecl (Variable dir _ ident _ _)) =
+                    if dir == Local then
+                        return ()
+                    else if elem ident portNames then
+                        tell $ Map.singleton (name, ident) dir
+                    else
+                        error $ "encountered decl with a dir that isn't a port: "
+                            ++ show (dir, ident)
+                collectPortDirsM _ = return ()
+        collectPortsM _ = return ()
 
-convertDescription :: Description -> Description
+convertDescription :: Ports -> Description -> Description
-convertDescription orig =
+convertDescription ports orig =
     if shouldConvert
         then traverseModuleItems conversion orig
         else orig
@@ -38,12 +68,47 @@ convertDescription orig =
         conversion = traverseDecls convertDecl . convertModuleItem
         idents = execWriter (collectModuleItemsM regIdents orig)
         convertModuleItem :: ModuleItem -> ModuleItem
+        -- rewrite bad continuous assignments to use procedural assignments
         convertModuleItem (Assign Nothing lhs expr) =
-            if Set.null $ Set.intersection usedIdents idents
+            if Set.disjoint usedIdents idents
                 then Assign Nothing lhs expr
                 else AlwaysC AlwaysComb $ AsgnBlk AsgnOpEq lhs expr
             where
                 usedIdents = execWriter $ collectNestedLHSsM lhsIdents lhs
+        -- rewrite port bindings to use temporary nets where necessary
+        convertModuleItem (Instance moduleName params instanceName rs bindings) =
+            if null newItems
+                then Instance moduleName params instanceName rs bindings
+                else Generate $ map GenModuleItem $
+                    (MIPackageItem $ Comment "rewrote reg-to-output bindings") :
+                    newItems ++
+                    [Instance moduleName params instanceName rs bindings']
+            where
+                (bindings', newItemsList) = unzip $ map fixBinding bindings
+                newItems = concat newItemsList
+                fixBinding :: PortBinding -> (PortBinding, [ModuleItem])
+                fixBinding (portName, Just expr) =
+                    if portDir /= Just Output || Set.disjoint usedIdents idents
+                        then ((portName, Just expr), [])
+                        else ((portName, Just tmpExpr), items)
+                    where
+                        portDir = Map.lookup (moduleName, portName) ports
+                        usedIdents = execWriter $
+                            collectNestedExprsM exprIdents expr
+                        tmp = "sv2v_tmp_" ++ instanceName ++ "_" ++ portName
+                        tmpExpr = Ident tmp
+                        t = Net TWire [(Bits $ Right expr, Number "0")]
+                        items =
+                            [ MIDecl $ Variable Local t tmp [] Nothing
+                            , AlwaysC AlwaysComb $ AsgnBlk AsgnOpEq lhs tmpExpr]
+                        lhs = case exprToLHS expr of
+                            Just l -> l
+                            Nothing ->
+                                error $ "bad non-lhs, non-net expr "
+                                    ++ show expr ++ " connected to output port "
+                                    ++ portName ++ " of " ++ instanceName
+                fixBinding other = (other, [])
+        -- rewrite variable declarations to have the correct type
         convertModuleItem (MIDecl (Variable dir (IntegerVector TLogic sg mr) ident a me)) =
             MIDecl $ Variable dir (t mr) ident a me
             where
@@ -74,5 +139,9 @@ regIdents (Initial stmt) =
 regIdents _ = return ()
 
 lhsIdents :: LHS -> Writer Idents ()
-lhsIdents (LHSIdent  vx  ) = tell $ Set.singleton vx
+lhsIdents (LHSIdent x) = tell $ Set.singleton x
 lhsIdents _ = return () -- the collector recurses for us
+
+exprIdents :: Expr -> Writer Idents ()
+exprIdents (Ident x) = tell $ Set.singleton x
+exprIdents _ = return () -- the collector recurses for us

src/Convert/Traverse.hs

@@ -466,9 +466,12 @@ exprMapperHelpers exprMapper =
     declMapper (Localparam t x e) =
         exprMapper e >>= return . Localparam t x
     declMapper (Variable d t x a me) = do
+        let (tf, rs) = typeRanges t
+        rs' <- mapM rangeMapper rs
+        let t' = tf rs'
         a' <- mapM rangeMapper a
         me' <- maybeExprMapper me
-        return $ Variable d t x a' me'
+        return $ Variable d t' x a' me'
 
 traverseExprsM' :: Monad m => TFStrategy -> MapperM m Expr -> MapperM m ModuleItem
 traverseExprsM' strat exprMapper = moduleItemMapper

src/Language/SystemVerilog/AST.hs

@@ -25,6 +25,7 @@ module Language.SystemVerilog.AST
     , module Op
     , module Stmt
     , module Type
+    , exprToLHS
     ) where
 
 import Language.SystemVerilog.AST.Attr as Attr
@@ -39,3 +40,19 @@ import Language.SystemVerilog.AST.Stmt as Stmt
 import Language.SystemVerilog.AST.Type as Type
 
 type AST = [Description]
+
+exprToLHS :: Expr -> Maybe LHS
+exprToLHS (Ident   x  ) = Just $ LHSIdent x
+exprToLHS (Bit   l e  ) = do
+    l' <- exprToLHS l
+    Just $ LHSBit   l' e
+exprToLHS (Range l m r) = do
+    l' <- exprToLHS l
+    Just $ LHSRange l' m r
+exprToLHS (Dot   l x  ) = do
+    l' <- exprToLHS l
+    Just $ LHSDot   l' x
+exprToLHS (Concat ls  ) = do
+    ls' <- mapM exprToLHS ls
+    Just $ LHSConcat ls'
+exprToLHS _ = Nothing

src/Language/SystemVerilog/Parser/Parse.y

@@ -533,7 +533,7 @@ NOutputGate :: { (Maybe Identifier, [LHS], Expr) }
   : opt(Identifier) "(" NOutputGateItems { ($1, fst $3, snd $3) }
 NOutputGateItems :: { ([LHS], Expr) }
   : Expr ")" { ([], $1) }
-  | Expr "," NOutputGateItems { (fst $3 ++ [exprToLHS $1], snd $3) }
+  | Expr "," NOutputGateItems { (fst $3 ++ [toLHS $1], snd $3) }
 
 NInputGateKW :: { NInputGateKW }
   : "and"  { GateAnd  }
@@ -938,12 +938,10 @@ combineTags (Just a) (Just b) =
 combineTags Nothing other = other
 combineTags other   _     = other
 
-exprToLHS :: Expr -> LHS
+toLHS :: Expr -> LHS
-exprToLHS (Ident   x  ) = LHSIdent x
+toLHS expr =
-exprToLHS (Bit   e b  ) = LHSBit   (exprToLHS e) b
+  case exprToLHS expr of
-exprToLHS (Range e m r) = LHSRange (exprToLHS e) m r
+    Just lhs -> lhs
-exprToLHS (Dot   e x  ) = LHSDot   (exprToLHS e) x
+    Nothing -> error $ "Parse error: cannot convert expression to LHS: "
-exprToLHS (Concat es  ) = LHSConcat (map exprToLHS es)
+                ++ show expr
-exprToLHS other =
-  error $ "Parse error: cannot convert expression to LHS: " ++ show other
 }