more test coverage and dead code removal

src/Convert/ImplicitNet.hs

@@ -31,11 +31,10 @@ traverseDescription defaultNetType (PackageItem (Directive str)) =
             if isPrefixOf prefix str
                 then parseDefaultNetType $ drop (length prefix) str
                 else defaultNetType
-traverseDescription defaultNetType (part @ Part{}) =
+traverseDescription defaultNetType description =
     (defaultNetType, partScoper traverseDeclM
         (traverseModuleItemM defaultNetType)
-        return return part)
+        return return description)
-traverseDescription defaultNetType other = (defaultNetType, other)
 
 traverseDeclM :: Decl -> Scoper () Decl
 traverseDeclM decl = do

src/Convert/Interface.hs

@@ -8,7 +8,7 @@
 module Convert.Interface (convert) where
 
 import Data.List (isPrefixOf)
-import Data.Maybe (mapMaybe)
+import Data.Maybe (isNothing, mapMaybe)
 import Control.Monad.Writer.Strict
 import qualified Data.Map.Strict as Map
 
@@ -21,7 +21,7 @@ data PartInfo = PartInfo
     { pKind :: PartKW
     , pPorts :: [Identifier]
     , pItems :: [ModuleItem]
-    } deriving Eq
+    }
 type PartInfos = Map.Map Identifier PartInfo
 
 type ModportInstances = [(Identifier, Identifier)]
@@ -73,7 +73,7 @@ convertDescription parts (Part attrs extern Module lifetime name ports items) =
         traverseModuleItemM (Modport modportName modportDecls) =
             insertElem modportName modportDecls >> return (Generate [])
         traverseModuleItemM (instanceItem @ Instance{}) =
-            if maybePartInfo == Nothing then
+            if isNothing maybePartInfo then
                 return instanceItem
             else if partKind == Interface then
                 -- inline instantiation of an interface

src/Convert/Jump.hs

@@ -134,10 +134,9 @@ convertStmt :: Stmt -> State Info Stmt
 convertStmt (Block Par x decls stmts) = do
     -- break, continue, and return disallowed in fork-join
     jumpAllowed <- gets sJumpAllowed
-    returnAllowed <- gets sReturnAllowed
+    modify $ \s -> s { sJumpAllowed = False }
-    modify $ \s -> s { sJumpAllowed = False, sReturnAllowed = False }
     stmts' <- mapM convertStmt stmts
-    modify $ \s -> s { sJumpAllowed = jumpAllowed, sReturnAllowed = returnAllowed }
+    modify $ \s -> s { sJumpAllowed = jumpAllowed }
     return $ Block Par x decls stmts'
 
 convertStmt (Block Seq x decls stmts) =

src/Convert/RemoveComments.hs

@@ -22,7 +22,6 @@ isTopLevelComment (PackageItem (Decl CommentDecl{})) = True
 isTopLevelComment _ = False
 
 convertModuleItem :: ModuleItem -> ModuleItem
-convertModuleItem (MIAttr _ (Generate [])) = Generate []
 convertModuleItem (MIPackageItem (Decl CommentDecl{})) = Generate []
 convertModuleItem (MIPackageItem item) =
     MIPackageItem $ convertPackageItem item

src/Convert/Struct.hs

@@ -49,10 +49,9 @@ convertStruct' isStruct sg fields =
         zero = RawNum 0
         typeRange :: Type -> Range
         typeRange t =
-            case ranges of
+            if null ranges
-                [] -> (zero, zero)
+                then (zero, zero)
-                [range] -> range
+                else let [range] = ranges in range
-                _ -> error "Struct.hs invariant failure"
             where ranges = snd $ typeRanges t
 
         -- extract info about the fields
@@ -204,8 +203,8 @@ convertExpr t (Mux c e1 e2) =
 convertExpr (struct @ (Struct _ fields [])) (Pattern itemsOrig) =
     if extraNames /= Set.empty then
         error $ "pattern " ++ show (Pattern itemsOrig) ++
-            " has extra named fields: " ++
+            " has extra named fields " ++ show (Set.toList extraNames) ++
-            show (Set.toList extraNames) ++ " that are not in " ++ show struct
+            " that are not in " ++ show struct
     else if structIsntReady struct then
         Pattern items
     else
@@ -223,7 +222,7 @@ convertExpr (struct @ (Struct _ fields [])) (Pattern itemsOrig) =
             -- position-based patterns should cover every field
             else if length itemsOrig /= length fields then
                 error $ "struct pattern " ++ show (Pattern itemsOrig) ++
