-dataconToVHDLExpr :: DataCon.DataCon -> AST.Expr
-dataconToVHDLExpr dc = AST.PrimLit lit
- where
- tycon = DataCon.dataConTyCon dc
- tyname = TyCon.tyConName tycon
- dcname = DataCon.dataConName dc
- lit = case Name.getOccString tyname of
- -- TODO: Do something more robust than string matching
- "Bit" -> case Name.getOccString dcname of "High" -> "'1'"; "Low" -> "'0'"
- "Bool" -> case Name.getOccString dcname of "True" -> "true"; "False" -> "false"
+dataconToVHDLExpr :: DataCon.DataCon -> TypeSession AST.Expr
+dataconToVHDLExpr dc = do
+ typemap <- getA tsTypes
+ htype_either <- mkHType (DataCon.dataConRepType dc)
+ case htype_either of
+ -- No errors
+ Right htype -> do
+ let existing_ty = (Monad.liftM $ fmap fst) $ Map.lookup htype typemap
+ case existing_ty of
+ Just ty -> do
+ let dcname = DataCon.dataConName dc
+ let lit = idToVHDLExpr $ mkVHDLExtId $ Name.getOccString dcname
+ return lit
+ Nothing -> do
+ let tycon = DataCon.dataConTyCon dc
+ let tyname = TyCon.tyConName tycon
+ let dcname = DataCon.dataConName dc
+ let lit = case Name.getOccString tyname of
+ -- TODO: Do something more robust than string matching
+ "Bit" -> case Name.getOccString dcname of "High" -> "'1'"; "Low" -> "'0'"
+ "Bool" -> case Name.getOccString dcname of "True" -> "true"; "False" -> "false"
+ return $ AST.PrimLit lit
+ -- Error when constructing htype
+ Left err -> error err