-mkConcSm (bndr, (CoreSyn.Case (CoreSyn.Var scrut) _ _ (alt:alts))) = do
- scrut' <- MonadState.lift tsType $ varToVHDLExpr scrut
- -- Omit first condition, which is the default
- altcons <- MonadState.lift tsType $ mapM (altconToVHDLExpr . (\(con,_,_) -> con)) alts
- let cond_exprs = map (\x -> scrut' AST.:=: x) altcons
+mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) _ _ alts)) = do
+ htype <- MonadState.lift tsType $ mkHType ("\nVHDL.mkConcSm: Unrepresentable scrutinee type? Expression: " ++ pprString expr) scrut
+ -- Turn the scrutinee into a VHDLExpr
+ scrut_expr <- MonadState.lift tsType $ varToVHDLExpr scrut
+ (enums, cmp) <- case htype of
+ EnumType _ enums -> do
+ -- Enumeration type, compare with the scrutinee directly
+ return (map stringToVHDLExpr enums, scrut_expr)
+ AggrType _ (Just (name, EnumType _ enums)) _ -> do
+ -- Extract the enumeration field from the aggregation
+ let sel_name = mkSelectedName (varToVHDLName scrut) (mkVHDLBasicId name)
+ let sel_expr = AST.PrimName sel_name
+ return (map stringToVHDLExpr enums, sel_expr)
+ (BuiltinType "Bit") -> do
+ let enums = [AST.PrimLit "'1'", AST.PrimLit "'0'"]
+ return (enums, scrut_expr)
+ (BuiltinType "Bool") -> do
+ let enums = [AST.PrimLit "true", AST.PrimLit "false"]
+ return (enums, scrut_expr)
+ _ -> error $ "\nSelector case on weird scrutinee: " ++ pprString scrut ++ " scrutinee type: " ++ pprString (Id.idType scrut)
+ -- Omit first condition, which is the default. Look up each altcon in
+ -- the enums list from the HType to find the actual enum value names.
+ let altcons = map (\(CoreSyn.DataAlt dc, _, _) -> enums!!(datacon_index scrut dc)) (tail alts)
+ -- Compare the (constructor field of the) scrutinee with each of the
+ -- alternatives.
+ let cond_exprs = map (\x -> cmp AST.:=: x) altcons