Use numbers in case-selectors to reflect changes to encoding of enum types

[matthijs/master-project/cλash.git] / clash / CLasH / VHDL / VHDLTools.hs

diff --git a/clash/CLasH/VHDL/VHDLTools.hs b/clash/CLasH/VHDL/VHDLTools.hs
index fde81d06dae32e7fbc0b381f16f24e0cb685c602..edaa5d2128ae271c782869ac5c8835aa70067f34 100644 (file)
--- a/clash/CLasH/VHDL/VHDLTools.hs
+++ b/clash/CLasH/VHDL/VHDLTools.hs
@@ -495,13 +495,11 @@ mkTyconTy htype =
           return $ Just (ty_id, Just $ Left ty_def)
     (EnumType tycon dcs) -> do
       let ty_id = mkVHDLExtId tycon
-      let possibilaties = case (length dcs) of 1 -> 1; x -> (x-1)
-      let bitsize = floor (logBase 2 (fromInteger (toInteger possibilaties)))
-      let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.DownRange (AST.PrimLit $ show bitsize) (AST.PrimLit "0")]
-      let ty_def = AST.SubtypeIn unsignedTM (Just range)
+      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)
-      return $ Just (ty_id, Just $ Right ty_def)
+      return $ Just (ty_id, Just $ Left ty_def)
     otherwise -> error $ "\nVHDLTools.mkTyconTy: Called for HType that is neiter a AggrType or EnumType: " ++ show htype
 
 -- | Create a VHDL vector type
@@ -543,7 +541,7 @@ mkNaturalTy ::
 mkNaturalTy min_bound max_bound = do
   let bitsize = floor (logBase 2 (fromInteger (toInteger max_bound)))
   let ty_id = mkVHDLExtId $ "natural_" ++ (show min_bound) ++ "_to_" ++ (show max_bound)
-  let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit $ show min_bound) (AST.PrimLit $ show bitsize)]
+  let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.DownRange (AST.PrimLit $ show bitsize) (AST.PrimLit $ show min_bound)]
   let ty_def = AST.SubtypeIn unsignedTM (Just range)
   return (Just (ty_id, Just $ Right ty_def))
 
@@ -551,8 +549,8 @@ mkUnsignedTy ::
   Int -- ^ Haskell type of the unsigned integer
   -> TypeSession TypeMapRec
 mkUnsignedTy size = do
-  let ty_id = mkVHDLExtId $ "unsigned_" ++ show (size - 1)
-  let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (size - 1))]
+  let ty_id = mkVHDLExtId $ "unsigned_" ++ show size
+  let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.DownRange (AST.PrimLit $ show (size - 1)) (AST.PrimLit "0")]
   let ty_def = AST.SubtypeIn unsignedTM (Just range)
   return (Just (ty_id, Just $ Right ty_def))
   
@@ -560,8 +558,8 @@ mkSignedTy ::
   Int -- ^ Haskell type of the signed integer
   -> TypeSession TypeMapRec
 mkSignedTy size = do
-  let ty_id = mkVHDLExtId $ "signed_" ++ show (size - 1)
-  let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (size - 1))]
+  let ty_id = mkVHDLExtId $ "signed_" ++ show size
+  let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.DownRange (AST.PrimLit $ show (size - 1)) (AST.PrimLit "0")]
   let ty_def = AST.SubtypeIn signedTM (Just range)
   return (Just (ty_id, Just $ Right ty_def))
 
@@ -647,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 "''"
       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]