Make vhdl generation and normalization lazy.

[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 6e9dbe3527473b0f6f178754930c27b2a9f66aee..3991a3f3110e1fe25fd847f117c072934d4f414e 100644 (file)
--- a/cλash/CLasH/VHDL/VHDLTools.hs
+++ b/cλash/CLasH/VHDL/VHDLTools.hs
@@ -10,6 +10,7 @@ import qualified Control.Arrow as Arrow
 import qualified Control.Monad.Trans.State as State
 import qualified Data.Monoid as Monoid
 import Data.Accessor
+import Data.Accessor.MonadState as MonadState
 import Debug.Trace
 
 -- ForSyDe
@@ -29,6 +30,7 @@ import qualified CoreSubst
 
 -- Local imports
 import CLasH.VHDL.VHDLTypes
+import CLasH.Translator.TranslatorTypes
 import CLasH.Utils.Core.CoreTools
 import CLasH.Utils.Pretty
 import CLasH.VHDL.Constants
@@ -55,11 +57,11 @@ mkCondAssign dst cond true false = mkAssign dst (Just (cond, true)) false
 
 -- Create a conditional or unconditional assignment statement
 mkAssign ::
-  Either CoreBndr AST.VHDLName -> -- ^ The signal to assign to
-  Maybe (AST.Expr , AST.Expr) -> -- ^ Optionally, the condition to test for
+  Either CoreBndr AST.VHDLName -- ^ The signal to assign to
+  -> Maybe (AST.Expr , AST.Expr) -- ^ Optionally, the condition to test for
                                  -- and the value to assign when true.
-  AST.Expr -> -- ^ The value to assign when false or no condition
-  AST.ConcSm -- ^ The resulting concurrent statement
+  -> AST.Expr -- ^ The value to assign when false or no condition
+  -> AST.ConcSm -- ^ The resulting concurrent statement
 mkAssign dst cond false_expr =
   let
     -- I'm not 100% how this assignment AST works, but this gets us what we
@@ -80,10 +82,10 @@ mkAssign dst cond false_expr =
     AST.CSSASm assign
 
 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
+  [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
 mkAssocElems args res entity =
     -- Create the actual AssocElems
     zipWith mkAssocElem ports sigs
@@ -107,6 +109,10 @@ 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)
+
 mkComponentInst ::
   String -- ^ The portmap label
   -> AST.VHDLId -- ^ The entity name
@@ -395,7 +401,7 @@ mk_vector_ty ty = do
           modA vsTypes (Map.insert (StdType $ OrdType vec_ty) (vec_id, (Left vec_def)))
           modA vsTypeDecls (\typedefs -> typedefs ++ [mktydecl (vec_id, (Left vec_def))])
           let vecShowFuns = mkVectorShow el_ty_tm vec_id
-          mapM_ (\(id, subprog) -> modA vsTypeFuns $ Map.insert (OrdType el_ty, id) ((mkVHDLExtId id), subprog)) vecShowFuns     
+          mapM_ (\(id, subprog) -> modA vsTypeFuns $ Map.insert (OrdType vec_ty, id) ((mkVHDLExtId id), subprog)) vecShowFuns
           let ty_def = AST.SubtypeIn vec_id (Just range)
           return (Right (ty_id, Right ty_def))
     -- Could not create element type
@@ -465,7 +471,7 @@ mkHType ty = do
         let name = Name.getOccString (TyCon.tyConName tycon)
         Map.lookup name builtin_types
   case builtin_ty of
-    Just typ -> 
+    Just typ ->
       return $ Right $ BuiltinType $ prettyShow typ
     Nothing ->
       case Type.splitTyConApp_maybe ty of
@@ -528,8 +534,25 @@ isReprType ty = do
     Left _ -> False
     Right _ -> True
 
+
 tfp_to_int :: Type.Type -> TypeSession Int
 tfp_to_int ty = do
+  hscenv <- getA vsHscEnv
+  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" -> do
+          len <- tfp_to_int' ty
+          return len
+        otherwise -> do
+          modA vsTfpInts (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 <- getA vsTfpInts
   hscenv <- getA vsHscEnv
   let norm_ty = normalise_tfp_int hscenv ty
@@ -674,4 +697,12 @@ genExprPCall2 :: AST.VHDLId -> AST.Expr -> AST.Expr -> AST.SeqSm
 genExprPCall2 entid arg1 arg2 =
         AST.ProcCall (AST.NSimple entid) $
          map (\exp -> Nothing AST.:=>: AST.ADExpr exp) [arg1,arg2]
-         
\ No newline at end of file
+
+mkSigDec :: CoreSyn.CoreBndr -> VHDLSession (Maybe AST.SigDec)
+mkSigDec bndr =
+  if True then do --isInternalSigUse use || isStateSigUse use then do
+    let error_msg = "\nVHDL.mkSigDec: Can not make signal declaration for type: \n" ++ pprString bndr 
+    type_mark <- MonadState.lift vsType $ vhdl_ty error_msg (Var.varType bndr)
+    return $ Just (AST.SigDec (varToVHDLId bndr) type_mark Nothing)
+  else
+    return Nothing