-                    " doesn't have the same # of items as " ++ show struct
+                    " doesn't have the same number of items as " ++ show struct
             -- if the pattern does not use identifiers, use the
             -- identifiers from the struct type definition in order
             else
@@ -254,9 +253,9 @@ convertExpr (struct @ (Struct _ fields [])) (Pattern itemsOrig) =
             else if Map.member defaultKey specialItemMap then
                 specialItemMap Map.! defaultKey
             else
-                error $ "couldn't find field " ++ fieldName ++
+                error $ "couldn't find field '" ++ fieldName ++
-                    " from struct definition " ++ show struct ++
+                    "' from struct definition " ++ show struct ++
-                    " in struct pattern " ++ show itemsOrig
+                    " in struct pattern " ++ show (Pattern itemsOrig)
             where
                 fieldType = fieldTypeMap Map.! fieldName
                 fieldTypeName =
@@ -328,10 +327,8 @@ convertLHS :: LHS -> Scoper Type (Type, LHS)
 convertLHS l = do
     let e = lhsToExpr l
     (t, e') <- embedScopes convertSubExpr e
-    return $ case exprToLHS e' of
+    let Just l' = exprToLHS e'
-        Just l' -> (t, l')
+    return (t, l')
-        Nothing -> error $ "struct conversion created non-LHS from "
-                    ++ (show e) ++ " to " ++ (show e')
 
 -- try expression conversion by looking at the *innermost* type first
 convertSubExpr :: Scopes Type -> Expr -> (Type, Expr)
@@ -389,10 +386,9 @@ convertSubExpr scopes (Range (Dot e x) mode (baseO, lenO)) =
         baseLeft  = BinOp Sub (fst bounds) $ BinOp Sub (fst dim) baseO'
         baseRight = BinOp Add (snd bounds) $ BinOp Sub (snd dim) baseO'
         baseDec = baseLeft
-        baseInc = case mode of
+        baseInc = if mode == IndexedPlus
-            IndexedPlus  -> BinOp Add (BinOp Sub baseRight lenO') one
+            then BinOp Add (BinOp Sub baseRight lenO') one
-            IndexedMinus -> BinOp Sub (BinOp Add baseRight lenO') one
+            else BinOp Sub (BinOp Add baseRight lenO') one
-            NonIndexed   -> error "invariant violated"
         base = endianCondExpr dim baseDec baseInc
         undotted = Range e' mode (base, lenO')
         one = RawNum 1
@@ -471,7 +467,7 @@ isntStruct = (== Nothing) . getFields
 lookupFieldInfo :: Type -> Identifier -> (Type, Range, [Range])
 lookupFieldInfo struct fieldName =
     if maybeFieldType == Nothing
-        then error $ "field '" ++ fieldName ++ "' not found in: " ++ show struct
+        then error $ "field '" ++ fieldName ++ "' not found in " ++ show struct
         else (fieldType, bounds, dims)
     where
         Just fields = getFields struct
@@ -484,14 +480,11 @@ lookupFieldInfo struct fieldName =
 -- attempts to convert based on the assignment-like contexts of TF arguments
 convertCall :: Scopes Type -> Expr -> Args -> Args
 convertCall scopes fn (Args pnArgs kwArgs) =
-    case exprToLHS fn of
+    Args (map snd pnArgs') kwArgs'
-        Just fnLHS ->
-            Args (map snd pnArgs') kwArgs'
-            where
-                pnArgs' = map (convertArg fnLHS) $ zip idxs pnArgs
-                kwArgs' = map (convertArg fnLHS) kwArgs
-        _ -> Args pnArgs kwArgs
     where
+        Just fnLHS = exprToLHS fn
+        pnArgs' = map (convertArg fnLHS) $ zip idxs pnArgs
+        kwArgs' = map (convertArg fnLHS) kwArgs
         idxs = map show ([0..] :: [Int])
         convertArg :: LHS -> (Identifier, Expr) -> (Identifier, Expr)
         convertArg lhs (x, e) =

src/Language/SystemVerilog/AST/Decl.hs

@@ -23,7 +23,7 @@ data Decl
     | ParamType ParamScope Identifier Type
     | Variable   Direction Type Identifier [Range] Expr
     | CommentDecl String
-    deriving (Eq, Ord)
+    deriving Eq
 
 instance Show Decl where
     showList l _ = unlines' $ map show l
@@ -41,7 +41,7 @@ data Direction
     | Output
     | Inout
     | Local
-    deriving (Eq, Ord)
+    deriving Eq
 
 instance Show Direction where
     show Input  = "input"
@@ -52,7 +52,7 @@ instance Show Direction where
 data ParamScope
     = Parameter
     | Localparam
-    deriving (Eq, Ord)
+    deriving Eq
 
 instance Show ParamScope where
     show Parameter  = "parameter"

src/Language/SystemVerilog/AST/Description.hs

@@ -89,7 +89,7 @@ data Lifetime
     = Static
     | Automatic
     | Inherit
-    deriving (Eq, Ord)
+    deriving Eq
 
 instance Show Lifetime where
     show Static    = "static"

src/Language/SystemVerilog/AST/Type.hs

@@ -89,15 +89,11 @@ instance Show ([Range] -> Type) where
     show tf = show (tf [])
 instance Eq ([Range] -> Type) where
     (==) tf1 tf2 = (tf1 []) == (tf2 [])
-instance Ord ([Range] -> Type) where
-    compare tf1 tf2 = compare (tf1 []) (tf2 [])
 
 instance Show (Signing -> [Range] -> Type) where
     show tf = show (tf Unspecified)
 instance Eq (Signing -> [Range] -> Type) where
     (==) tf1 tf2 = (tf1 Unspecified) == (tf2 Unspecified)
-instance Ord (Signing -> [Range] -> Type) where
-    compare tf1 tf2 = compare (tf1 Unspecified) (tf2 Unspecified)
 
 typeRanges :: Type -> ([Range] -> Type, [Range])
 typeRanges typ =

test/basic/fork_join.sv

@@ -0,0 +1,7 @@
+module top;
+    initial
+        fork
+            $display("A");
+            $display("B");
+        join
+endmodule

test/basic/jump.sv

@@ -136,4 +136,13 @@ module top;
         $display("Block F-1");
     end
 
+    initial begin
+        int i;
+        for (i = 0; i < 10; ++i)
+            if (i < 5)
+                $display("Loop F:", i);
+            else
+                break;
+    end
+
 endmodule

test/basic/jump.v

@@ -112,4 +112,10 @@ module top;
         $display("Block F-1");
     end
 
+    initial begin : loop_f
+        integer i;
+        for (i = 0; i < 5; ++i)
+            $display("Loop F:", i);
+    end
+
 endmodule

test/error/break_inside_fork.sv

@@ -0,0 +1,8 @@
+// pattern: encountered break inside fork-join
+module top;
+    final
+        while (1)
+        fork
+            break;
+        join
+endmodule

test/error/break_outside_loop.sv

@@ -0,0 +1,4 @@
+// pattern: encountered break outside of loop
+module top;
+    initial break;
+endmodule

test/error/continue_inside_fork.sv

@@ -0,0 +1,8 @@
+// pattern: encountered continue inside fork-join
+module top;
+    initial
+        while (1)
+        fork
+            continue;
+        join
+endmodule

test/error/continue_outside_loop.sv

@@ -0,0 +1,4 @@
+// pattern: encountered continue outside of loop
+module top;
+    initial continue;
+endmodule

test/error/return_inside_fork.sv

@@ -0,0 +1,9 @@
+// pattern: encountered return inside fork-join
+module top;
+    task t;
+        fork
+            return;
+        join
+    endtask
+    initial t;
+endmodule

test/error/return_outside_tf.sv

@@ -0,0 +1,4 @@
+// pattern: encountered return outside of task or function
+module top;
+    initial return;
+endmodule

test/error/struct_extra_named_field.sv

@@ -0,0 +1,6 @@
+// pattern: pattern '\{..x: 1,..y: 2.\} has extra named fields \["y"\] that are not in struct packed \{..logic x;.\}
+module top;
+    struct packed {
+        logic x;
+    } x = '{ x: 1, y: 2 };
+endmodule

test/error/struct_extra_unnamed_field.sv

@@ -0,0 +1,6 @@
+// pattern: pattern '\{..1,..2.\} doesn't have the same number of items as struct packed \{..logic x;.\}
+module top;
+    struct packed {
+        logic x;
+    } x = '{ 1, 2 };
+endmodule

test/error/struct_missing_field.sv

@@ -0,0 +1,6 @@
+// pattern: couldn't find field 'y' from struct definition struct packed \{..logic x;..logic y;.\} in struct pattern '\{..x: 1.\}
+module top;
+    struct packed {
+        logic x, y;
+    } s = '{ x: 1 };
+endmodule

test/error/struct_unknown_field.sv

@@ -0,0 +1,8 @@
+// pattern: field 'y' not found in struct packed \{..logic x;.\}
+module top;
+    struct packed {
+        logic x;
+    } x;
+    assign x.x = 1;
+    assign x.y = 0;
+endmodule