rewrite ProessDecl to be more specific - a sequential process with explicit clock and (optional) reset

pheaver · pheaver · commit 9bc9e7864f64 · 2010-11-20T21:05:45.000-08:00
diff --git a/netlist-to-verilog/Language/Netlist/GenVerilog.hs b/netlist-to-verilog/Language/Netlist/GenVerilog.hs
@@ -17,6 +17,7 @@
 -- AST permits left- and right-rotate operators, which are not supported in
 -- Verilog.
 --------------------------------------------------------------------------------
+{-# LANGUAGE ViewPatterns #-}
 
 -- TODO: endianness - currently we're hardcoded to little endian verilog
 
@@ -86,51 +87,34 @@ mk_decl (InitProcessDecl stmt)
 mk_decl (CommentDecl str)
   = [V.CommentItem str]
 
--- nothing to do here
-mk_decl (ProcessDecl [])
-  = []
-
-mk_decl (ProcessDecl xs)
+mk_decl (ProcessDecl (Event (mk_expr -> clk) edge) Nothing stmt)
   = [V.AlwaysItem (V.EventControlStmt e (Just s))]
   where
-    s = mk_process_stmt xs
-    e = V.EventControlExpr $ mk_trigger (map fst xs)
+    e    = V.EventControlExpr event
+    s    = V.IfStmt cond (Just (mk_stmt stmt)) Nothing
+
+    (event, cond) = edge_helper edge clk
+
+mk_decl (ProcessDecl (Event (mk_expr -> clk) clk_edge)
+         (Just (Event (mk_expr -> reset) reset_edge, reset_stmt)) stmt)
+  = [V.AlwaysItem (V.EventControlStmt e (Just s1))]
+  where
+    e = V.EventControlExpr (V.EventOr clk_event reset_event)
+
+    s1    = V.IfStmt reset_cond (Just (mk_stmt reset_stmt)) (Just s2)
+    s2    = V.IfStmt clk_cond   (Just (mk_stmt stmt)) Nothing
+
+    (clk_event, clk_cond) = edge_helper clk_edge clk
+    (reset_event, reset_cond) = edge_helper reset_edge reset
+
+edge_helper :: Edge -> V.Expression -> (V.EventExpr, V.Expression)
+edge_helper PosEdge x = (V.EventPosedge x, x)
+edge_helper NegEdge x = (V.EventNegedge x, V.ExprUnary V.UBang x)
 
 mk_range :: Range -> V.Range
 mk_range (Range e1 e2)
   = V.Range (mk_expr e1) (mk_expr e2)
 
-mk_process_stmt :: [(Event, Stmt)] -> V.Statement
-mk_process_stmt []
-  = error "mk_process_stmt: empty list"
-mk_process_stmt [(_, stmt)]
-  -- if this is the last one, then we don't have to check the event condition
-  = mk_stmt stmt
-mk_process_stmt ((Event e edge, stmt):xs)
-  = V.IfStmt cond (Just (mk_stmt stmt)) (Just (mk_process_stmt xs))
-  where
-    cond = case edge of
-             PosEdge -> (mk_expr e)
-             NegEdge -> V.ExprUnary V.UBang (mk_expr e)
-
--- create a Verilog event expression from a list of triggers.
--- the list must have at least one 'Event' field in it.
-mk_trigger :: [Event] -> V.EventExpr
-mk_trigger []
-  = error "mk_trigger: empty event list"
-mk_trigger xs0
-  = foldr1 V.EventOr (f xs0)
-  where
-    f []                  = []
-    f (Event x edge : xs) = e : f xs
-      where
-        e = case edge of
-              PosEdge -> V.EventPosedge (mk_expr x)
-              NegEdge -> V.EventNegedge (mk_expr x)
-              -- AnyEdge -> V.EventExpr (expr_var x)
-                         -- V.EventOr (V.EventPosedge (expr_var x)) (V.EventNegedge (expr_var x))
-                         -- is this the right thing to do?
-
 mk_stmt :: Stmt -> V.Statement
 mk_stmt (Assign x expr)
   = V.NonBlockingAssignment (mk_expr x) Nothing (mk_expr expr)
diff --git a/netlist-to-vhdl/Language/Netlist/GenVHDL.hs b/netlist-to-vhdl/Language/Netlist/GenVHDL.hs
@@ -17,7 +17,6 @@ import Language.Netlist.AST
 
 import Text.PrettyPrint
 import Data.Maybe(catMaybes)
-import Data.List(nub)
 
 
 -- | Generate a 'Language.Netlist.AST.Module' as a VHDL file . The ['String'] argument
@@ -78,9 +77,6 @@ decl (MemDecl i (Just asize) dsize) = Just $
 
 decl _d = Nothing
 
-
-
-
 insts ::  [Decl] -> Doc
 insts [] = empty
 insts is = case catMaybes $ zipWith inst gensyms is of
@@ -91,13 +87,37 @@ insts is = case catMaybes $ zipWith inst gensyms is of
 inst :: String -> Decl -> Maybe Doc
 inst _ (NetAssign i e) = Just $ text i <+> text "<=" <+> expr e
 
-inst gensym proc@(ProcessDecl evs) = Just $
+inst gensym (ProcessDecl (Event clk edge) Nothing s) = Just $
     text gensym <+> colon <+> text "process" <> senlist <+> text "is" $$
     text "begin" $$
-    nest 2 (pstmts evs) $$
+    nest 2 (text "if" <+> nest 2 event <+> text "then" $$
+            nest 2 (stmt s) $$
+            text "end if" <> semi) $$
     text "end process" <+> text gensym
-  where senlist = parens $ cat $ punctuate comma $ map expr $   mkSensitivityList proc
+  where
+    senlist = parens $ expr clk
+    event   = case edge of
+                PosEdge -> text "rising_edge" <> parens (expr clk)
+                NegEdge -> text "falling_edge" <> parens (expr clk)
 
+inst gensym (ProcessDecl (Event clk clk_edge)
+             (Just (Event reset reset_edge, reset_stmt)) s) = Just $
+    text gensym <+> colon <+> text "process" <> senlist <+> text "is" $$
+    text "begin" $$
+    nest 2 (text "if" <+> nest 2 reset_event <+> text "then" $$
+            nest 2 (stmt reset_stmt) $$
+            text "elsif" <+> nest 2 clk_event <+> text "then" $$
+            nest 2 (stmt s) $$
+            text "end if" <> semi) $$
+    text "end process" <+> text gensym
+  where
+    senlist     = parens $ cat $ punctuate comma $ map expr [ clk, reset ]
+    clk_event   = case clk_edge of
+                    PosEdge -> text "rising_edge" <> parens (expr clk)
+                    NegEdge -> text "falling_edge" <> parens (expr clk)
+    reset_event = case reset_edge of
+                    PosEdge -> expr reset <+> text "= '1'"
+                    NegEdge -> expr reset <+> text "= '0'"
 
 
 inst _ (InstDecl nm inst gens ins outs) = Just $
@@ -130,18 +150,6 @@ inst _ (CommentDecl msg) = Just $
 
 inst _ _d = Nothing
 
-pstmts :: [(Event, Stmt)] -> Doc
-pstmts ss = (vcat $ zipWith mkIf is ss)  $$ text "end if" <> semi
-  where is = (text "if"):(repeat (text "elsif"))
-        mkIf i (p,s) = i <+> nest 2 (event p) <+> text "then" $$
-                       nest 2 (stmt s)
-
-event :: Event -> Doc
-event (Event i PosEdge)   = text "rising_edge" <> parens (expr i)
-event (Event i NegEdge)   = text "falling_edge" <> parens (expr i)
-event (Event i AsyncHigh) = expr i <+> text "= '1'"
-event (Event i AsyncLow)  = expr i <+> text "= '0'"
-
 stmt :: Stmt -> Doc
 stmt (Assign l r) = expr l <+> text "<=" <+> expr r <> semi
 stmt (Seq ss) = vcat (map stmt ss)
@@ -215,18 +223,6 @@ expr (ExprCase e ((p:ps,alt):alts) def) =
 expr x = text (show x)
 
 
--- | mkSensitivityList takes a process and extracts the appropriate sensitify list
---
-
-mkSensitivityList :: Decl -> [Expr]
-mkSensitivityList (ProcessDecl evs) = nub event_names
-  where event_names =
-	 	--   AJG: This is now *only* based on the 'Event' vars, nothing else.
-		map (\ (e,_) -> case e of
-				 Event (ExprVar name) _ -> ExprVar name
-				 _ -> error $ "strange form for mkSensitivityList " ++ show e
-		    ) evs
-
 lookupUnary :: UnaryOp -> Doc -> Doc
 lookupUnary op e = text (unOp op) <> parens e
 
diff --git a/netlist/Language/Netlist/AST.hs b/netlist/Language/Netlist/AST.hs
@@ -88,20 +88,8 @@ data Decl
   -- declare an external module entity
   -- TODO: ExternDecl ExternLang
 
-  -- | A general process construct, compatible with both VHDL and Verilog
-  -- processes.  It supports positive and negative edge triggers and a body (a
-  -- statement) for each trigger.  Here are loose semantics of a process
-  -- @[(trigger0, stmt0), (trigger1, stmt1)...]@:
-  --
-  -- @
-  -- if trigger0
-  --    statement0
-  -- else if
-  --    trigger1
-  -- ...
-  -- @
-
-  | ProcessDecl [(Event, Stmt)]
+  -- | A sequential process with clock and (optional) asynchronous reset.
+  | ProcessDecl Event (Maybe (Event, Stmt)) Stmt
 
   -- | A statement that executes once at the beginning of simulation.
   -- Equivalent to Verilog \"initial\" statement.
@@ -132,9 +120,6 @@ data Event
 data Edge
   = PosEdge
   | NegEdge
-  | AsyncHigh
-  | AsyncLow
-  -- TODO: AnyEdge?
   deriving (Eq, Ord, Show, Data, Typeable)
 
 -- | Expr is a combination of VHDL and Verilog expressions.
@@ -274,8 +259,10 @@ instance Binary Decl where
                                               put x3
                                               put x4
                                               put x5
-                ProcessDecl x1 -> do putWord8 4
-                                     put x1
+                ProcessDecl x1 x2 x3 -> do putWord8 4
+                                           put x1
+                                           put x2
+                                           put x3
                 InitProcessDecl x1 -> do putWord8 5
                                          put x1
                 CommentDecl x1 -> do putWord8 6
@@ -301,7 +288,9 @@ instance Binary Decl where
                            x5 <- get
                            return (InstDecl x1 x2 x3 x4 x5)
                    4 -> do x1 <- get
-                           return (ProcessDecl x1)
+                           x2 <- get
+                           x3 <- get
+                           return (ProcessDecl x1 x2 x3)
                    5 -> do x1 <- get
                            return (InitProcessDecl x1)
                    6 -> do x1 <- get
@@ -334,15 +323,11 @@ instance Binary Edge where
           = case x of
                 PosEdge -> putWord8 0
                 NegEdge -> putWord8 1
-                AsyncHigh -> putWord8 2
-                AsyncLow -> putWord8 3
         get
           = do i <- getWord8
                case i of
                    0 -> return PosEdge
                    1 -> return NegEdge
-                   2 -> return AsyncHigh
-                   3 -> return AsyncLow
                    _ -> error "Corrupted binary data for Edge"
 
 
diff --git a/netlist/Language/Netlist/Examples.hs b/netlist/Language/Netlist/Examples.hs
@@ -31,12 +31,11 @@ ds :: [Decl]
 ds = [ NetDecl "a" (makeRange Down 16) (Just (ExprVar "x"))
      , NetDecl "b" (makeRange Down 16) (Just (sizedInteger 16 10))
      , MemDecl "c" Nothing (makeRange Down 16)
-     , ProcessDecl
-       [ (Event (ExprVar "reset") PosEdge, Assign (ExprVar "c") (sizedInteger 16 0))
-       , (Event (ExprVar "clk") PosEdge, If (ExprVar "enable")
-                                  (Assign (ExprVar "c") (ExprVar "x"))
-                                  Nothing)
-       ]
+     , ProcessDecl (Event (ExprVar "clk") PosEdge)
+                   (Just (Event (ExprVar "reset") PosEdge, (Assign (ExprVar "c") (sizedInteger 16 0))))
+                   (If (ExprVar "enable")
+                         (Assign (ExprVar "c") (ExprVar "x"))
+                         Nothing)
      ]
 
 var_exprs :: [Expr]
diff --git a/netlist/Language/Netlist/Util.hs b/netlist/Language/Netlist/Util.hs
@@ -89,15 +89,11 @@ statements xs  = Seq xs
 generateReg :: Expr -> Expr -> Maybe (Expr, Expr) -> Maybe (Expr, Expr) ->
                Maybe Expr -> Expr -> Decl
 generateReg x clk mb_reset mb_restart mb_enable expr
-  = ProcessDecl as
+  = ProcessDecl (Event clk PosEdge) mb_reset' stmt2
   where
-    as = case mb_reset of
-           Just (reset, initial)
-             -> [ (Event reset PosEdge, Assign x initial), a0]
-           Nothing
-             -> [a0]
-
-    a0 = (Event clk PosEdge, stmt2)
+    mb_reset' = case mb_reset of
+                  Just (reset, initial) -> Just (Event reset PosEdge, Assign x initial)
+                  Nothing               -> Nothing
 
     stmt2 = case mb_restart of
               Just (restart, initial)
