diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2020-10-02 16:41:40 +0200 |
|---|---|---|
| committer | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2020-10-12 15:10:13 +0200 |
| commit | a740aa0bfca7053f1e7688553d6118ca536b004e (patch) | |
| tree | 6244f7e87107da748532b897f9bc0626471b07e1 | |
| parent | 15c4eb1f774c15d653358e9dcae1e55791c4bbfd (diff) | |
| download | haskell-a740aa0bfca7053f1e7688553d6118ca536b004e.tar.gz | |
Bignum: match on small Integer/Natural
Previously we only matched on *variables* whose unfoldings were a ConApp
of the form `IS lit#` or `NS lit##`. But we forgot to match on the
ConApp directly... As a consequence, constant folding only worked after
the FloatOut pass which creates bindings for most sub-expressions. With
this patch, matching on bignums works even with -O0 (see bignumMatch
test).
| -rw-r--r-- | compiler/GHC/Core/SimpleOpt.hs | 17 | ||||
| -rw-r--r-- | testsuite/tests/lib/integer/all.T | 1 | ||||
| -rw-r--r-- | testsuite/tests/lib/integer/bignumMatch.hs | 9 | ||||
| -rw-r--r-- | testsuite/tests/lib/integer/bignumMatch.stderr | 2 |
4 files changed, 26 insertions, 3 deletions
diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs index eebefbaba6..5f1ed2ba52 100644 --- a/compiler/GHC/Core/SimpleOpt.hs +++ b/compiler/GHC/Core/SimpleOpt.hs @@ -1257,13 +1257,24 @@ exprIsLiteral_maybe env@(_, id_unf) e -> Just l Var v | Just rhs <- expandUnfolding_maybe (id_unf v) - , Just (_env,_fb,dc,_tys,[arg]) <- exprIsConApp_maybe env rhs + , Just b <- matchBignum env rhs + -> Just b + e + | Just b <- matchBignum env e + -> Just b + + | otherwise + -> Nothing + where + matchBignum env e + | Just (_env,_fb,dc,_tys,[arg]) <- exprIsConApp_maybe env e , Just (LitNumber _ i) <- exprIsLiteral_maybe env arg - -> if + = if | dc == naturalNSDataCon -> Just (mkLitNatural i) | dc == integerISDataCon -> Just (mkLitInteger i) | otherwise -> Nothing - _ -> Nothing + | otherwise + = Nothing {- Note [exprIsLambda_maybe] diff --git a/testsuite/tests/lib/integer/all.T b/testsuite/tests/lib/integer/all.T index 43bcb0f3e4..fc6b77f6fa 100644 --- a/testsuite/tests/lib/integer/all.T +++ b/testsuite/tests/lib/integer/all.T @@ -10,6 +10,7 @@ test('gcdeInteger', normal, compile_and_run, ['']) test('integerPowMod', [], compile_and_run, ['']) test('integerGcdExt', [], compile_and_run, ['']) test('integerRecipMod', [], compile_and_run, ['']) +test('bignumMatch', [], compile, ['']) # skip ghci as it doesn't support unboxed tuples test('integerImportExport', [omit_ways(['ghci'])], compile_and_run, ['']) diff --git a/testsuite/tests/lib/integer/bignumMatch.hs b/testsuite/tests/lib/integer/bignumMatch.hs new file mode 100644 index 0000000000..5d9df14c27 --- /dev/null +++ b/testsuite/tests/lib/integer/bignumMatch.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE MagicHash #-} +{-# OPTIONS_GHC -ddump-rule-firings -O0 -v0 #-} + +module Test where + +import GHC.Num.Integer + +foo :: Integer +foo = IS 45# `integerAdd` (IS 0# `integerMul` IS 18#) diff --git a/testsuite/tests/lib/integer/bignumMatch.stderr b/testsuite/tests/lib/integer/bignumMatch.stderr new file mode 100644 index 0000000000..d2a5a07dcb --- /dev/null +++ b/testsuite/tests/lib/integer/bignumMatch.stderr @@ -0,0 +1,2 @@ +Rule fired: integerMul (BUILTIN) +Rule fired: integerAdd (BUILTIN) |