X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;ds=sidebyside;f=c%CE%BBash%2FCLasH%2FVHDL%2FVHDLTools.hs;h=a16ea0108f5998c7b9d123771d8f06c2e64df22b;hb=4a1b18cd81cebb66c95cc0ca8a6aaa441bee1418;hp=ed4d7f6b3bc4608e0a0699102eb576d50c3da642;hpb=ad9bc80c39c42f645c76c65e1d3833148b854c1e;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 ed4d7f6..a16ea01 100644
--- "a/c\316\273ash/CLasH/VHDL/VHDLTools.hs"
+++ "b/c\316\273ash/CLasH/VHDL/VHDLTools.hs"
@@ -1,3 +1,4 @@
+{-# LANGUAGE RelaxedPolyRec #-} -- Needed for vhdl_ty_either', for some reason...
 module CLasH.VHDL.VHDLTools where
 
 -- Standard modules
@@ -27,11 +28,13 @@ import qualified TyCon
 import qualified Type
 import qualified DataCon
 import qualified CoreSubst
+import qualified Outputable
 
 -- Local imports
 import CLasH.VHDL.VHDLTypes
 import CLasH.Translator.TranslatorTypes
 import CLasH.Utils.Core.CoreTools
+import CLasH.Utils
 import CLasH.Utils.Pretty
 import CLasH.VHDL.Constants
 
@@ -85,10 +88,10 @@ mkAssocElems ::
   [AST.Expr]                    -- ^ The argument that are applied to function
   -> AST.VHDLName               -- ^ The binder in which to store the result
   -> Entity                     -- ^ The entity to map against.
-  -> [AST.AssocElem]            -- ^ The resulting port maps
+  -> TranslatorSession [AST.AssocElem] -- ^ The resulting port maps
 mkAssocElems args res entity =
     -- Create the actual AssocElems
-    zipWith mkAssocElem ports sigs
+    return $ zipWith mkAssocElem ports sigs
   where
     -- Turn the ports and signals from a map into a flat list. This works,
     -- since the maps must have an identical form by definition. TODO: Check
@@ -104,11 +107,6 @@ mkAssocElems args res entity =
 mkAssocElem :: AST.VHDLId -> AST.Expr -> AST.AssocElem
 mkAssocElem port signal = Just port AST.:=>: (AST.ADExpr signal) 
 
--- | Create an VHDL port -> signal association
-mkAssocElemIndexed :: AST.VHDLId -> AST.VHDLId -> AST.VHDLId -> AST.AssocElem
-mkAssocElemIndexed port signal index = Just port AST.:=>: (AST.ADName (AST.NIndexed (AST.IndexedName 
-                      (AST.NSimple signal) [AST.PrimName $ AST.NSimple index])))
-
 -- | Create an aggregate signal
 mkAggregateSignal :: [AST.Expr] -> AST.Expr
 mkAggregateSignal x = AST.Aggregate (map (\z -> AST.ElemAssoc Nothing z) x)
@@ -271,7 +269,8 @@ builtin_types =
 -- Translate a Haskell type to a VHDL type, generating a new type if needed.
 -- Returns an error value, using the given message, when no type could be
 -- created. Returns Nothing when the type is valid, but empty.
-vhdl_ty :: String -> Type.Type -> TypeSession (Maybe AST.TypeMark)
+vhdl_ty :: (TypedThing t, Outputable.Outputable t) => 
+  String -> t -> TypeSession (Maybe AST.TypeMark)
 vhdl_ty msg ty = do
   tm_either <- vhdl_ty_either ty
   case tm_either of
@@ -280,8 +279,15 @@ vhdl_ty msg ty = do
 
 -- Translate a Haskell type to a VHDL type, generating a new type if needed.
 -- Returns either an error message or the resulting type.
-vhdl_ty_either :: Type.Type -> TypeSession (Either String (Maybe AST.TypeMark))
-vhdl_ty_either ty = do
+vhdl_ty_either :: (TypedThing t, Outputable.Outputable t) => 
+  t -> TypeSession (Either String (Maybe AST.TypeMark))
+vhdl_ty_either tything =
+  case getType tything of
+    Nothing -> return $ Left $ "VHDLTools.vhdl_ty: Typed thing without a type: " ++ pprString tything
+    Just ty -> vhdl_ty_either' ty
+
+vhdl_ty_either' :: Type.Type -> TypeSession (Either String (Maybe AST.TypeMark))
+vhdl_ty_either' ty = do
   typemap <- getA tsTypes
   htype_either <- mkHType ty
   case htype_either of
@@ -317,6 +323,8 @@ vhdl_ty_either ty = do
 -- Construct a new VHDL type for the given Haskell type. Returns an error
 -- message or the resulting typemark and typedef.
 construct_vhdl_ty :: Type.Type -> TypeSession (Either String (Maybe (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn)))
+-- State types don't generate VHDL
+construct_vhdl_ty ty | isStateType ty = return $ Right Nothing
 construct_vhdl_ty ty = do
   case Type.splitTyConApp_maybe ty of
     Just (tycon, args) -> do
@@ -720,3 +728,8 @@ mkSigDec bndr = do
   case type_mark_maybe of
     Just type_mark -> return $ Just (AST.SigDec (varToVHDLId bndr) type_mark Nothing)
     Nothing -> return Nothing
+
+-- | Does the given thing have a non-empty type?
+hasNonEmptyType :: (TypedThing t, Outputable.Outputable t) => 
+  t -> TranslatorSession Bool
+hasNonEmptyType thing = MonadState.lift tsType $ isJustM (vhdl_ty "hasNonEmptyType: Non representable type?" thing)