-- and binds that to b.
mkextracts :: CoreBndr -> Int -> TransformMonad (Maybe (CoreBndr, CoreExpr))
mkextracts b i =
+ -- TODO: Use free variables instead of is_wild. is_wild is a hack.
if is_wild b || Type.isFunTy (Id.idType b)
-- Don't create extra bindings for binders that are already wild, or
-- for binders that bind function types (to prevent loops with
caseremovetop = everywhere ("caseremove", caseremove)
--------------------------------
--- Application simplification
+-- Argument extraction
--------------------------------
--- Make sure that all arguments in an application are simple variables.
+-- Make sure that all arguments of a representable type are simple variables.
appsimpl, appsimpltop :: Transform
--- Don't simplify arguments that are already simple. Do simplify datacons,
--- however, since we can't portmap literals.
-appsimpl expr@(App f (Var v)) | not $ Id.isDataConWorkId v = return expr
+-- Don't simplify arguments that are already simple.
+appsimpl expr@(App f (Var v)) = return expr
-- Simplify all non-applicable (to prevent loops with inlinefun) arguments,
-- except for type arguments (since a let can't bind type vars, only a lambda
-- can). Do this by introducing a new Let that binds the argument and passing
-- Find the function called and the arguments
(fexpr, args) = collectArgs expr
Var f = fexpr
- -- Leave simple arguments untouched
- doarg (Var arg) = return $ Var arg
- -- Change any arguments that have a function type, but no free variables.
- -- We could use is_applicable here, but I think arguments to functions
- -- could only have forall typing when existential typing is enabled. Not
- -- sure, though.
- doarg arg | is_fun arg && not (has_free_vars arg) = do
- -- Create a new top level binding that binds the argument
- id <- mkBinderFor arg "fun"
- Trans.lift $ addGlobalBind id arg
- -- Replace the argument with a reference to the argument
- change $ Var id
+ -- Change any arguments that have a function type, but are not simple yet
+ -- (ie, a variable or application). This means to create a new function
+ -- for map (\f -> ...) b, but not for map (foo a) b.
+ --
+ -- We could use is_applicable here instead of is_fun, but I think
+ -- arguments to functions could only have forall typing when existential
+ -- typing is enabled. Not sure, though.
+ doarg arg | not (is_simple arg) && is_fun arg = do
+ -- Create a new top level binding that binds the argument. Its body will
+ -- be extended with lambda expressions, to take any free variables used
+ -- by the argument expression.
+ let free_vars = VarSet.varSetElems $ CoreFVs.exprFreeVars arg
+ let body = MkCore.mkCoreLams free_vars arg
+ id <- mkBinderFor body "fun"
+ Trans.lift $ addGlobalBind id body
+ -- Replace the argument with a reference to the new function, applied to
+ -- all vars it uses.
+ change $ MkCore.mkCoreApps (Var id) (map Var free_vars)
-- Leave all other arguments untouched
doarg arg = return arg
then
-- This should really only happen at the top level... TODO: Give
-- a different error if this happens down in the recursion.
- error $ "Function " ++ show bndr ++ " is polymorphic, can't normalize"
+ error $ "\nNormalize.normalizeBind: Function " ++ show bndr ++ " is polymorphic, can't normalize"
else do
normalized_funcs <- getA tsNormalized
-- See if this function was normalized already
return ()
-- We don't have a value for this binder. This really shouldn't
-- happen for local id's...
- Nothing -> error $ "No value found for binder " ++ pprString bndr ++ "? This should not happen!"
+ Nothing -> error $ "\nNormalize.normalizeBind: No value found for binder " ++ pprString bndr ++ "? This should not happen!"