X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=clash%2FCLasH%2FVHDL%2FVHDLTools.hs;h=3dcd951bcb7a9822509fc77d0807f2a137734aeb;hb=699b4f25f903ae9fa7deacf2eeb6204403178de9;hp=6ba4d765179bf118b729744a2e29e07a09500d15;hpb=5594e632ef0aa31926c5533cd67fef8b56b088b1;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/clash/CLasH/VHDL/VHDLTools.hs b/clash/CLasH/VHDL/VHDLTools.hs index 6ba4d76..3dcd951 100644 --- a/clash/CLasH/VHDL/VHDLTools.hs +++ b/clash/CLasH/VHDL/VHDLTools.hs @@ -192,7 +192,7 @@ dataconToVHDLExpr dc = do let existing_ty = Monad.liftM (fmap fst) $ Map.lookup htype typemap case existing_ty of Just ty -> do - let lit = idToVHDLExpr $ mkVHDLExtId $ Name.getOccString dcname + let lit = AST.PrimLit $ show $ getConstructorIndex htype $ Name.getOccString dcname return lit Nothing -> error $ "\nVHDLTools.dataconToVHDLExpr: Trying to make value for non-representable DataCon: " ++ pprString dc -- Error when constructing htype @@ -495,7 +495,7 @@ mkTyconTy htype = return $ Just (ty_id, Just $ Left ty_def) (EnumType tycon dcs) -> do let ty_id = mkVHDLExtId tycon - let range = AST.SubTypeRange (AST.PrimLit "0") (AST.PrimLit $ show (length dcs)) + let range = AST.SubTypeRange (AST.PrimLit "0") (AST.PrimLit $ show ((length dcs) - 1)) let ty_def = AST.TDI $ AST.IntegerTypeDef range let enumShow = mkEnumShow dcs ty_id MonadState.modify tsTypeFuns $ Map.insert (htype, showIdString) (showId, enumShow) @@ -649,7 +649,7 @@ mkAdtShow conLbl conIds elemIdss adtTM = AST.SubProgBody showSpec [] [showExpr] [AST.CaseSmAlt [AST.ChoiceE $ AST.PrimLit $ show x] [AST.ReturnSm (Just $ ((genExprFCall showId) . (selectedName adtPar) $ mkVHDLBasicId conLbl) AST.:&: showFields x)] | x <- [0..(length conIds) -1]] showFields i = if (null (elemIdss!!i)) then - AST.PrimLit "''" + AST.PrimLit "nul" else foldr1 (\e1 e2 -> e1 AST.:&: e2) $ map ((AST.PrimLit "' '" AST.:&:) . (genExprFCall showId) . (selectedName adtPar))