-- body consisting of a bunch of nested lambdas containing a
-- non-function value (e.g., a complete application).
eta :: Transform
-eta c expr | is_fun expr && not (is_lam expr) && all (== LambdaBody) c = do
- let arg_ty = (fst . Type.splitFunTy . CoreUtils.exprType) expr
- id <- Trans.lift $ mkInternalVar "param" arg_ty
- change (Lam id (App expr (Var id)))
+eta (AppFirst:_) expr = return expr
+-- Also don't apply to arguments, since this can cause loops with
+-- funextract. This isn't the proper solution, but due to an
+-- implementation bug in notappargs, this is how it used to work so far.
+eta (AppSecond:_) expr = return expr
+eta c expr | is_fun expr && not (is_lam expr) = do
+ let arg_ty = (fst . Type.splitFunTy . CoreUtils.exprType) expr
+ id <- Trans.lift $ mkInternalVar "param" arg_ty
+ change (Lam id (App expr (Var id)))
-- Leave all other expressions unchanged
eta c e = return e
-- 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
+ doarg arg | not (is_simple arg) && is_fun arg && not (has_free_tyvars 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.
-- Make sure the scrutinee of a case expression is a local variable
-- reference.
scrutsimpl :: Transform
--- Don't touch scrutinees that are already simple
-scrutsimpl c expr@(Case (Var _) _ _ _) = return expr
--- Replace all other cases with a let that binds the scrutinee and a new
+-- Replace a case expression with a let that binds the scrutinee and a new
-- simple scrutinee, but only when the scrutinee is representable (to prevent
-- loops with inlinenonrep, though I don't think a non-representable scrutinee
--- will be supported anyway...)
+-- will be supported anyway...) and is not a local variable already.
scrutsimpl c expr@(Case scrut b ty alts) = do
repr <- isRepr scrut
- if repr
+ local_var <- Trans.lift $ is_local_var scrut
+ if repr && not local_var
then do
id <- Trans.lift $ mkBinderFor scrut "scrut"
change $ Let (NonRec id scrut) (Case (Var id) b ty alts)
-- that is fully applied (i.e., dos not have a function type) but is not
-- representable. We apply in any context, since non-representable
-- expressions are generally left alone and can occur anywhere.
-inlinenonrepresult context expr | not (is_fun expr) =
+inlinenonrepresult context expr | not (is_applicable expr) && not (has_free_tyvars expr) =
case collectArgs expr of
(Var f, args) | not (Id.isDictId f) -> do
repr <- isRepr expr
-- Leave all other expressions unchanged
inlinenonrepresult c expr = return expr
+----------------------------------------------------------------
+-- Type-class transformations
+----------------------------------------------------------------
+
--------------------------------
-- ClassOp resolution
--------------------------------