varToVHDLExpr :: Var.Var -> TypeSession AST.Expr
varToVHDLExpr var =
case Id.isDataConWorkId_maybe var of
- Just dc -> dataconToVHDLExpr dc
-- This is a dataconstructor.
- -- Not a datacon, just another signal. Perhaps we should check for
- -- local/global here as well?
- -- Sadly so.. tfp decimals are types, not data constructors, but instances
- -- should still be translated to integer literals. It is probebly not the
- -- best solution to translate them here.
- -- FIXME: Find a better solution for translating instances of tfp integers
- Nothing -> do
- let ty = Var.varType var
- case Type.splitTyConApp_maybe ty of
- Just (tycon, args) ->
- case Name.getOccString (TyCon.tyConName tycon) of
- "Dec" -> do
- len <- tfp_to_int ty
- return $ AST.PrimLit (show len)
- otherwise -> return $ AST.PrimName $ AST.NSimple $ varToVHDLId var
+ Just dc -> dataconToVHDLExpr dc
+ -- Not a datacon, just another signal.
+ Nothing -> return $ AST.PrimName $ AST.NSimple $ varToVHDLId var
-- Turn a VHDLName into an AST expression
vhdlNameToVHDLExpr = AST.PrimName
builtin_types =
Map.fromList [
(BuiltinType "Bit", Just (std_logicTM, Nothing)),
- (BuiltinType "Bool", Just (booleanTM, Nothing)), -- TysWiredIn.boolTy
- (BuiltinType "Dec", Just (integerTM, Nothing))
+ (BuiltinType "Bool", Just (booleanTM, Nothing)) -- TysWiredIn.boolTy
]
-- Is the given type representable at runtime?
Left _ -> False
Right _ -> True
+-- | Turn a Core type into a HType, returning an error using the given
+-- error string if the type was not representable.
mkHType :: (TypedThing t, Outputable.Outputable t) =>
String -> t -> TypeSession HType
mkHType msg ty = do
Right htype -> return htype
Left err -> error $ msg ++ err
+-- | Turn a Core type into a HType. Returns either an error message if
+-- the type was not representable, or the HType generated.
mkHTypeEither :: (TypedThing t, Outputable.Outputable t) =>
t -> TypeSession (Either String HType)
mkHTypeEither tything =
mapM_ (\(id, subprog) -> MonadState.modify tsTypeFuns $ Map.insert (UVecType elHType, id) ((mkVHDLExtId id), subprog)) vecShowFuns
let ty_def = AST.SubtypeIn vec_id (Just range)
return (Just (ty_id, Just $ Right ty_def))
+ -- Vector of empty elements becomes empty itself.
Nothing -> return Nothing
mkVectorTy htype = error $ "\nVHDLTools.mkVectorTy: Called for HType that is not a VecType: " ++ show htype
-- Assume the type for which we want labels is really translatable
htype <- mkHType error_msg ty
case Map.lookup htype types of
- Just (Just (_, Just (Left (AST.TDR (AST.RecordTypeDef elems))))) -> return $ map (\(AST.ElementDec id _) -> id) elems
+ Nothing -> error $ "\nVHDLTools.getFieldLabels: Type not found? This should not happen!\nLooking for type: " ++ (pprString ty) ++ "\nhtype: " ++ (show htype)
Just Nothing -> return [] -- The type is empty
- _ -> error $ "\nVHDLTools.getFieldLabels: Type not found or not a record type? This should not happen! Type: " ++ (show htype)
+ Just (Just (_, Just (Left (AST.TDR (AST.RecordTypeDef elems))))) -> return $ map (\(AST.ElementDec id _) -> id) elems
+ Just (Just (_, Just vty)) -> error $ "\nVHDLTools.getFieldLabels: Type not a record type? This should not happen!\nLooking for type: " ++ pprString (ty) ++ "\nhtype: " ++ (show htype) ++ "\nFound type: " ++ (show vty)
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
mktydecl (ty_id, Just (Right ty_def)) = Just $ AST.PDISD $ AST.SubtypeDec ty_id ty_def
-tfp_to_int :: Type.Type -> TypeSession Int
-tfp_to_int ty = do
- hscenv <- MonadState.get tsHscEnv
- let norm_ty = normalise_tfp_int hscenv ty
- case Type.splitTyConApp_maybe norm_ty of
- Just (tycon, args) -> do
- let name = Name.getOccString (TyCon.tyConName tycon)
- case name of
- "Dec" ->
- tfp_to_int' ty
- otherwise -> do
- MonadState.modify tsTfpInts (Map.insert (OrdType norm_ty) (-1))
- return $ error ("Callin tfp_to_int on non-dec:" ++ (show ty))
- Nothing -> return $ error ("Callin tfp_to_int on non-dec:" ++ (show ty))
-
-tfp_to_int' :: Type.Type -> TypeSession Int
-tfp_to_int' ty = do
- lens <- MonadState.get tsTfpInts
- hscenv <- MonadState.get tsHscEnv
- let norm_ty = normalise_tfp_int hscenv ty
- let existing_len = Map.lookup (OrdType norm_ty) lens
- case existing_len of
- Just len -> return len
- Nothing -> do
- let new_len = eval_tfp_int hscenv ty
- MonadState.modify tsTfpInts (Map.insert (OrdType norm_ty) (new_len))
- return new_len
-
mkTupleShow ::
[AST.TypeMark] -- ^ type of each tuple element
-> AST.TypeMark -- ^ type of the tuple