diff options
| author | Joachim Breitner <mail@joachim-breitner.de> | 2016-12-26 10:16:55 +0100 |
|---|---|---|
| committer | Joachim Breitner <mail@joachim-breitner.de> | 2016-12-26 21:33:46 +0100 |
| commit | 815099cce8f183d49305c9d40c8ed699c178108c (patch) | |
| tree | 244d0e304edce32814ab796065d80ad013484254 /testsuite/tests/callarity | |
| parent | 3c9fbbac3a34700565b1d51df67444fda149952f (diff) | |
| download | haskell-815099cce8f183d49305c9d40c8ed699c178108c.tar.gz | |
CallArity: Use exprIsCheap to detect thunks
Originally, everything that is not in WHNF (`exprIsWHNF`) is considered
a thunk, not eta-expanded, to avoid losing any sharing. This is also how
the published papers on Call Arity describe it.
In practice, there are thunks that do a just little work, such as
pattern-matching on a variable, and the benefits of eta-expansion likely
oughtweigh the cost of doing that repeatedly. Therefore, this
implementation of Call Arity considers everything that is not cheap
(`exprIsCheap`) as a thunk.
Nofib reports -2.58% allocations for scs and -40.93% allocation for
wheel-sieve1; the latter has - 2.92% runtime.
Diffstat (limited to 'testsuite/tests/callarity')
| -rw-r--r-- | testsuite/tests/callarity/unittest/CallArity1.hs | 11 |
1 files changed, 6 insertions, 5 deletions
diff --git a/testsuite/tests/callarity/unittest/CallArity1.hs b/testsuite/tests/callarity/unittest/CallArity1.hs index 6873d32dd0..88f83fd7ed 100644 --- a/testsuite/tests/callarity/unittest/CallArity1.hs +++ b/testsuite/tests/callarity/unittest/CallArity1.hs @@ -24,9 +24,9 @@ import CoreLint import FastString -- Build IDs. use mkTemplateLocal, more predictable than proper uniques -go, go2, x, d, n, y, z, scrut :: Id -[go, go2, x,d, n, y, z, scrut, f] = mkTestIds - (words "go go2 x d n y z scrut f") +go, go2, x, d, n, y, z, scrutf, scruta :: Id +[go, go2, x,d, n, y, z, scrutf, scruta, f] = mkTestIds + (words "go go2 x d n y z scrutf scruta f") [ mkFunTys [intTy, intTy] intTy , mkFunTys [intTy, intTy] intTy , intTy @@ -34,6 +34,7 @@ go, go2, x, d, n, y, z, scrut :: Id , mkFunTys [intTy] intTy , intTy , intTy + , mkFunTys [boolTy] boolTy , boolTy , mkFunTys [intTy, intTy] intTy -- protoypical external function ] @@ -168,7 +169,7 @@ main = do getSessionDynFlags >>= setSessionDynFlags . flip gopt_set Opt_SuppressUniques dflags <- getSessionDynFlags liftIO $ forM_ exprs $ \(n,e) -> do - case lintExpr dflags [f,scrut] e of + case lintExpr dflags [f,scrutf,scruta] e of Just msg -> putMsg dflags (msg $$ text "in" <+> text n) Nothing -> return () putMsg dflags (text n <> char ':') @@ -184,7 +185,7 @@ main = do mkLApps :: Id -> [Integer] -> CoreExpr mkLApps v = mkApps (Var v) . map mkLit -mkACase = mkIfThenElse (Var scrut) +mkACase = mkIfThenElse (mkVarApps (Var scrutf) [scruta]) mkTestId :: Int -> String -> Type -> Id mkTestId i s ty = mkSysLocal (mkFastString s) (mkBuiltinUnique i) ty |