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
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))
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))
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))
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]