support non-blocking assignments with delay or event controls

src/Convert/PackedArray.hs

@@ -255,7 +255,7 @@ rewriteModuleItem info =
 
         rewriteStmt :: Stmt -> Stmt
         rewriteStmt (AsgnBlk op lhs expr) = convertAssignment (AsgnBlk op) lhs expr
-        rewriteStmt (Asgn       lhs expr) = convertAssignment Asgn         lhs expr
+        rewriteStmt (Asgn    mt lhs expr) = convertAssignment (Asgn    mt) lhs expr
         rewriteStmt other = other
         convertAssignment :: (LHS -> Expr -> Stmt) -> LHS -> Expr -> Stmt
         convertAssignment constructor (lhs @ (LHSIdent ident)) (expr @ (Repeat _ exprs)) =

src/Convert/Traverse.hs

@@ -143,7 +143,7 @@ traverseNestedStmtsM mapper = fullMapper
             def' <- maybeDo fullMapper def
             return $ Case u kw expr cases' def'
         cs (AsgnBlk op lhs expr) = return $ AsgnBlk op lhs expr
-        cs (Asgn       lhs expr) = return $ Asgn       lhs expr
+        cs (Asgn    mt lhs expr) = return $ Asgn    mt lhs expr
         cs (For a b c stmt) = fullMapper stmt >>= return . For a b c
         cs (While   e stmt) = fullMapper stmt >>= return . While   e
         cs (RepeatL e stmt) = fullMapper stmt >>= return . RepeatL e
