X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;ds=sidebyside;f=c%CE%BBash%2FCLasH%2FVHDL%2FGenerate.hs;h=5386e7e61b698a0681830ffc9b4b14c2c9c1e67f;hb=4a1b18cd81cebb66c95cc0ca8a6aaa441bee1418;hp=31c9c8d7f11f192eb5f12b68030579cf50caf567;hpb=160e92e346410b51e9e27e7307c7776b4935d547;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git "a/c\316\273ash/CLasH/VHDL/Generate.hs" "b/c\316\273ash/CLasH/VHDL/Generate.hs"
index 31c9c8d..5386e7e 100644
--- "a/c\316\273ash/CLasH/VHDL/Generate.hs"
+++ "b/c\316\273ash/CLasH/VHDL/Generate.hs"
@@ -166,7 +166,8 @@ mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt]))
                 | otherwise =
   case alt of
     (CoreSyn.DataAlt dc, bndrs, (CoreSyn.Var sel_bndr)) -> do
-      case List.elemIndex sel_bndr bndrs of
+      bndrs' <- Monad.filterM hasNonEmptyType bndrs
+      case List.elemIndex sel_bndr bndrs' of
         Just i -> do
           labels <- MonadState.lift tsType $ getFieldLabels (Id.idType scrut)
           let label = labels!!i
@@ -204,11 +205,19 @@ genExprArgs wrap dst func args = do
 
 -- | Turn the all lefts into VHDL Expressions.
 argsToVHDLExprs :: [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.Expr]
-argsToVHDLExprs = mapM argToVHDLExpr
-
-argToVHDLExpr :: Either CoreSyn.CoreExpr AST.Expr -> TranslatorSession AST.Expr
-argToVHDLExpr (Left expr) = MonadState.lift tsType $ varToVHDLExpr (exprToVar expr)
-argToVHDLExpr (Right expr) = return expr
+argsToVHDLExprs = catMaybesM . (mapM argToVHDLExpr)
+
+argToVHDLExpr :: Either CoreSyn.CoreExpr AST.Expr -> TranslatorSession (Maybe AST.Expr)
+argToVHDLExpr (Left expr) = MonadState.lift tsType $ do
+  let errmsg = "Generate.argToVHDLExpr: Using non-representable type? Should not happen!"
+  ty_maybe <- vhdl_ty errmsg expr
+  case ty_maybe of
+    Just _ -> do
+      vhdl_expr <- varToVHDLExpr $ exprToVar expr
+      return $ Just vhdl_expr
+    Nothing -> return $ Nothing
+
+argToVHDLExpr (Right expr) = return $ Just expr
 
 -- A function to wrap a builder-like function that generates no component
 -- instantiations