X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL%2FVHDLTools.hs;h=165b1ef655710195d244dd13ade22cd243be218d;hb=fb44a1f428ffb4ef84e27a4bfdcd859ab3ba6c82;hp=8b963f53ed3415885649b50bd09633693f4c927d;hpb=f3951a1376fc7d7f8addbe9e9fed071320502100;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git "a/c\316\273ash/CLasH/VHDL/VHDLTools.hs" "b/c\316\273ash/CLasH/VHDL/VHDLTools.hs" index 8b963f5..165b1ef 100644 --- "a/c\316\273ash/CLasH/VHDL/VHDLTools.hs" +++ "b/c\316\273ash/CLasH/VHDL/VHDLTools.hs" @@ -148,23 +148,10 @@ mkComponentInst label entity_id portassigns = AST.CSISm compins 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 @@ -292,8 +279,7 @@ builtin_types :: TypeMap 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? @@ -304,6 +290,8 @@ isReprType ty = do 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 @@ -312,6 +300,8 @@ 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 = @@ -332,7 +322,7 @@ mkHTypeEither' ty | ty_has_free_tyvars ty = return $ Left $ "\nVHDLTools.mkHType (Just x) -> return $ Right $ BuiltinType name Nothing -> case name of - "TFVec" -> do + "Vector" -> do let el_ty = tfvec_elem ty elem_htype_either <- mkHTypeEither el_ty case elem_htype_either of @@ -343,13 +333,13 @@ mkHTypeEither' ty | ty_has_free_tyvars ty = return $ Left $ "\nVHDLTools.mkHType -- Could not create element type Left err -> return $ Left $ "\nVHDLTools.mkHTypeEither': Can not construct vectortype for elementtype: " ++ pprString el_ty ++ err - "SizedWord" -> do + "Unsigned" -> do len <- tfp_to_int (sized_word_len_ty ty) return $ Right $ SizedWType len - "SizedInt" -> do + "Signed" -> do len <- tfp_to_int (sized_word_len_ty ty) return $ Right $ SizedIType len - "RangedWord" -> do + "Index" -> do bound <- tfp_to_int (ranged_word_bound_ty ty) return $ Right $ RangedWType bound otherwise -> @@ -486,6 +476,7 @@ mkVectorTy (VecType len elHType) = do 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 @@ -531,43 +522,16 @@ getFieldLabels ty = do -- 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 $ "\nVHDL.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