@@ -165,8 +165,12 @@ traverseStmtLHSsM mapper = traverseNestedStmtsM stmtMapper
         stmtMapper (Timing (Event sense) stmt) = do
             sense' <- senseMapper sense
             return $ Timing (Event sense') stmt
+        stmtMapper (Asgn (Just (Event sense)) lhs expr) = do
+            lhs' <- fullMapper lhs
+            sense' <- senseMapper sense
+            return $ Asgn (Just $ Event sense') lhs' expr
         stmtMapper (AsgnBlk op lhs expr) = fullMapper lhs >>= \lhs' -> return $ AsgnBlk op lhs' expr
-        stmtMapper (Asgn       lhs expr) = fullMapper lhs >>= \lhs' -> return $ Asgn       lhs' expr
+        stmtMapper (Asgn    mt lhs expr) = fullMapper lhs >>= \lhs' -> return $ Asgn    mt lhs' expr
         stmtMapper other = return other
         senseMapper (Sense        lhs) = fullMapper lhs >>= return . Sense
         senseMapper (SensePosedge lhs) = fullMapper lhs >>= return . SensePosedge
@@ -268,8 +272,8 @@ traverseExprsM mapper = moduleItemMapper
         return $ Case u kw e' cases' def
     flatStmtMapper (AsgnBlk op lhs expr) =
         exprMapper expr >>= return . AsgnBlk op lhs
-    flatStmtMapper (Asgn       lhs expr) =
-        exprMapper expr >>= return . Asgn       lhs
+    flatStmtMapper (Asgn    mt lhs expr) =
+        exprMapper expr >>= return . Asgn    mt lhs
     flatStmtMapper (For (x1, e1) cc (x2, e2) stmt) = do
         e1' <- exprMapper e1
         e2' <- exprMapper e2
@@ -502,9 +506,9 @@ traverseAsgnsM mapper = moduleItemMapper
         stmtMapper (AsgnBlk op lhs expr) = do
             (lhs', expr') <- mapper (lhs, expr)
             return $ AsgnBlk op lhs' expr'
-        stmtMapper (Asgn       lhs expr) = do
+        stmtMapper (Asgn    mt lhs expr) = do
             (lhs', expr') <- mapper (lhs, expr)
-            return $ Asgn       lhs' expr'
+            return $ Asgn    mt lhs' expr'
         stmtMapper other = return other
 
 traverseAsgns :: Mapper (LHS, Expr) -> Mapper ModuleItem

src/Language/SystemVerilog/AST.hs

@@ -457,7 +457,7 @@ data Stmt
   | Case    Bool CaseKW Expr [Case] (Maybe Stmt)
   | For     (Identifier, Expr) Expr (Identifier, Expr) Stmt
   | AsgnBlk AsgnOp LHS Expr
-  | Asgn    LHS Expr
+  | Asgn    (Maybe Timing) LHS Expr
   | While   Expr Stmt
   | RepeatL Expr Stmt
   | DoWhile Expr Stmt
@@ -488,7 +488,7 @@ instance Show Stmt where
         Just c -> printf "\n\tdefault: %s" (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 o v e) = printf "%s %s %s;" (show v) (show o) (show e)
-  show (Asgn      v e) = printf "%s <= %s;" (show v) (show e)
+  show (Asgn    t v e) = printf "%s <= %s%s;" (show v) (maybe "" showPad t) (show e)
   show (While   e s) = printf  "while (%s) %s" (show e) (show s)
   show (RepeatL e s) = printf "repeat (%s) %s" (show e) (show s)
   show (DoWhile e s) = printf "do %s while (%s);" (show s) (show e)

src/Language/SystemVerilog/Parser/Parse.y

@@ -296,9 +296,9 @@ DeclOrStmtTokens(delim) :: { [DeclToken] }
   : DeclOrStmtToken                  delim  { [$1] }
   | DeclOrStmtToken DeclOrStmtTokens(delim) { [$1] ++ $2 }
   | AsgnOp Expr "," DeclOrStmtTokens(delim) { [DTAsgn $1 $2, DTComma] ++ $4 }
-  | "<="   Expr "," DeclOrStmtTokens(delim) { [DTAsgnNBlk $2, DTComma] ++ $4 }
   | AsgnOp Expr                      delim  { [DTAsgn $1 $2] }
-  | "<="   Expr                      delim  { [DTAsgnNBlk $2] }
+  | "<=" opt(DelayOrEventControl) Expr "," DeclOrStmtTokens(delim) { [DTAsgnNBlk $2 $3, DTComma] ++ $5 }
+  | "<=" opt(DelayOrEventControl) Expr                      delim  { [DTAsgnNBlk $2 $3] }
 DeclOrStmtToken :: { DeclToken }
   : ","                       { DTComma }
   | Range                     { DTRange  $1 }
@@ -456,8 +456,8 @@ Stmts :: { [Stmt] }
 Stmt :: { Stmt }
   : StmtNonAsgn         { $1 }
   | LHS AsgnOp Expr ";" { AsgnBlk $2 $1 $3 }
-  | LHS "<="   Expr ";" { Asgn       $1 $3 }
   | Identifier      ";" { Subroutine $1 [] }
+  | LHS "<=" opt(DelayOrEventControl) Expr ";" { Asgn $3 $1 $4 }
 StmtNonAsgn :: { Stmt }
   : ";" { Null }
   | "begin" opt(Tag) DeclsAndStmts "end" opt(Tag) { Block (combineTags $2 $5) (fst $3) (snd $3) }
@@ -483,11 +483,14 @@ DeclOrStmt :: { ([Decl], [Stmt]) }
   | "localparam" ParamType DeclAsgns ";" { (map (uncurry $ Localparam $2) $3, []) }
 
 TimingControl :: { Timing }
-  : DelayControl { $1 }
+  : DelayOrEventControl { $1 }
   | CycleDelay          { $1 }
+DelayOrEventControl :: { Timing }
+  : DelayControl { $1 }
   | EventControl { $1 }
 DelayControl :: { Timing }
-  : "#"  Expr { Delay $2 }
+  : "#" DelayValue   { Delay $2 }
+  | "#" "(" Expr ")" { Delay $3 }
 CycleDelay :: { Timing }
   : "##" Expr { Cycle $2 }
 EventControl :: { Timing }
@@ -503,6 +506,14 @@ Sense :: { Sense }
   | "posedge" LHS { SensePosedge $2 }
   | "negedge" LHS { SenseNegedge $2 }
 
+DelayValue :: { Expr }
+  : Number { Number $1 }
+-- TODO: Support these other DelayValues?
+-- | real_number
+-- | ps_identifier
+-- | time_literal
+-- | 1step
+
 Unique :: { Bool }
   : "unique"    { True  }
   | {- empty -} { False }

src/Language/SystemVerilog/Parser/ParseDecl.hs

@@ -47,7 +47,7 @@ import Language.SystemVerilog.AST
 data DeclToken
     = DTComma
     | DTAsgn     AsgnOp Expr
-    | DTAsgnNBlk Expr
+    | DTAsgnNBlk (Maybe Timing) Expr
     | DTRange    Range
     | DTIdent    Identifier
     | DTDir      Direction
@@ -70,7 +70,7 @@ forbidNonEqAsgn tokens =
         else id
     where
         isNonEqAsgn :: DeclToken -> Bool
-        isNonEqAsgn (DTAsgnNBlk _) = True
+        isNonEqAsgn (DTAsgnNBlk _ _) = True
         isNonEqAsgn (DTAsgn (AsgnOp _) _) = True
         isNonEqAsgn _ = False
 
@@ -174,13 +174,13 @@ parseDTsAsDeclOrAsgn tokens =
     where
         (constructor, expr) = case last tokens of
             DTAsgn     op e -> (AsgnBlk op, e)
-            DTAsgnNBlk e -> (Asgn      , e)
+            DTAsgnNBlk mt e -> (Asgn    mt, e)
             _ -> error $ "invalid block item decl or stmt: " ++ (show tokens)
         Just lhs = foldl takeLHSStep Nothing $ init tokens
         isAsgnToken :: DeclToken -> Bool
         isAsgnToken (DTBit             _) = True
         isAsgnToken (DTConcat          _) = True
-        isAsgnToken (DTAsgnNBlk        _) = True
+        isAsgnToken (DTAsgnNBlk      _ _) = True
         isAsgnToken (DTAsgn (AsgnOp _) _) = True
         isAsgnToken _ = False
 
@@ -280,7 +280,7 @@ takeRanges (token : tokens) =
 -- `DTAsgnNBlk`, so this doesn't liberalize the parser.
 takeAsgn :: [DeclToken] -> (Maybe Expr, [DeclToken])
 takeAsgn (DTAsgn AsgnOpEq e : rest) = (Just e , rest)
-takeAsgn (DTAsgnNBlk      e : rest) = (Just e , rest)
+takeAsgn (DTAsgnNBlk    _ e : rest) = (Just e , rest)
 takeAsgn                 rest  = (Nothing, rest)
 
 takeComma :: [DeclToken] -> (Bool, [DeclToken])