+ flattenMultipleAltCaseExpr ::
+ BindMap
+ -- A list of bindings in effect
+ -> BindValue -- The scrutinee
+ -> CoreBndr -- The binder to bind the scrutinee to
+ -> [CoreAlt] -- The alternatives
+ -> FlattenState ( [SignalMap], SignalMap) -- See expandExpr
+
+ flattenMultipleAltCaseExpr binds var b (a:a':alts) = do
+ (args, res) <- flattenSingleAltCaseExpr binds var b a
+ (args', res') <- flattenMultipleAltCaseExpr binds var b (a':alts)
+ case a of
+ (DataAlt datacon, bind_vars, expr) -> do
+ let tycon = DataCon.dataConTyCon datacon
+ let tyname = TyCon.tyConName tycon
+ case Name.getOccString tyname of
+ -- TODO: Do something more robust than string matching
+ "Bit" -> do
+ -- The scrutinee must be a single signal
+ let Left (Single sig) = var
+ let dcname = DataCon.dataConName datacon
+ let lit = case Name.getOccString dcname of "High" -> "'1'"; "Low" -> "'0'"
+ -- 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 $ "Type " ++ (Name.getOccString tyname) ++ " not supported in multiple alternative case expressions."
+ otherwise ->
+ error $ "Case patterns other than data constructors not supported in case alternative: " ++ (showSDoc $ ppr a)
+ where
+ -- Select either the first or second signal map depending on the value
+ -- of the first argument (True == first map, False == second map)
+ mkConditionals :: SignalId -> SignalMap -> SignalMap -> FlattenState SignalMap
+ mkConditionals boolsigid true false = do
+ let zipped = zipValueMaps true false
+ Traversable.mapM (mkConditional boolsigid) zipped
+
+ mkConditional :: SignalId -> (SignalId, SignalId) -> FlattenState SignalId
+ mkConditional boolsigid (true, false) = do
+ -- Create a new signal (true and false should be identically typed,
+ -- so it doesn't matter which one we copy).
+ res <- copySignal true
+ addDef (CondDef boolsigid true false res)
+ return res
+
+ flattenMultipleAltCaseExpr binds var b (a:alts) =
+ flattenSingleAltCaseExpr binds var b a
+