projects
/
matthijs
/
master-project
/
cλash.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Don't generate VHDL for substate extractor cases.
[matthijs/master-project/cλash.git]
/
cλash
/
CLasH
/
VHDL
/
Generate.hs
diff --git
a/cλash/CLasH/VHDL/Generate.hs
b/cλash/CLasH/VHDL/Generate.hs
index e71e0d91fbd028cca6dc5e0a6512023a28f527d3..5698ef89a6efe29503b4c263b524c288a46f0016 100644
(file)
--- a/
cλash/CLasH/VHDL/Generate.hs
+++ b/
cλash/CLasH/VHDL/Generate.hs
@@
-28,7
+28,7
@@
import CLasH.Translator.TranslatorTypes
import CLasH.VHDL.Constants
import CLasH.VHDL.VHDLTypes
import CLasH.VHDL.VHDLTools
import CLasH.VHDL.Constants
import CLasH.VHDL.VHDLTypes
import CLasH.VHDL.VHDLTools
-import
qualified
CLasH.Utils as Utils
+import CLasH.Utils as Utils
import CLasH.Utils.Core.CoreTools
import CLasH.Utils.Pretty
import qualified CLasH.Normalize as Normalize
import CLasH.Utils.Core.CoreTools
import CLasH.Utils.Pretty
import qualified CLasH.Normalize as Normalize
@@
-47,10
+47,11
@@
getEntity fname = Utils.makeCached fname tsEntities $ do
-- Strip off lambda's, these will be arguments
let (args, letexpr) = CoreSyn.collectBinders expr
-- Generate ports for all non-state types
-- Strip off lambda's, these will be arguments
let (args, letexpr) = CoreSyn.collectBinders expr
-- Generate ports for all non-state types
- args' <-
mapM mkMap (filter (not.hasStateType) args)
+ args' <-
catMaybesM $ mapM mkMap args
-- There must be a let at top level
let (CoreSyn.Let binds (CoreSyn.Var res)) = letexpr
-- There must be a let at top level
let (CoreSyn.Let binds (CoreSyn.Var res)) = letexpr
- res' <- mkMap res
+ -- TODO: Handle Nothing
+ Just res' <- mkMap res
let vhdl_id = mkVHDLBasicId $ varToString fname ++ "_" ++ varToStringUniq fname
let ent_decl = createEntityAST vhdl_id args' res'
let signature = Entity vhdl_id args' res' ent_decl
let vhdl_id = mkVHDLBasicId $ varToString fname ++ "_" ++ varToStringUniq fname
let ent_decl = createEntityAST vhdl_id args' res'
let signature = Entity vhdl_id args' res' ent_decl
@@
-59,7
+60,7
@@
getEntity fname = Utils.makeCached fname tsEntities $ do
mkMap ::
--[(SignalId, SignalInfo)]
CoreSyn.CoreBndr
mkMap ::
--[(SignalId, SignalInfo)]
CoreSyn.CoreBndr
- -> TranslatorSession
Port
+ -> TranslatorSession
(Maybe Port)
mkMap = (\bndr ->
let
--info = Maybe.fromMaybe
mkMap = (\bndr ->
let
--info = Maybe.fromMaybe
@@
-70,8
+71,10
@@
getEntity fname = Utils.makeCached fname tsEntities $ do
ty = Var.varType bndr
error_msg = "\nVHDL.createEntity.mkMap: Can not create entity: " ++ pprString fname ++ "\nbecause no type can be created for port: " ++ pprString bndr
in do
ty = Var.varType bndr
error_msg = "\nVHDL.createEntity.mkMap: Can not create entity: " ++ pprString fname ++ "\nbecause no type can be created for port: " ++ pprString bndr
in do
- type_mark <- MonadState.lift tsType $ vhdl_ty error_msg ty
- return (id, type_mark)
+ type_mark_maybe <- MonadState.lift tsType $ vhdl_ty error_msg ty
+ case type_mark_maybe of
+ Just type_mark -> return $ Just (id, type_mark)
+ Nothing -> return Nothing
)
-- | Create the VHDL AST for an entity
)
-- | Create the VHDL AST for an entity
@@
-157,7
+160,10
@@
mkConcSm (bndr, app@(CoreSyn.App _ _))= do
-- A single alt case must be a selector. This means thee scrutinee is a simple
-- variable, the alternative is a dataalt with a single non-wild binder that
-- is also returned.
-- A single alt case must be a selector. This means thee scrutinee is a simple
-- variable, the alternative is a dataalt with a single non-wild binder that
-- is also returned.
-mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt])) =
+mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt]))
+ -- Don't generate VHDL for substate extraction
+ | hasStateType bndr = return ([], [])
+ | otherwise =
case alt of
(CoreSyn.DataAlt dc, bndrs, (CoreSyn.Var sel_bndr)) -> do
case List.elemIndex sel_bndr bndrs of
case alt of
(CoreSyn.DataAlt dc, bndrs, (CoreSyn.Var sel_bndr)) -> do
case List.elemIndex sel_bndr bndrs of
@@
-486,7
+492,8
@@
genFold'' len left (Left res) f [folded_f, start, vec] = do
-- temporary vector
let tmp_ty = Type.mkAppTy nvec (Var.varType start)
let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty
-- temporary vector
let tmp_ty = Type.mkAppTy nvec (Var.varType start)
let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty
- tmp_vhdl_ty <- MonadState.lift tsType $ vhdl_ty error_msg tmp_ty
+ -- TODO: Handle Nothing
+ Just tmp_vhdl_ty <- MonadState.lift tsType $ vhdl_ty error_msg tmp_ty
-- Setup the generate scheme
let gen_label = mkVHDLExtId ("foldlVector" ++ (varToString vec))
let block_label = mkVHDLExtId ("foldlVector" ++ (varToString res))
-- Setup the generate scheme
let gen_label = mkVHDLExtId ("foldlVector" ++ (varToString vec))
let block_label = mkVHDLExtId ("foldlVector" ++ (varToString res))
@@
-688,7
+695,8
@@
genIterateOrGenerate'' len iter (Left res) f [app_f, start] = do
-- -- temporary vector
let tmp_ty = Var.varType res
let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty
-- -- temporary vector
let tmp_ty = Var.varType res
let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty
- tmp_vhdl_ty <- MonadState.lift tsType $ vhdl_ty error_msg tmp_ty
+ -- TODO: Handle Nothing
+ Just tmp_vhdl_ty <- MonadState.lift tsType $ vhdl_ty error_msg tmp_ty
-- Setup the generate scheme
let gen_label = mkVHDLExtId ("iterateVector" ++ (varToString start))
let block_label = mkVHDLExtId ("iterateVector" ++ (varToString res))
-- Setup the generate scheme
let gen_label = mkVHDLExtId ("iterateVector" ++ (varToString start))
let block_label = mkVHDLExtId ("iterateVector" ++ (varToString res))
@@
-849,7
+857,8
@@
genApplication dst f args = do
vectorFunId :: Type.Type -> String -> TypeSession AST.VHDLId
vectorFunId el_ty fname = do
let error_msg = "\nGenerate.vectorFunId: Can not construct vector function for element: " ++ pprString el_ty
vectorFunId :: Type.Type -> String -> TypeSession AST.VHDLId
vectorFunId el_ty fname = do
let error_msg = "\nGenerate.vectorFunId: Can not construct vector function for element: " ++ pprString el_ty
- elemTM <- vhdl_ty error_msg el_ty
+ -- TODO: Handle the Nothing case?
+ Just elemTM <- vhdl_ty error_msg el_ty
-- 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)