X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL%2FGenerate.hs;h=149c6eca1fcd6e28d0e782f5af8a60ca9e61b998;hb=c14448ec4b59b13cffa7274d6154366d3be13fbb;hp=3f81f8f12c9b52e0b2d3641d36ed546663849dfe;hpb=e7f89819c61188a732c8f011d74d783800e88da8;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git "a/c\316\273ash/CLasH/VHDL/Generate.hs" "b/c\316\273ash/CLasH/VHDL/Generate.hs" index 3f81f8f..149c6ec 100644 --- "a/c\316\273ash/CLasH/VHDL/Generate.hs" +++ "b/c\316\273ash/CLasH/VHDL/Generate.hs" @@ -44,12 +44,10 @@ getEntity :: getEntity fname = Utils.makeCached fname tsEntities $ do expr <- Normalize.getNormalized fname - -- Strip off lambda's, these will be arguments - let (args, letexpr) = CoreSyn.collectBinders expr + -- Split the normalized expression + let (args, binds, res) = Normalize.splitNormalized expr -- Generate ports for all non-empty types args' <- catMaybesM $ mapM mkMap args - -- There must be a let at top level - let (CoreSyn.Let binds (CoreSyn.Var res)) = letexpr -- TODO: Handle Nothing res' <- mkMap res let vhdl_id = mkVHDLBasicId $ varToString fname ++ "_" ++ varToStringUniq fname @@ -111,12 +109,12 @@ getArchitecture :: getArchitecture fname = Utils.makeCached fname tsArchitectures $ do expr <- Normalize.getNormalized fname + -- Split the normalized expression + let (args, binds, res) = Normalize.splitNormalized expr + + -- Get the entity for this function signature <- getEntity fname let entity_id = ent_id signature - -- Strip off lambda's, these will be arguments - let (args, letexpr) = CoreSyn.collectBinders expr - -- There must be a let at top level - let (CoreSyn.Let (CoreSyn.Rec binds) (CoreSyn.Var res)) = letexpr -- Create signal declarations for all binders in the let expression, except -- for the output port (that will already have an output port declared in @@ -129,9 +127,9 @@ getArchitecture fname = Utils.makeCached fname tsArchitectures $ do let (in_state_maybes, out_state_maybes) = unzip state_vars let (statementss, used_entitiess) = unzip sms -- Create a state proc, if needed - let state_proc = case (Maybe.catMaybes in_state_maybes, Maybe.catMaybes out_state_maybes) of - ([in_state], [out_state]) -> [AST.CSPSm $ mkStateProcSm (in_state, out_state)] - ([], []) -> [] + state_proc <- case (Maybe.catMaybes in_state_maybes, Maybe.catMaybes out_state_maybes) of + ([in_state], [out_state]) -> mkStateProcSm (in_state, out_state) + ([], []) -> return [] (ins, outs) -> error $ "Weird use of state in " ++ show fname ++ ". In: " ++ show ins ++ " Out: " ++ show outs -- Join the create statements and the (optional) state_proc let statements = concat statementss ++ state_proc @@ -162,9 +160,12 @@ getArchitecture fname = Utils.makeCached fname tsArchitectures $ do mkStateProcSm :: (CoreSyn.CoreBndr, CoreSyn.CoreBndr) -- ^ The current and new state variables - -> AST.ProcSm -- ^ The resulting statement -mkStateProcSm (old, new) = - AST.ProcSm label [clk] [statement] + -> TranslatorSession [AST.ConcSm] -- ^ The resulting statements +mkStateProcSm (old, new) = do + nonempty <- hasNonEmptyType old + if nonempty + then return [AST.CSPSm $ AST.ProcSm label [clk] [statement]] + else return [] where label = mkVHDLBasicId $ "state" clk = mkVHDLBasicId "clock"