From 8c10e892bb7cd3637d62bc0044515e2bf59667f8 Mon Sep 17 00:00:00 2001
From: christiaanb <christiaan.baaij@gmail.com>
Date: Mon, 21 Jun 2010 11:27:51 +0200
Subject: [PATCH] Encode enumerations as unsigned integers instead of vhdls
enum type
---
clash/CLasH/VHDL/Generate.hs | 7 ++++---
clash/CLasH/VHDL/VHDLTools.hs | 32 +++++++++++++++++++++++---------
2 files changed, 27 insertions(+), 12 deletions(-)
diff --git a/clash/CLasH/VHDL/Generate.hs b/clash/CLasH/VHDL/Generate.hs
index 8c59334..e546821 100644
--- a/clash/CLasH/VHDL/Generate.hs
+++ b/clash/CLasH/VHDL/Generate.hs
@@ -1113,7 +1113,7 @@ genApplication (dst, dsttype) f args = do
return ([mkUncondAssign dst arg'], [])
-- In all other cases, a record type is created.
_ -> case htype_either of
- Right htype@(AggrType _ _ _) -> do
+ Right htype@(AggrType _ etype _) -> do
let dc_i = datacon_index dsttype dc
let labels = getFieldLabels htype dc_i
arg_exprs <- argsToVHDLExprs argsNoState
@@ -1125,8 +1125,9 @@ genApplication (dst, dsttype) f args = do
-- constructor used to the constructor field as
-- well.
Just dc_label ->
- let dc_expr = AST.PrimName $ AST.NSimple $ mkVHDLExtId $ varToString f in
- (dc_label:labels, dc_expr:arg_exprs)
+ let { dc_index = getConstructorIndex (snd $ Maybe.fromJust etype) (varToString f)
+ ; dc_expr = AST.PrimLit $ show dc_index
+ } in (dc_label:labels, dc_expr:arg_exprs)
return (zipWith mkassign final_labels final_exprs, [])
where
mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm
diff --git a/clash/CLasH/VHDL/VHDLTools.hs b/clash/CLasH/VHDL/VHDLTools.hs
index ab3360b..fe807d4 100644
--- a/clash/CLasH/VHDL/VHDLTools.hs
+++ b/clash/CLasH/VHDL/VHDLTools.hs
@@ -492,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
@@ -593,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
@@ -623,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
--
2.30.2