From 9b7d00ad53acfc821840051ef693d87470b4462b Mon Sep 17 00:00:00 2001 From: Matthijs Kooijman Date: Thu, 19 Feb 2009 14:17:58 +0100 Subject: [PATCH] Enable the DontCare value for Bit again. This is still not completely fool-proof, improvements will follow. --- Alu.hs | 6 +++--- Bits.hs | 2 +- Flatten.hs | 54 +++++++++++++++++++++++++++++++++++++++--------------- VHDL.hs | 2 +- 4 files changed, 44 insertions(+), 20 deletions(-) diff --git a/Alu.hs b/Alu.hs index e9ddf57..3880245 100644 --- 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 845105d..c0717bf 100644 --- 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 f62046c..da665cf 100644 --- 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 b85d6ff..1c7eba9 100644 --- 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 -- 2.30.2