Enable the DontCare value for Bit again.

This is still not completely fool-proof, improvements will follow.

diff --git a/Alu.hs b/Alu.hs
index e9ddf5775869a4538ee064b120d0034e8730cf82..3880245ff0d82a8ecee0609575a925903b90e3c1 100644 (file)
--- a/Alu.hs
+++ b/Alu.hs
@@ -5,7 +5,7 @@ import qualified Sim
 main = Sim.simulate exec program initial_state
 mainIO = Sim.simulateIO exec initial_state
 
-dontcare = Low
+dontcare = DontCare
 
 program = [
             -- (addr, we, op)
@@ -43,8 +43,8 @@ register_bank (addr, High, d) s = -- Write
   where
     --Regs r0 r1 = s
     (r0, r1) = s
-    r0' = if addr == Low then d else r0
-    r1' = if addr == High then d else r1
+    r0' = case addr of Low -> d; High -> r0; otherwise -> dontcare
+    r1' = case addr of High -> d; Low -> r1; otherwise -> dontcare
     --s' = Regs r0' r1'
     s' = (r0', r1')
 

diff --git a/Bits.hs b/Bits.hs
index 845105d02a49cd4d3966405a316ff021dc4e96fb..c0717bff475bf107e5117c5e9cb6f441787e144d 100644 (file)
--- a/Bits.hs
+++ b/Bits.hs
@@ -38,7 +38,7 @@ displaysig High = "1"
 displaysig Low  = "0"
 
 -- The plain Bit type
-data Bit = High | Low -- | DontCare
+data Bit = High | Low | DontCare
   deriving (Show, Eq, Read)
 
 -- A function to prettyprint a bitvector

diff --git a/Flatten.hs b/Flatten.hs
index f62046c369c5889e507ab546d979e6e9a7389cc9..da665cf3fdb1f768235d394efd285f1302bb1f8a 100644 (file)
--- a/Flatten.hs
+++ b/Flatten.hs
@@ -257,8 +257,10 @@ flattenExpr binds expr@(Case scrut b _ alts) = do
   -- Flatten the scrutinee
   (_, res) <- flattenExpr binds scrut
   case alts of
+    -- TODO include b in the binds list
     [alt] -> flattenSingleAltCaseExpr binds res b alt
-    otherwise -> flattenMultipleAltCaseExpr binds res b alts
+    -- Reverse the alternatives, so the __DEFAULT alternative ends up last
+    otherwise -> flattenMultipleAltCaseExpr binds res b (reverse alts)
   where
     flattenSingleAltCaseExpr ::
       BindMap
@@ -276,7 +278,6 @@ flattenExpr binds expr@(Case scrut b _ alts) = do
             -- the existing bindings list and get the portname map for each of
             -- it's elements.
             Tuple tuple_sigs = scrut
-            -- TODO include b in the binds list
             -- Merge our existing binds with the new binds.
             binds' = (zip bind_vars (map Left tuple_sigs)) ++ binds 
           in
@@ -290,6 +291,10 @@ flattenExpr binds expr@(Case scrut b _ alts) = do
               flattenExpr binds expr
             else
               error $ "Dataconstructors other than tuple constructors cannot have binder arguments in case pattern of alternative: " ++ (showSDoc $ ppr alt)
+
+    flattenSingleAltCaseExpr binds _ _ alt@(DEFAULT, [], expr) =
+      flattenExpr binds expr
+      
     flattenSingleAltCaseExpr _ _ _ alt = error $ "Case patterns other than data constructors not supported in case alternative: " ++ (showSDoc $ ppr alt)
 
     flattenMultipleAltCaseExpr ::
@@ -305,18 +310,23 @@ flattenExpr binds expr@(Case scrut b _ alts) = do
       (args', res') <- flattenMultipleAltCaseExpr binds scrut b (a':alts)
       case a of
         (DataAlt datacon, bind_vars, expr) -> do
-          lit <- dataConToLiteral datacon
-          -- The scrutinee must be a single signal
-          let Single sig = scrut
-          -- Create a signal that contains a boolean
-          boolsigid <- genSignalId SigInternal TysWiredIn.boolTy
-          let expr = EqLit sig lit
-          addDef (UncondDef (Right expr) boolsigid)
-          -- Create conditional assignments of either args/res or
-          -- args'/res based on boolsigid, and return the result.
-          our_args <- zipWithM (mkConditionals boolsigid) args args'
-          our_res  <- mkConditionals boolsigid res res'
-          return (our_args, our_res)
+          if isDontCare datacon 
+            then do
+              -- Completely skip the dontcare cases
+              return (args', res')
+            else do
+              lit <- dataConToLiteral datacon
+              -- The scrutinee must be a single signal
+              let Single sig = scrut
+              -- Create a signal that contains a boolean
+              boolsigid <- genSignalId SigInternal TysWiredIn.boolTy
+              let expr = EqLit sig lit
+              addDef (UncondDef (Right expr) boolsigid)
+              -- Create conditional assignments of either args/res or
+              -- args'/res based on boolsigid, and return the result.
+              our_args <- zipWithM (mkConditionals boolsigid) args args'
+              our_res  <- mkConditionals boolsigid res res'
+              return (our_args, our_res)
         otherwise ->
           error $ "Case patterns other than data constructors not supported in case alternative: " ++ (showSDoc $ ppr a)
       where
@@ -341,6 +351,20 @@ flattenExpr binds expr@(Case scrut b _ alts) = do
 flattenExpr _ expr = do
   error $ "Unsupported expression: " ++ (showSDoc $ ppr expr)
 
+-- | Is the given data constructor a dontcare?
+isDontCare :: DataCon.DataCon -> Bool
+isDontCare datacon =
+  case Name.getOccString tyname of
+    -- TODO: Do something more robust than string matching
+    "Bit" ->
+      Name.getOccString dcname  == "DontCare"
+    otherwise ->
+      False
+  where
+    tycon = DataCon.dataConTyCon datacon
+    tyname = TyCon.tyConName tycon
+    dcname = DataCon.dataConName datacon
+
 -- | Translates a dataconstructor without arguments to the corresponding
 --   literal.
 dataConToLiteral :: DataCon.DataCon -> FlattenState String
@@ -351,7 +375,7 @@ dataConToLiteral datacon = do
     -- TODO: Do something more robust than string matching
     "Bit"      -> do
       let dcname = DataCon.dataConName datacon
-      let lit = case Name.getOccString dcname of "High" -> "'1'"; "Low" -> "'0'"
+      let lit = case Name.getOccString dcname of "High" -> "'1'"; "Low" -> "'0'"; "DontCare" -> "'-'"
       return lit
     "Bool" -> do
       let dcname = DataCon.dataConName datacon

diff --git a/VHDL.hs b/VHDL.hs
index b85d6ff0be288e7db0ec57ca886fae79cbc6ec09..1c7eba9ea2e848fbca70c620357e1b0e9fb09f85 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -320,7 +320,7 @@ vhdl_ty_maybe ty =
           let name = TyCon.tyConName tycon in
             -- TODO: Do something more robust than string matching
             case Name.getOccString name of
-              "Bit"      -> Just bit_ty
+              "Bit"      -> Just std_logic_ty
               otherwise  -> Nothing
         otherwise -> Nothing