Encode enumerations as unsigned integers instead of vhdls enum type

[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 a70036ef33b56ff60816390b43505b7f7fcb6e77..fe807d4f0370559813edfd713448e555e82b9705 100644 (file)
--- a/clash/CLasH/VHDL/VHDLTools.hs
+++ b/clash/CLasH/VHDL/VHDLTools.hs
@@ -346,7 +346,8 @@ mkHTypeEither' ty | ty_has_free_tyvars ty = return $ Left $ "\nVHDLTools.mkHType
                   return $ Right $ SizedIType len
                 "Index" -> do
                   bound <- tfp_to_int (ranged_word_bound_ty ty)
-                  return $ Right $ RangedWType bound
+                  -- Upperbound is exclusive, hence the -1
+                  return $ Right $ RangedWType (bound - 1)
                 otherwise ->
                   mkTyConHType tycon args
     Nothing -> return $ Left $ "\nVHDLTools.mkHTypeEither': Do not know what to do with type: " ++ pprString ty
@@ -491,12 +492,14 @@ mkTyconTy htype =
           MonadState.modify tsTypeFuns $ Map.insert (htype, showIdString) (showId, tupshow)
           return $ Just (ty_id, Just $ Left ty_def)
     (EnumType tycon dcs) -> do
-      let elems = map mkVHDLExtId dcs
       let ty_id = mkVHDLExtId tycon
-      let ty_def = AST.TDE $ AST.EnumTypeDef elems
-      let enumShow = mkEnumShow elems ty_id
+      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 enumShow = mkEnumShow dcs ty_id
       MonadState.modify tsTypeFuns $ Map.insert (htype, showIdString) (showId, enumShow)
-      return $ Just (ty_id, Just $ Left ty_def)
+      return $ Just (ty_id, Just $ Right ty_def)
     otherwise -> error $ "\nVHDLTools.mkTyconTy: Called for HType that is neiter a AggrType or EnumType: " ++ show htype
 
 -- | Create a VHDL vector type
@@ -570,8 +573,8 @@ getFields ::
 getFields htype dc_i = case htype of
   (AggrType name _ fieldss) 
     | dc_i >= 0 && dc_i < length fieldss -> fieldss!!dc_i
-    | otherwise -> error $ "Invalid constructor index: " ++ (show dc_i) ++ ". No such constructor in HType: " ++ (show htype)
-  _ -> error $ "Can't get fields from non-aggregate HType: " ++ show htype
+    | otherwise -> error $ "VHDLTool.getFields: Invalid constructor index: " ++ (show dc_i) ++ ". No such constructor in HType: " ++ (show htype)
+  _ -> error $ "VHDLTool.getFields: Can't get fields from non-aggregate HType: " ++ show htype
 
 -- Finds the field labels for an aggregation type, as VHDLIds.
 getFieldLabels ::
@@ -592,6 +595,17 @@ getConstructorFieldLabel (AggrType _ Nothing _) =
 getConstructorFieldLabel htype =
        error $ "Can't get constructor field label from non-aggregate HType: " ++ show htype
 
+
+getConstructorIndex ::
+  HType ->
+  String ->
+  Int
+getConstructorIndex (EnumType etype cons) dc = case List.elemIndex dc cons of
+  Just (index) -> index
+  Nothing -> error $ "VHDLTools.getConstructor: constructor: " ++ show dc ++ " is not part of type: " ++ show etype ++ ", which only has constructors: " ++ show cons
+getConstructorIndex htype _ = error $ "Can't get constructor index for non-Enum type: " ++ show htype
+
+
 mktydecl :: (AST.VHDLId, Maybe (Either AST.TypeDef AST.SubtypeIn)) -> Maybe AST.PackageDecItem
 mytydecl (_, Nothing) = Nothing
 mktydecl (ty_id, Just (Left ty_def)) = Just $ AST.PDITD $ AST.TypeDec ty_id ty_def
@@ -622,15 +636,16 @@ mkTupleShow elemTMs tupleTM = AST.SubProgBody showSpec [] [showExpr]
     tupSize = length elemTMs
 
 mkEnumShow ::
-  [AST.VHDLId]
+  [String]
   -> AST.TypeMark
   -> AST.SubProgBody
 mkEnumShow elemIds enumTM = AST.SubProgBody showSpec [] [showExpr]
-  where
-    enumPar    = AST.unsafeVHDLBasicId "enum"
+  where  
+    enumPar   = AST.unsafeVHDLBasicId "enum"
     showSpec  = AST.Function showId [AST.IfaceVarDec enumPar enumTM] stringTM
-    showExpr  = AST.ReturnSm (Just $
-                  AST.PrimLit (show $ tail $ init $ AST.fromVHDLId enumTM))
+    showExpr  = AST.CaseSm (AST.PrimName $ AST.NSimple enumPar)
+                  [AST.CaseSmAlt [AST.ChoiceE $ AST.PrimLit $ show x] [AST.ReturnSm (Just $ AST.PrimLit $ '"':(elemIds!!x)++['"'])] | x <- [0..(length elemIds) -1]]
+            
 
 mkVectorShow ::
   AST.TypeMark -- ^ elemtype