Merge branch 'cλash' of http://git.stderr.nl/matthijs/projects/master-project

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

diff --git a/VHDL.hs b/VHDL.hs
index 561c2790d5537bc56d4f5b12d6d9505b2f2a30fb..d177a10b934dc8004425a150552de5df83c12e4e 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -38,6 +38,9 @@ import TranslatorTypes
 import HsValueMap
 import Pretty
 import CoreTools
+import Constants
+import Generate
+import GlobalNameTable
 
 createDesignFiles ::
   [(CoreSyn.CoreBndr, CoreSyn.CoreExpr)]
@@ -48,7 +51,7 @@ createDesignFiles binds =
   map (Arrow.second $ AST.DesignFile full_context) units
   
   where
-    init_session = VHDLSession Map.empty builtin_funcs
+    init_session = VHDLSession Map.empty Map.empty builtin_funcs globalNameTable
     (units, final_session) = 
       State.runState (createLibraryUnits binds) init_session
     ty_decls = Map.elems (final_session ^. vsTypes)
@@ -109,7 +112,7 @@ createEntity (fname, expr) = do
       CoreSyn.CoreBndr 
       -> VHDLState VHDLSignalMapElement
     -- We only need the vsTypes element from the state
-    mkMap = MonadState.lift vsTypes . (\bndr ->
+    mkMap = (\bndr ->
       let
         --info = Maybe.fromMaybe
         --  (error $ "Signal not found in the name map? This should not happen!")
@@ -191,7 +194,7 @@ createArchitecture (fname, expr) = do
     procs = map mkStateProcSm [] -- (makeStatePairs flatfunc)
     procs' = map AST.CSPSm procs
     -- mkSigDec only uses vsTypes from the state
-    mkSigDec' = MonadState.lift vsTypes . mkSigDec
+    mkSigDec' = mkSigDec
 
 -- | Looks up all pairs of old state, new state signals, together with
 --   the state id they represent.
@@ -220,7 +223,7 @@ mkStateProcSm (num, old, new) =
     rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clk)]
     statement   = AST.IfSm rising_edge_clk [assign] [] Nothing
 
-mkSigDec :: CoreSyn.CoreBndr -> TypeState (Maybe AST.SigDec)
+mkSigDec :: CoreSyn.CoreBndr -> VHDLState (Maybe AST.SigDec)
 mkSigDec bndr =
   if True then do --isInternalSigUse use || isStateSigUse use then do
     type_mark <- vhdl_ty $ Var.varType bndr
@@ -281,7 +284,7 @@ mkConcSm sigs (UncondDef src dst) _ = do
           -- Create a cast expression, which is just a function call using the
           -- type name as the function name.
           let litexpr = AST.PrimLit lit
-          ty_id <- MonadState.lift vsTypes (vhdl_ty ty)
+          ty_id <- vhdl_ty ty
           let ty_name = AST.NSimple ty_id
           let args = [Nothing AST.:=>: (AST.ADExpr litexpr)] 
           return $ AST.PrimFCall $ AST.FCall ty_name args
@@ -361,9 +364,9 @@ std_logic_ty :: AST.TypeMark
 std_logic_ty = AST.unsafeVHDLBasicId "std_logic"
 
 -- Translate a Haskell type to a VHDL type
-vhdl_ty :: Type.Type -> TypeState AST.TypeMark
+vhdl_ty :: Type.Type -> VHDLState AST.TypeMark
 vhdl_ty ty = do
-  typemap <- State.get
+  typemap <- getA vsTypes
   let builtin_ty = do -- See if this is a tycon and lookup its name
         (tycon, args) <- Type.splitTyConApp_maybe ty
         let name = Name.getOccString (TyCon.tyConName tycon)
@@ -380,7 +383,7 @@ vhdl_ty ty = do
             (tycon, args) <- Type.splitTyConApp_maybe ty
             let name = Name.getOccString (TyCon.tyConName tycon)
             case name of
-              "FSVec" -> Just $ mk_vector_ty (fsvec_len ty) ty
+              "TFVec" -> Just $ mk_vector_ty (tfvec_len ty) ty
               "SizedWord" -> Just $ mk_vector_ty (sized_word_len ty) ty
               otherwise -> Nothing
       -- Return new_ty when a new type was successfully created
@@ -392,7 +395,7 @@ vhdl_ty ty = do
 mk_vector_ty ::
   Int -- ^ The length of the vector
   -> Type.Type -- ^ The Haskell type to create a VHDL type for
-  -> TypeState AST.TypeMark -- The typemark created.
+  -> VHDLState AST.TypeMark -- The typemark created.
 
 mk_vector_ty len ty = do
   -- Assume there is a single type argument
@@ -402,7 +405,9 @@ mk_vector_ty len ty = do
   let ty_def = AST.TDA $ AST.ConsArrayDef range std_logic_ty
   let ty_dec = AST.TypeDec ty_id ty_def
   -- TODO: Check name uniqueness
-  State.modify (Map.insert (OrdType ty) (ty_id, ty_dec))
+  --State.modify (Map.insert (OrdType ty) (ty_id, ty_dec))
+  modA vsTypes (Map.insert (OrdType ty) (ty_id, ty_dec))
+  modA vsTypeFuns (Map.insert (OrdType ty) (genUnconsVectorFuns std_logic_ty ty_id))
   return ty_id