X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FNormalize.hs;h=91033b5b1b9bc84c928fd86129362c3d1e5b2f71;hb=bb9442c6efb3b7dc6b16d56234e4b064c45bfb75;hp=56905891fcf19141895f05eec7cb6b49daf9563e;hpb=729463aa72a83323564e39a608a68d02412af2c1;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git "a/c\316\273ash/CLasH/Normalize.hs" "b/c\316\273ash/CLasH/Normalize.hs" index 5690589..91033b5 100644 --- "a/c\316\273ash/CLasH/Normalize.hs" +++ "b/c\316\273ash/CLasH/Normalize.hs" @@ -338,23 +338,19 @@ inlinetoplevel, inlinetopleveltop :: Transform -- Any system name is candidate for inlining. Never inline user-defined -- functions, to preserve structure. inlinetoplevel expr@(Var f) | not $ isUserDefined f = do - norm <- isNormalizeable f - -- See if this is a top level binding for which we have a body - body_maybe <- Trans.lift $ getGlobalBind f - if norm && Maybe.isJust body_maybe - then do - -- Get the normalized version - norm <- Trans.lift $ getNormalized f - if needsInline norm - then do - -- Regenerate all uniques in the to-be-inlined expression - norm_uniqued <- Trans.lift $ genUniques norm - change norm_uniqued - else - return expr - else + norm_maybe <- Trans.lift $ getNormalized_maybe f + case norm_maybe of -- No body or not normalizeable. - return expr + Nothing -> return expr + Just norm -> if needsInline norm then do + -- Regenerate all uniques in the to-be-inlined expression + norm_uniqued <- Trans.lift $ genUniques norm + -- And replace the variable reference with the unique'd body. + change norm_uniqued + else + -- No need to inline + return expr + -- Leave all other expressions unchanged inlinetoplevel expr = return expr inlinetopleveltop = everywhere ("inlinetoplevel", inlinetoplevel) @@ -726,20 +722,41 @@ simplrestop expr = do -- What transforms to run? transforms = [inlinetopleveltop, argproptop, funextracttop, etatop, betatop, castproptop, letremovesimpletop, letderectop, letremovetop, letsimpltop, letflattop, scrutsimpltop, scrutbndrremovetop, casesimpltop, caseremovetop, inlinenonreptop, appsimpltop, letremoveunusedtop, castsimpltop, lambdasimpltop, simplrestop] --- | Returns the normalized version of the given function. +-- | Returns the normalized version of the given function, or an error +-- if it is not a known global binder. getNormalized :: CoreBndr -- ^ The function to get -> TranslatorSession CoreExpr -- The normalized function body - -getNormalized bndr = Utils.makeCached bndr tsNormalized $ - if is_poly (Var bndr) - then - -- This should really only happen at the top level... TODO: Give - -- a different error if this happens down in the recursion. - error $ "\nNormalize.normalizeBind: Function " ++ show bndr ++ " is polymorphic, can't normalize" - else do - Just expr <- getGlobalBind bndr - normalizeExpr (show bndr) expr +getNormalized bndr = do + norm <- getNormalized_maybe bndr + return $ Maybe.fromMaybe + (error $ "Normalize.getNormalized: Unknown or non-representable function requested: " ++ show bndr) + norm + +-- | Returns the normalized version of the given function, or Nothing +-- when the binder is not a known global binder or is not normalizeable. +getNormalized_maybe :: + CoreBndr -- ^ The function to get + -> TranslatorSession (Maybe CoreExpr) -- The normalized function body + +getNormalized_maybe bndr = do + expr_maybe <- getGlobalBind bndr + normalizeable <- isNormalizeable' bndr + if not normalizeable || Maybe.isNothing expr_maybe + then + -- Binder not normalizeable or not found + return Nothing + else if is_poly (Var bndr) + then + -- This should really only happen at the top level... TODO: Give + -- a different error if this happens down in the recursion. + error $ "\nNormalize.normalizeBind: Function " ++ show bndr ++ " is polymorphic, can't normalize" + else do + -- Binder found and is monomorphic. Normalize the expression + -- and cache the result. + normalized <- Utils.makeCached bndr tsNormalized $ + normalizeExpr (show bndr) (Maybe.fromJust expr_maybe) + return (Just normalized) -- | Normalize an expression normalizeExpr ::