Merge branch 'master' of git://github.com/christiaanb/clash into cλash

[matthijs/master-project/cλash.git] / cλash / CLasH / VHDL / VHDLTools.hs

diff --git a/cλash/CLasH/VHDL/VHDLTools.hs b/cλash/CLasH/VHDL/VHDLTools.hs
index 4b728e858af6f67f0af5c3ee41d3b5719daa8121..a16ea0108f5998c7b9d123771d8f06c2e64df22b 100644 (file)
--- a/cλash/CLasH/VHDL/VHDLTools.hs
+++ b/cλash/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
@@ -722,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)