projects
/
matthijs
/
master-project
/
cλash.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
466f80b
)
Use data-accessor-transformers package to remove deprecation warnings
author
Christiaan Baaij
<christiaan.baaij@gmail.com>
Tue, 10 Nov 2009 16:42:18 +0000
(17:42 +0100)
committer
Christiaan Baaij
<christiaan.baaij@gmail.com>
Tue, 10 Nov 2009 16:42:18 +0000
(17:42 +0100)
cλash/CLasH/Normalize/NormalizeTools.hs
patch
|
blob
|
history
cλash/CLasH/Translator.hs
patch
|
blob
|
history
cλash/CLasH/Translator/TranslatorTypes.hs
patch
|
blob
|
history
cλash/CLasH/Utils.hs
patch
|
blob
|
history
cλash/CLasH/Utils/Core/BinderTools.hs
patch
|
blob
|
history
cλash/CLasH/VHDL.hs
patch
|
blob
|
history
cλash/CLasH/VHDL/Generate.hs
patch
|
blob
|
history
cλash/CLasH/VHDL/Testbench.hs
patch
|
blob
|
history
cλash/CLasH/VHDL/VHDLTools.hs
patch
|
blob
|
history
cλash/clash.cabal
patch
|
blob
|
history
diff --git
a/cλash/CLasH/Normalize/NormalizeTools.hs
b/cλash/CLasH/Normalize/NormalizeTools.hs
index c9e2f804f55508fd7bbec7c1e624e89ac419bd00..936a4ec1e834ec59c6cc49002f50f1878c544d6e 100644
(file)
--- a/
cλash/CLasH/Normalize/NormalizeTools.hs
+++ b/
cλash/CLasH/Normalize/NormalizeTools.hs
@@
-16,7
+16,7
@@
import qualified Control.Monad.Trans.Writer as Writer
import qualified "transformers" Control.Monad.Trans as Trans
import qualified Data.Map as Map
import Data.Accessor
import qualified "transformers" Control.Monad.Trans as Trans
import qualified Data.Map as Map
import Data.Accessor
-import Data.Accessor.MonadState as MonadState
+import Data.Accessor.Monad
.Trans.
State as MonadState
-- GHC API
import CoreSyn
-- GHC API
import CoreSyn
diff --git
a/cλash/CLasH/Translator.hs
b/cλash/CLasH/Translator.hs
index 8884506ea47f27f80a0b3a93bae20384711e0159..16158d24df07fbbf441688a313cf3863cf47a9a5 100644
(file)
--- a/
cλash/CLasH/Translator.hs
+++ b/
cλash/CLasH/Translator.hs
@@
-10,7
+10,7
@@
import qualified Monad
import qualified System.FilePath as FilePath
import qualified Control.Monad.Trans.State as State
import Text.PrettyPrint.HughesPJ (render)
import qualified System.FilePath as FilePath
import qualified Control.Monad.Trans.State as State
import Text.PrettyPrint.HughesPJ (render)
-import Data.Accessor
+import Data.Accessor
.Monad.Trans.State
import qualified Data.Map as Map
import Debug.Trace
import qualified Data.Map as Map
import Debug.Trace
diff --git
a/cλash/CLasH/Translator/TranslatorTypes.hs
b/cλash/CLasH/Translator/TranslatorTypes.hs
index 2591e666f0b3491b93b8f8baaced8d993b77998d..56c5c75a0324696d5f1d6b7d8aa0c934caa5295c 100644
(file)
--- a/
cλash/CLasH/Translator/TranslatorTypes.hs
+++ b/
cλash/CLasH/Translator/TranslatorTypes.hs
@@
-9,7
+9,7
@@
module CLasH.Translator.TranslatorTypes where
import qualified Control.Monad.Trans.State as State
import qualified Data.Map as Map
import qualified Data.Accessor.Template
import qualified Control.Monad.Trans.State as State
import qualified Data.Map as Map
import qualified Data.Accessor.Template
-import
Data.Accessor
+import
qualified Data.Accessor.Monad.Trans.State as MonadState
-- GHC API
import qualified GHC
-- GHC API
import qualified GHC
@@
-109,23
+109,23
@@
type TranslatorSession = State.State TranslatorState
-- module(s)?
isTopLevelBinder :: CoreSyn.CoreBndr -> TranslatorSession Bool
isTopLevelBinder bndr = do
-- module(s)?
isTopLevelBinder :: CoreSyn.CoreBndr -> TranslatorSession Bool
isTopLevelBinder bndr = do
- bindings <-
getA
tsBindings
+ bindings <-
MonadState.get
tsBindings
return $ Map.member bndr bindings
-- Finds the value of a global binding, if available
getGlobalBind :: CoreSyn.CoreBndr -> TranslatorSession (Maybe CoreSyn.CoreExpr)
getGlobalBind bndr = do
return $ Map.member bndr bindings
-- Finds the value of a global binding, if available
getGlobalBind :: CoreSyn.CoreBndr -> TranslatorSession (Maybe CoreSyn.CoreExpr)
getGlobalBind bndr = do
- bindings <-
getA
tsBindings
+ bindings <-
MonadState.get
tsBindings
return $ Map.lookup bndr bindings
-- Adds a new global binding with the given value
addGlobalBind :: CoreSyn.CoreBndr -> CoreSyn.CoreExpr -> TranslatorSession ()
return $ Map.lookup bndr bindings
-- Adds a new global binding with the given value
addGlobalBind :: CoreSyn.CoreBndr -> CoreSyn.CoreExpr -> TranslatorSession ()
-addGlobalBind bndr expr =
modA
tsBindings (Map.insert bndr expr)
+addGlobalBind bndr expr =
MonadState.modify
tsBindings (Map.insert bndr expr)
-- Returns a list of all global binders
getGlobalBinders :: TranslatorSession [CoreSyn.CoreBndr]
getGlobalBinders = do
-- Returns a list of all global binders
getGlobalBinders :: TranslatorSession [CoreSyn.CoreBndr]
getGlobalBinders = do
- bindings <-
getA
tsBindings
+ bindings <-
MonadState.get
tsBindings
return $ Map.keys bindings
-- vim: set ts=8 sw=2 sts=2 expandtab:
return $ Map.keys bindings
-- vim: set ts=8 sw=2 sts=2 expandtab:
diff --git
a/cλash/CLasH/Utils.hs
b/cλash/CLasH/Utils.hs
index 94da85494f2216f75b395b542ed6c07b5362ecbf..51c6ebfc906281c79e74d5becc61fa289a3db143 100644
(file)
--- a/
cλash/CLasH/Utils.hs
+++ b/
cλash/CLasH/Utils.hs
@@
-3,6
+3,7
@@
module CLasH.Utils where
-- Standard Imports
import qualified Maybe
import Data.Accessor
-- Standard Imports
import qualified Maybe
import Data.Accessor
+import Data.Accessor.Monad.Trans.State as MonadState
import qualified Data.Map as Map
import qualified Control.Monad as Monad
import qualified Control.Monad.Trans.State as State
import qualified Data.Map as Map
import qualified Control.Monad as Monad
import qualified Control.Monad.Trans.State as State
@@
-19,14
+20,14
@@
makeCached :: (Monad m, Ord k) =>
-> State.StateT s m v -- ^ The resulting value, from the cache or freshly
-- computed.
makeCached key accessor create = do
-> State.StateT s m v -- ^ The resulting value, from the cache or freshly
-- computed.
makeCached key accessor create = do
- cache <-
getA
accessor
+ cache <-
MonadState.get
accessor
case Map.lookup key cache of
-- Found in cache, just return
Just value -> return value
-- Not found, compute it and put it in the cache
Nothing -> do
value <- create
case Map.lookup key cache of
-- Found in cache, just return
Just value -> return value
-- Not found, compute it and put it in the cache
Nothing -> do
value <- create
-
modA
accessor (Map.insert key value)
+
MonadState.modify
accessor (Map.insert key value)
return value
unzipM :: (Monad m) =>
return value
unzipM :: (Monad m) =>
diff --git
a/cλash/CLasH/Utils/Core/BinderTools.hs
b/cλash/CLasH/Utils/Core/BinderTools.hs
index a072c45f2ee95389672704fce4a9f6e412145752..ef694746286b622a70dab4f98bbef36a247a264e 100644
(file)
--- a/
cλash/CLasH/Utils/Core/BinderTools.hs
+++ b/
cλash/CLasH/Utils/Core/BinderTools.hs
@@
-4,7
+4,7
@@
module CLasH.Utils.Core.BinderTools where
-- Standard modules
module CLasH.Utils.Core.BinderTools where
-- Standard modules
-import Data.Accessor.MonadState as MonadState
+import Data.Accessor.Monad
.Trans.
State as MonadState
-- GHC API
import CoreSyn
-- GHC API
import CoreSyn
@@
-22,16
+22,14
@@
import qualified VarSet
import qualified HscTypes
-- Local imports
import qualified HscTypes
-- Local imports
-import Data.Accessor
-import Data.Accessor.MonadState as MonadState
import CLasH.Translator.TranslatorTypes
-- Create a new Unique
mkUnique :: TranslatorSession Unique.Unique
mkUnique = do
import CLasH.Translator.TranslatorTypes
-- Create a new Unique
mkUnique :: TranslatorSession Unique.Unique
mkUnique = do
- us <-
getA
tsUniqSupply
+ us <-
MonadState.get
tsUniqSupply
let (us', us'') = UniqSupply.splitUniqSupply us
let (us', us'') = UniqSupply.splitUniqSupply us
-
putA
tsUniqSupply us'
+
MonadState.set
tsUniqSupply us'
return $ UniqSupply.uniqFromSupply us''
-- Create a new internal var with the given name and type. A Unique is
return $ UniqSupply.uniqFromSupply us''
-- Create a new internal var with the given name and type. A Unique is
diff --git
a/cλash/CLasH/VHDL.hs
b/cλash/CLasH/VHDL.hs
index 762a0f43f4facc8e142d45537c55beb21df96fb7..21671adedef95da3bccd4f64e204486e43b620b0 100644
(file)
--- a/
cλash/CLasH/VHDL.hs
+++ b/
cλash/CLasH/VHDL.hs
@@
-11,7
+11,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 qualified Control.Monad.Trans.State as State
import qualified Data.Monoid as Monoid
import Data.Accessor
-import Data.Accessor.MonadState as MonadState
+import Data.Accessor.Monad
.Trans.
State as MonadState
import Debug.Trace
-- ForSyDe
import Debug.Trace
-- ForSyDe
@@
-82,9
+82,9
@@
createTypesPackage ::
-- ^ The id and content of the types package
createTypesPackage = do
-- ^ The id and content of the types package
createTypesPackage = do
- tyfuns <-
getA
(tsType .> tsTypeFuns)
+ tyfuns <-
MonadState.get
(tsType .> tsTypeFuns)
let tyfun_decls = mkBuiltInShow ++ (map snd $ Map.elems tyfuns)
let tyfun_decls = mkBuiltInShow ++ (map snd $ Map.elems tyfuns)
- ty_decls_maybes <-
getA
(tsType .> tsTypeDecls)
+ ty_decls_maybes <-
MonadState.get
(tsType .> tsTypeDecls)
let ty_decls = Maybe.catMaybes ty_decls_maybes
let subProgSpecs = map (\(AST.SubProgBody spec _ _) -> AST.PDISS spec) tyfun_decls
let type_package_dec = AST.LUPackageDec $ AST.PackageDec (mkVHDLBasicId "types") ([tfvec_index_decl] ++ ty_decls ++ subProgSpecs)
let ty_decls = Maybe.catMaybes ty_decls_maybes
let subProgSpecs = map (\(AST.SubProgBody spec _ _) -> AST.PDISS spec) tyfun_decls
let type_package_dec = AST.LUPackageDec $ AST.PackageDec (mkVHDLBasicId "types") ([tfvec_index_decl] ++ ty_decls ++ subProgSpecs)
diff --git
a/cλash/CLasH/VHDL/Generate.hs
b/cλash/CLasH/VHDL/Generate.hs
index 3c738a0a04b4c1c9dfefd79a7e816d66a50fb06f..4b24b576e89ca597a8c4b85b8bb551682d63e7fa 100644
(file)
--- a/
cλash/CLasH/VHDL/Generate.hs
+++ b/
cλash/CLasH/VHDL/Generate.hs
@@
-6,8
+6,7
@@
import qualified Data.Map as Map
import qualified Control.Monad as Monad
import qualified Maybe
import qualified Data.Either as Either
import qualified Control.Monad as Monad
import qualified Maybe
import qualified Data.Either as Either
-import Data.Accessor
-import Data.Accessor.MonadState as MonadState
+import Data.Accessor.Monad.Trans.State as MonadState
import Debug.Trace
-- ForSyDe
import Debug.Trace
-- ForSyDe
@@
-50,9
+49,9
@@
getEntity fname = Utils.makeCached fname tsEntities $ do
args' <- catMaybesM $ mapM mkMap args
-- TODO: Handle Nothing
res' <- mkMap res
args' <- catMaybesM $ mapM mkMap args
-- TODO: Handle Nothing
res' <- mkMap res
- count <-
getA
tsEntityCounter
+ count <-
MonadState.get
tsEntityCounter
let vhdl_id = mkVHDLBasicId $ varToString fname ++ "Component_" ++ show count
let vhdl_id = mkVHDLBasicId $ varToString fname ++ "Component_" ++ show count
-
putA
tsEntityCounter (count + 1)
+
MonadState.set
tsEntityCounter (count + 1)
let ent_decl = createEntityAST vhdl_id args' res'
let signature = Entity vhdl_id args' res' ent_decl
return signature
let ent_decl = createEntityAST vhdl_id args' res'
let signature = Entity vhdl_id args' res' ent_decl
return signature
@@
-130,7
+129,7
@@
getArchitecture fname = Utils.makeCached fname tsArchitectures $ do
let (in_state_maybes, out_state_maybes) = unzip state_vars
let (statementss, used_entitiess) = unzip sms
-- Get initial state, if it's there
let (in_state_maybes, out_state_maybes) = unzip state_vars
let (statementss, used_entitiess) = unzip sms
-- Get initial state, if it's there
- initSmap <-
getA
tsInitStates
+ initSmap <-
MonadState.get
tsInitStates
let init_state = Map.lookup fname initSmap
-- Create a state proc, if needed
(state_proc, resbndr) <- case (Maybe.catMaybes in_state_maybes, Maybe.catMaybes out_state_maybes, init_state) of
let init_state = Map.lookup fname initSmap
-- Create a state proc, if needed
(state_proc, resbndr) <- case (Maybe.catMaybes in_state_maybes, Maybe.catMaybes out_state_maybes, init_state) of
@@
-340,7
+339,7
@@
genLitArgs ::
(dst -> func -> [Literal.Literal] -> TranslatorSession [AST.ConcSm])
-> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.ConcSm])
genLitArgs wrap dst func args = do
(dst -> func -> [Literal.Literal] -> TranslatorSession [AST.ConcSm])
-> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.ConcSm])
genLitArgs wrap dst func args = do
- hscenv <- MonadState.lift tsType $
getA
tsHscEnv
+ hscenv <- MonadState.lift tsType $
MonadState.get
tsHscEnv
let (exprargs, []) = Either.partitionEithers args
-- FIXME: Check if we were passed an CoreSyn.App
let litargs = concat (map (getLiterals hscenv) exprargs)
let (exprargs, []) = Either.partitionEithers args
-- FIXME: Check if we were passed an CoreSyn.App
let litargs = concat (map (getLiterals hscenv) exprargs)
@@
-1092,7
+1091,7
@@
vectorFunId el_ty fname = do
-- TODO: This should not be duplicated from mk_vector_ty. Probably but it in
-- the VHDLState or something.
let vectorTM = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elemTM)
-- TODO: This should not be duplicated from mk_vector_ty. Probably but it in
-- the VHDLState or something.
let vectorTM = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elemTM)
- typefuns <-
getA
tsTypeFuns
+ typefuns <-
MonadState.get
tsTypeFuns
el_htype <- mkHType error_msg el_ty
case Map.lookup (UVecType el_htype, fname) typefuns of
-- Function already generated, just return it
el_htype <- mkHType error_msg el_ty
case Map.lookup (UVecType el_htype, fname) typefuns of
-- Function already generated, just return it
@@
-1102,7
+1101,7
@@
vectorFunId el_ty fname = do
let functions = genUnconsVectorFuns elemTM vectorTM
case lookup fname functions of
Just body -> do
let functions = genUnconsVectorFuns elemTM vectorTM
case lookup fname functions of
Just body -> do
-
modA
tsTypeFuns $ Map.insert (UVecType el_htype, fname) (function_id, (fst body))
+
MonadState.modify
tsTypeFuns $ Map.insert (UVecType el_htype, fname) (function_id, (fst body))
mapM_ (vectorFunId el_ty) (snd body)
return function_id
Nothing -> error $ "\nGenerate.vectorFunId: I don't know how to generate vector function " ++ fname
mapM_ (vectorFunId el_ty) (snd body)
return function_id
Nothing -> error $ "\nGenerate.vectorFunId: I don't know how to generate vector function " ++ fname
diff --git
a/cλash/CLasH/VHDL/Testbench.hs
b/cλash/CLasH/VHDL/Testbench.hs
index 399846dc0d6327e9e4dc90616aa975ca0f52797a..89988f5372327b0eb675ecbff08d525ea62a4c73 100644
(file)
--- a/
cλash/CLasH/VHDL/Testbench.hs
+++ b/
cλash/CLasH/VHDL/Testbench.hs
@@
-7,8
+7,7
@@
module CLasH.VHDL.Testbench where
import qualified Control.Monad as Monad
import qualified Maybe
import qualified Data.Map as Map
import qualified Control.Monad as Monad
import qualified Maybe
import qualified Data.Map as Map
-import Data.Accessor
-import qualified Data.Accessor.MonadState as MonadState
+import qualified Data.Accessor.Monad.Trans.State as MonadState
-- ForSyDe
import qualified Language.VHDL.AST as AST
-- ForSyDe
import qualified Language.VHDL.AST as AST
@@
-42,9
+41,9
@@
createTestbench mCycles cores stimuli top = do
-- testbench has no outputs and no inputs.
bndr <- mkInternalVar "testbench" TysWiredIn.unitTy
let entity = createTestbenchEntity bndr
-- testbench has no outputs and no inputs.
bndr <- mkInternalVar "testbench" TysWiredIn.unitTy
let entity = createTestbenchEntity bndr
-
modA
tsEntities (Map.insert bndr entity)
+
MonadState.modify
tsEntities (Map.insert bndr entity)
arch <- createTestbenchArch mCycles stimuli' top entity
arch <- createTestbenchArch mCycles stimuli' top entity
-
modA
tsArchitectures (Map.insert bndr arch)
+
MonadState.modify
tsArchitectures (Map.insert bndr arch)
return bndr
createTestbenchEntity ::
return bndr
createTestbenchEntity ::
diff --git
a/cλash/CLasH/VHDL/VHDLTools.hs
b/cλash/CLasH/VHDL/VHDLTools.hs
index 546fc124ffd216b7e105340b64172fcc423e895d..db3e13acdf200bd199d2f9d49b617722baf3f18d 100644
(file)
--- a/
cλash/CLasH/VHDL/VHDLTools.hs
+++ b/
cλash/CLasH/VHDL/VHDLTools.hs
@@
-11,8
+11,7
@@
import qualified Control.Monad as Monad
import qualified Control.Arrow as Arrow
import qualified Control.Monad.Trans.State as State
import qualified Data.Monoid as Monoid
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 Data.Accessor.Monad.Trans.State as MonadState
import Debug.Trace
-- ForSyDe
import Debug.Trace
-- ForSyDe
@@
-193,7
+192,7
@@
altconToVHDLExpr DEFAULT = error "\nVHDL.conToVHDLExpr: DEFAULT alternative shou
-- Turn a datacon (without arguments!) into a VHDL expression.
dataconToVHDLExpr :: DataCon.DataCon -> TypeSession AST.Expr
dataconToVHDLExpr dc = do
-- Turn a datacon (without arguments!) into a VHDL expression.
dataconToVHDLExpr :: DataCon.DataCon -> TypeSession AST.Expr
dataconToVHDLExpr dc = do
- typemap <-
getA
tsTypes
+ typemap <-
MonadState.get
tsTypes
htype_either <- mkHTypeEither (DataCon.dataConRepType dc)
case htype_either of
-- No errors
htype_either <- mkHTypeEither (DataCon.dataConRepType dc)
case htype_either of
-- No errors
@@
-331,7
+330,7
@@
mkHTypeEither' ty | ty_has_free_tyvars ty = return $ Left $ "\nVHDLTools.mkHType
| otherwise = do
case Type.splitTyConApp_maybe ty of
Just (tycon, args) -> do
| otherwise = do
case Type.splitTyConApp_maybe ty of
Just (tycon, args) -> do
- typemap <-
getA
tsTypes
+ typemap <-
MonadState.get
tsTypes
let name = Name.getOccString (TyCon.tyConName tycon)
let builtinTyMaybe = Map.lookup (BuiltinType name) typemap
case builtinTyMaybe of
let name = Name.getOccString (TyCon.tyConName tycon)
let builtinTyMaybe = Map.lookup (BuiltinType name) typemap
case builtinTyMaybe of
@@
-406,7
+405,7
@@
vhdlTy msg ty = do
vhdlTyMaybe :: HType -> TypeSession (Maybe AST.TypeMark)
vhdlTyMaybe htype = do
vhdlTyMaybe :: HType -> TypeSession (Maybe AST.TypeMark)
vhdlTyMaybe htype = do
- typemap <-
getA
tsTypes
+ typemap <-
MonadState.get
tsTypes
-- If not a builtin type, try the custom types
let existing_ty = Map.lookup htype typemap
case existing_ty of
-- If not a builtin type, try the custom types
let existing_ty = Map.lookup htype typemap
case existing_ty of
@@
-416,10
+415,10
@@
vhdlTyMaybe htype = do
-- No type yet, try to construct it
Nothing -> do
newty <- (construct_vhdl_ty htype)
-- No type yet, try to construct it
Nothing -> do
newty <- (construct_vhdl_ty htype)
-
modA
tsTypes (Map.insert htype newty)
+
MonadState.modify
tsTypes (Map.insert htype newty)
case newty of
Just (ty_id, ty_def) -> do
case newty of
Just (ty_id, ty_def) -> do
-
modA
tsTypeDecls (\typedefs -> typedefs ++ [mktydecl (ty_id, ty_def)])
+
MonadState.modify
tsTypeDecls (\typedefs -> typedefs ++ [mktydecl (ty_id, ty_def)])
return $ Just ty_id
Nothing -> return Nothing
return $ Just ty_id
Nothing -> return Nothing
@@
-452,14
+451,14
@@
mkTyconTy htype =
let ty_id = mkVHDLExtId $ tycon ++ elem_names
let ty_def = AST.TDR $ AST.RecordTypeDef elems
let tupshow = mkTupleShow elem_tys ty_id
let ty_id = mkVHDLExtId $ tycon ++ elem_names
let ty_def = AST.TDR $ AST.RecordTypeDef elems
let tupshow = mkTupleShow elem_tys ty_id
-
modA
tsTypeFuns $ Map.insert (htype, showIdString) (showId, tupshow)
+
MonadState.modify
tsTypeFuns $ Map.insert (htype, showIdString) (showId, tupshow)
return $ Just (ty_id, Just $ Left ty_def)
(EnumType tycon dcs) -> do
let elems = map mkVHDLExtId dcs
let ty_id = mkVHDLExtId tycon
let ty_def = AST.TDE $ AST.EnumTypeDef elems
let enumShow = mkEnumShow elems ty_id
return $ Just (ty_id, Just $ Left ty_def)
(EnumType tycon dcs) -> do
let elems = map mkVHDLExtId dcs
let ty_id = mkVHDLExtId tycon
let ty_def = AST.TDE $ AST.EnumTypeDef elems
let enumShow = mkEnumShow elems ty_id
-
modA
tsTypeFuns $ Map.insert (htype, showIdString) (showId, enumShow)
+
MonadState.modify
tsTypeFuns $ Map.insert (htype, showIdString) (showId, enumShow)
return $ Just (ty_id, Just $ Left ty_def)
otherwise -> error $ "\nVHDLTools.mkTyconTy: Called for HType that is neiter a AggrType or EnumType: " ++ show htype
where
return $ Just (ty_id, Just $ Left ty_def)
otherwise -> error $ "\nVHDLTools.mkTyconTy: Called for HType that is neiter a AggrType or EnumType: " ++ show htype
where
@@
-473,7
+472,7
@@
mkVectorTy ::
-- ^ An error message or The typemark created.
mkVectorTy (VecType len elHType) = do
-- ^ An error message or The typemark created.
mkVectorTy (VecType len elHType) = do
- typesMap <-
getA
tsTypes
+ typesMap <-
MonadState.get
tsTypes
elTyTmMaybe <- vhdlTyMaybe elHType
case elTyTmMaybe of
(Just elTyTm) -> do
elTyTmMaybe <- vhdlTyMaybe elHType
case elTyTmMaybe of
(Just elTyTm) -> do
@@
-487,10
+486,10
@@
mkVectorTy (VecType len elHType) = do
Nothing -> do
let vec_id = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elTyTm)
let vec_def = AST.TDA $ AST.UnconsArrayDef [tfvec_indexTM] elTyTm
Nothing -> do
let vec_id = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elTyTm)
let vec_def = AST.TDA $ AST.UnconsArrayDef [tfvec_indexTM] elTyTm
-
modA
tsTypes (Map.insert (UVecType elHType) (Just (vec_id, (Just $ Left vec_def))))
-
modA
tsTypeDecls (\typedefs -> typedefs ++ [mktydecl (vec_id, (Just $ Left vec_def))])
+
MonadState.modify
tsTypes (Map.insert (UVecType elHType) (Just (vec_id, (Just $ Left vec_def))))
+
MonadState.modify
tsTypeDecls (\typedefs -> typedefs ++ [mktydecl (vec_id, (Just $ Left vec_def))])
let vecShowFuns = mkVectorShow elTyTm vec_id
let vecShowFuns = mkVectorShow elTyTm vec_id
- mapM_ (\(id, subprog) ->
modA
tsTypeFuns $ Map.insert (UVecType elHType, id) ((mkVHDLExtId id), subprog)) vecShowFuns
+ 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))
Nothing -> return Nothing
let ty_def = AST.SubtypeIn vec_id (Just range)
return (Just (ty_id, Just $ Right ty_def))
Nothing -> return Nothing
@@
-534,7
+533,7
@@
getFieldLabels ty = do
let error_msg = "\nVHDLTools.getFieldLabels: Can not get field labels, because: " ++ pprString ty ++ "can not be generated."
vhdlTy error_msg ty
-- Get the types map, lookup and unpack the VHDL TypeDef
let error_msg = "\nVHDLTools.getFieldLabels: Can not get field labels, because: " ++ pprString ty ++ "can not be generated."
vhdlTy error_msg ty
-- Get the types map, lookup and unpack the VHDL TypeDef
- types <-
getA
tsTypes
+ types <-
MonadState.get
tsTypes
-- Assume the type for which we want labels is really translatable
htype <- mkHType error_msg ty
case Map.lookup htype types of
-- Assume the type for which we want labels is really translatable
htype <- mkHType error_msg ty
case Map.lookup htype types of
@@
-549,7
+548,7
@@
mktydecl (ty_id, Just (Right ty_def)) = Just $ AST.PDISD $ AST.SubtypeDec ty_id
tfp_to_int :: Type.Type -> TypeSession Int
tfp_to_int ty = do
tfp_to_int :: Type.Type -> TypeSession Int
tfp_to_int ty = do
- hscenv <-
getA
tsHscEnv
+ hscenv <-
MonadState.get
tsHscEnv
let norm_ty = normalise_tfp_int hscenv ty
case Type.splitTyConApp_maybe norm_ty of
Just (tycon, args) -> do
let norm_ty = normalise_tfp_int hscenv ty
case Type.splitTyConApp_maybe norm_ty of
Just (tycon, args) -> do
@@
-559,21
+558,21
@@
tfp_to_int ty = do
len <- tfp_to_int' ty
return len
otherwise -> do
len <- tfp_to_int' ty
return len
otherwise -> do
-
modA
tsTfpInts (Map.insert (OrdType norm_ty) (-1))
+
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
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
tsTfpInts
- hscenv <-
getA
tsHscEnv
+ 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
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
-
modA
tsTfpInts (Map.insert (OrdType norm_ty) (new_len))
+
MonadState.modify
tsTfpInts (Map.insert (OrdType norm_ty) (new_len))
return new_len
mkTupleShow ::
return new_len
mkTupleShow ::
diff --git
a/cλash/clash.cabal
b/cλash/clash.cabal
index 1797f28e596e17abeafdb997e471810621b65b33..6a262e8b029f2760d4f56d4925fcb3a97d59848e 100644
(file)
--- a/
cλash/clash.cabal
+++ b/
cλash/clash.cabal
@@
-20,7
+20,8
@@
Library
build-depends: ghc >= 6.11, pretty, vhdl > 0.1, haskell98, syb,
data-accessor, containers, base >= 4, transformers,
filepath, template-haskell, data-accessor-template,
build-depends: ghc >= 6.11, pretty, vhdl > 0.1, haskell98, syb,
data-accessor, containers, base >= 4, transformers,
filepath, template-haskell, data-accessor-template,
- prettyclass, directory, th-lift-ng, tfp, tfvec
+ data-accessor-transformers, prettyclass, directory,
+ th-lift-ng, tfp, tfvec
exposed-modules: CLasH.HardwareTypes
CLasH.Translator
exposed-modules: CLasH.HardwareTypes
CLasH.Translator