-- 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)
(args, [bind], res) -> True
_ -> False
+
+--------------------------------
+-- Dictionary inlining
+--------------------------------
+-- Inline all top level dictionaries, so we can use them to resolve
+-- class methods based on the dictionary passed.
+inlinedict expr@(Var f) | Id.isDictId f = do
+ body_maybe <- Trans.lift $ getGlobalBind f
+ case body_maybe of
+ Nothing -> return expr
+ Just body -> change body
+
+-- Leave all other expressions unchanged
+inlinedict expr = return expr
+inlinedicttop = everywhere ("inlinedict", inlinedict)
+
--------------------------------
-- Scrutinee simplification
--------------------------------
-- 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]
+transforms = [inlinedicttop, 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, or an error
-- if it is not a known global binder.
getNormalized bndr = do
norm <- getNormalized_maybe bndr
return $ Maybe.fromMaybe
- (error $ "Normalize.getNormalized: Unknown function requested: " ++ show bndr)
+ (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.
+-- 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
- if Maybe.isNothing expr_maybe
+ normalizeable <- isNormalizeable' bndr
+ if not normalizeable || Maybe.isNothing expr_maybe
then
- -- Binder not found
+ -- Binder not normalizeable or not found
return Nothing
else if is_poly (Var bndr)
then