X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=clash%2FCLasH%2FVHDL%2FVHDLTools.hs;h=3dcd951bcb7a9822509fc77d0807f2a137734aeb;hb=0e1a00f9a5b95f27cc10b3ffaa6533b6f321fd5c;hp=507fe3b995d0a2de4c3809cb524b3df163717802;hpb=bfcff194b5409ea0cc49a87c7844d1d8efb6bca4;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/clash/CLasH/VHDL/VHDLTools.hs b/clash/CLasH/VHDL/VHDLTools.hs
index 507fe3b..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)
@@ -645,18 +645,16 @@ mkAdtShow conLbl conIds elemIdss adtTM = AST.SubProgBody showSpec [] [showExpr]
   where  
     adtPar   = AST.unsafeVHDLBasicId "adt"
     showSpec  = AST.Function showId [AST.IfaceVarDec adtPar adtTM] stringTM
-    showExpr  = AST.CaseSm (AST.PrimName $ AST.NSelected $ (AST.NSimple adtPar) AST.:.: (AST.SSimple $ (mkVHDLBasicId conLbl)))
-                  [AST.CaseSmAlt [AST.ChoiceE $ AST.PrimLit $ show x] [AST.ReturnSm (Just $ ((AST.PrimLit $ '"':(conIds!!x)++[' ','"'])) AST.:&: showFields x)] | x <- [0..(length conIds) -1]]
+    showExpr  = AST.CaseSm ((selectedName adtPar) (mkVHDLBasicId conLbl))
+                  [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.:&: AST.PrimLit "' '" AST.:&: e2) $
-              map ((genExprFCall showId).
-                    AST.PrimName .
-                    AST.NSelected .
-                    (AST.NSimple adtPar AST.:.:).
-                    tupVHDLSuffix)
-                  (map mkVHDLBasicId (elemIdss!!i))              
+        foldr1 (\e1 e2 -> e1 AST.:&: e2) $
+              map ((AST.PrimLit "' '" AST.:&:) . (genExprFCall showId) . (selectedName adtPar))
+                  (map mkVHDLBasicId (elemIdss!!i))
+    selectedName par = (AST.PrimName . AST.NSelected . (AST.NSimple par AST.:.:) . tupVHDLSuffix)       
     
 mkEnumShow ::
   [String]