clash 0.1.2.2 → 0.1.2.3
raw patch · 4 files changed
+40/−42 lines, 4 files
Files
- CLasH/Normalize.hs +34/−36
- CLasH/Translator.hs +2/−2
- CLasH/VHDL/Generate.hs +3/−3
- clash.cabal +1/−1
CLasH/Normalize.hs view
@@ -164,10 +164,29 @@ body_maybe <- needsInline f case body_maybe of Just body -> do- -- Regenerate all uniques in the to-be-inlined expression- body_uniqued <- Trans.lift $ genUniques body- -- And replace the variable reference with the unique'd body.- change (mkApps body_uniqued args)+ -- If we inline a top-level function which has an associated+ -- initial state, and if the body of of the function is an+ -- Application. Then we need to clone the function indicated+ -- by the first argument of the application, and associate the + -- initial state with this clone. We also need to replace the+ -- original reference with a reference to this clone+ initSmap <- Trans.lift $ MonadState.get tsInitStates+ case (CoreSyn.collectArgs body, Map.lookup f initSmap) of+ ((Var inlineF, inlineFargs), Just initState) -> do+ -- Get the body belong to the applied function and clone it+ inlineFbody <- Trans.lift $ getGlobalBind inlineF+ newInlineF <- Trans.lift $ mkFunction inlineF (Maybe.fromJust inlineFbody)+ -- Associate the initial state with the cloned function+ Trans.lift $ MonadState.modify tsInitStates (\ismap -> Map.insert (newInlineF) initState ismap)+ -- Replace original reference with a reference to the cloned function+ let newBody = mkApps (Var newInlineF) inlineFargs+ newBodyUniqued <- Trans.lift $ genUniques newBody+ change (mkApps newBodyUniqued args) + _ -> do+ -- Regenerate all uniques in the to-be-inlined expression+ body_uniqued <- Trans.lift $ genUniques body+ -- And replace the variable reference with the unique'd body.+ change (mkApps body_uniqued args) -- No need to inline Nothing -> return expr -- This is not an application of a binder, leave it unchanged.@@ -675,12 +694,13 @@ let newbody = MkCore.mkCoreLams newparams (MkCore.mkCoreApps body oldargs) -- Create a new function with the same name but a new body newf <- Trans.lift $ mkFunction f newbody- Trans.lift $ MonadState.modify tsInitStates (\ismap ->- let init_state_maybe = Map.lookup f ismap in- case init_state_maybe of- Nothing -> ismap- Just init_state -> Map.insert newf init_state ismap)+ let + init_state_maybe = Map.lookup f ismap + in+ case init_state_maybe of+ Nothing -> ismap+ Just init_state -> Map.insert (newf) init_state ismap) -- Replace the original application with one of the new function to the -- new arguments. change $ MkCore.mkCoreApps (Var newf) newargs@@ -1050,15 +1070,7 @@ otherwise -> do initId <- Trans.lift $ mkBinderFor initvalue ("init" ++ Name.getOccString realfunBndr) Trans.lift $ addGlobalBind initId initvalue- return initId- -- initbndr_maybe <- Trans.lift $ getGlobalBind initvalue- -- initbndr <- case initbndr_maybe of- -- (Just a) -> return initvalue- -- Nothing -> do- -- let body = Var initvalue- -- initId <- Trans.lift $ mkBinderFor body ("init" ++ Name.getOccString realfunBndr)- -- Trans.lift $ addGlobalBind initId body- -- return initId + return initId Trans.lift $ MonadState.modify tsInitStates (Map.insert realfunBndr initbndr) -- Return the extracted expression change (Lam id1 (Lam id2 (App (App realfunBody (Var id1)) (Var id2))))@@ -1473,23 +1485,9 @@ getNormalized_maybe result_nonrep bndr = do expr_maybe <- getGlobalBind bndr- case (isArrowB bndr, expr_maybe, isLiftMaybe expr_maybe) of- -- The bndr is an Arrow, and it is the lifting function- (True, Just arrowf, True) -> do- -- Collect the lifted function and the initial state- let (CoreSyn.Var liftfun, already_mapped_args) = CoreSyn.collectArgs arrowf- let [Var realfun, Var initvalue] = get_val_args (Var.varType liftfun) already_mapped_args- -- Normalize the lifted function- normalized <- getNormalized_maybe result_nonrep realfun- realfun' <- mkFunction realfun $ Maybe.fromMaybe (error $ "Normalize.getNormalized_maybe(Arrow.liftS): lifted function " ++ pprString realfun ++ "could not be normalized") normalized- -- Associate initial state with lifted function- MonadState.modify tsInitStates (Map.insert realfun' initvalue)- MonadState.modify tsInitStates (Map.insert bndr initvalue)- -- Make a mapping from the arrow to the lifted function- MonadState.modify tsArrows (Map.insert bndr realfun')- return normalized- -- The bndr is an Arrow (but not the lifting function)- (True, Just arrowf, False) -> do+ case (isArrowB bndr, expr_maybe) of+ -- The bndr is an Arrow + (True, Just arrowf) -> do normalizedA <- Utils.makeCached bndr tsNormalized $ do { -- First apply the transformations that remove the arrows ; arrowLessExpr <- normalizeExpr (show bndr) aTransforms arrowf@@ -1505,7 +1503,7 @@ MonadState.modify tsArrows (Map.insert bndr realfun) return (Just normalizedA) -- The expression is not an Arrow- (False, Just expr, False) -> do+ (False, Just expr) -> do normalizeable <- isNormalizeable result_nonrep bndr if not normalizeable then
CLasH/Translator.hs view
@@ -81,8 +81,8 @@ let all_bindings = concatMap (\x -> CoreSyn.flattenBinds (HscTypes.cm_binds x)) cores -- Store the bindings we loaded tsBindings %= Map.fromList all_bindings- let all_initstates = concatMap (\x -> case x of (_, Nothing, _) -> []; (_, Just inits, _) -> inits) specs - tsInitStates %= Map.fromList all_initstates+ -- let all_initstates = concatMap (\x -> case x of (_, Nothing, _) -> []; (_, Just inits, _) -> inits) specs + tsInitStates %= Map.empty test_binds <- catMaybesM $ Monad.mapM mkTest specs let topbinds = Maybe.catMaybes $ map (\(top, _, _) -> top) specs vhdl <- case topbinds of
CLasH/VHDL/Generate.hs view
@@ -130,13 +130,13 @@ let (statementss, used_entitiess) = unzip sms -- Get initial state, if it's there initSmap <- MonadState.get tsInitStates- let init_state = Map.lookup fname initSmap+ 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 ([in_state], [out_state], Nothing) -> do nonEmpty <- hasNonEmptyType "\n Generate.getArchitecture (in_state)" in_state if nonEmpty - then error ("No initial state defined for: " ++ show fname) + then error ("Generate.getArchitecture: No initial state defined for: " ++ show fname) else return ([],[]) ([in_state], [out_state], Just resetval) -> do nonEmpty <- hasNonEmptyType "" in_state@@ -1079,7 +1079,7 @@ genSra = genNoInsts $ genExprArgs $ genExprRes genSra' genSra' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [(AST.Expr, Type.Type)] -> TranslatorSession AST.Expr genSra' res f [(arg1,_),(arg2,_)] = do {- ; return $ (AST.Sra arg1 (genExprFCall (mkVHDLBasicId toIntegerId) arg2))+ ; return $ (genExprFCall2 (mkVHDLBasicId "shift_right") (arg1, (genExprFCall (mkVHDLBasicId toIntegerId) arg2))) } -----------------------------------------------------------------------------
clash.cabal view
@@ -1,5 +1,5 @@ name: clash-version: 0.1.2.2+version: 0.1.2.3 build-type: Simple synopsis: CAES Language for Synchronous Hardware (CLaSH) description: CLaSH is a tool-chain/language to translate subsets of