diff options
| -rw-r--r-- | compiler/GHC/Builtin/Names.hs | 35 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/ConstantFold.hs | 7 | ||||
| -rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/Integer.hs | 54 | ||||
| -rw-r--r-- | testsuite/tests/arityanal/should_compile/Arity02.stderr | 33 | ||||
| -rw-r--r-- | testsuite/tests/arityanal/should_compile/Arity09.stderr | 32 |
5 files changed, 57 insertions, 104 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs index d60c8820a1..2c07acdf4e 100644 --- a/compiler/GHC/Builtin/Names.hs +++ b/compiler/GHC/Builtin/Names.hs @@ -367,15 +367,8 @@ basicKnownKeyNames integerMulName, integerSubName, integerNegateName, - integerEqName, - integerNeName, - integerLeName, - integerGtName, - integerLtName, - integerGeName, integerAbsName, integerSignumName, - integerCompareName, integerPopCountName, integerQuotName, integerRemName, @@ -1157,15 +1150,8 @@ integerFromNaturalName , integerMulName , integerSubName , integerNegateName - , integerEqName - , integerNeName - , integerLeName - , integerGtName - , integerLtName - , integerGeName , integerAbsName , integerSignumName - , integerCompareName , integerPopCountName , integerQuotName , integerRemName @@ -1268,15 +1254,8 @@ integerAddName = bniVarQual "integerAdd" integerAddIdK integerMulName = bniVarQual "integerMul" integerMulIdKey integerSubName = bniVarQual "integerSub" integerSubIdKey integerNegateName = bniVarQual "integerNegate" integerNegateIdKey -integerEqName = bniVarQual "integerEq#" integerEqIdKey -integerNeName = bniVarQual "integerNe#" integerNeIdKey -integerLeName = bniVarQual "integerLe#" integerLeIdKey -integerGtName = bniVarQual "integerGt#" integerGtIdKey -integerLtName = bniVarQual "integerLt#" integerLtIdKey -integerGeName = bniVarQual "integerGe#" integerGeIdKey integerAbsName = bniVarQual "integerAbs" integerAbsIdKey integerSignumName = bniVarQual "integerSignum" integerSignumIdKey -integerCompareName = bniVarQual "integerCompare" integerCompareIdKey integerPopCountName = bniVarQual "integerPopCount#" integerPopCountIdKey integerQuotName = bniVarQual "integerQuot" integerQuotIdKey integerRemName = bniVarQual "integerRem" integerRemIdKey @@ -2542,15 +2521,8 @@ integerFromNaturalIdKey , integerMulIdKey , integerSubIdKey , integerNegateIdKey - , integerEqIdKey - , integerNeIdKey - , integerLeIdKey - , integerGtIdKey - , integerLtIdKey - , integerGeIdKey , integerAbsIdKey , integerSignumIdKey - , integerCompareIdKey , integerPopCountIdKey , integerQuotIdKey , integerRemIdKey @@ -2616,15 +2588,8 @@ integerAddIdKey = mkPreludeMiscIdUnique 608 integerMulIdKey = mkPreludeMiscIdUnique 609 integerSubIdKey = mkPreludeMiscIdUnique 610 integerNegateIdKey = mkPreludeMiscIdUnique 611 -integerEqIdKey = mkPreludeMiscIdUnique 612 -integerNeIdKey = mkPreludeMiscIdUnique 613 -integerLeIdKey = mkPreludeMiscIdUnique 614 -integerGtIdKey = mkPreludeMiscIdUnique 615 -integerLtIdKey = mkPreludeMiscIdUnique 616 -integerGeIdKey = mkPreludeMiscIdUnique 617 integerAbsIdKey = mkPreludeMiscIdUnique 618 integerSignumIdKey = mkPreludeMiscIdUnique 619 -integerCompareIdKey = mkPreludeMiscIdUnique 620 integerPopCountIdKey = mkPreludeMiscIdUnique 621 integerQuotIdKey = mkPreludeMiscIdUnique 622 integerRemIdKey = mkPreludeMiscIdUnique 623 diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs index 58887cf8e1..9d052748d0 100644 --- a/compiler/GHC/Core/Opt/ConstantFold.hs +++ b/compiler/GHC/Core/Opt/ConstantFold.hs @@ -2055,16 +2055,9 @@ builtinBignumRules = , natural_to_word "Natural -> Word# (wrap)" naturalToWordName -- comparisons (return an unlifted Int#) - , bignum_bin_pred "integerEq#" integerEqName (==) - , bignum_bin_pred "integerNe#" integerNeName (/=) - , bignum_bin_pred "integerLe#" integerLeName (<=) - , bignum_bin_pred "integerGt#" integerGtName (>) - , bignum_bin_pred "integerLt#" integerLtName (<) - , bignum_bin_pred "integerGe#" integerGeName (>=) , bignum_bin_pred "bigNatEq#" bignatEqName (==) -- comparisons (return an Ordering) - , bignum_compare "integerCompare" integerCompareName , bignum_compare "bignatCompare" bignatCompareName , bignum_compare "bignatCompareWord#" bignatCompareWordName diff --git a/libraries/ghc-bignum/src/GHC/Num/Integer.hs b/libraries/ghc-bignum/src/GHC/Num/Integer.hs index f0cfcb81b0..2f9a5432cf 100644 --- a/libraries/ghc-bignum/src/GHC/Num/Integer.hs +++ b/libraries/ghc-bignum/src/GHC/Num/Integer.hs @@ -282,7 +282,6 @@ integerGe !x !y = isTrue# (integerGe# x y) -- | Equal predicate. integerEq# :: Integer -> Integer -> Bool# -{-# NOINLINE integerEq# #-} integerEq# (IS x) (IS y) = x ==# y integerEq# (IN x) (IN y) = bigNatEq# x y integerEq# (IP x) (IP y) = bigNatEq# x y @@ -290,7 +289,6 @@ integerEq# _ _ = 0# -- | Not-equal predicate. integerNe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerNe# #-} integerNe# (IS x) (IS y) = x /=# y integerNe# (IN x) (IN y) = bigNatNe# x y integerNe# (IP x) (IP y) = bigNatNe# x y @@ -298,31 +296,27 @@ integerNe# _ _ = 1# -- | Greater predicate. integerGt# :: Integer -> Integer -> Bool# -{-# NOINLINE integerGt# #-} -integerGt# (IS x) (IS y) = x ># y -integerGt# x y | GT <- integerCompare' x y = 1# -integerGt# _ _ = 0# +integerGt# (IS x) (IS y) = x ># y +integerGt# x y | GT <- integerCompare x y = 1# +integerGt# _ _ = 0# -- | Lower-or-equal predicate. integerLe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerLe# #-} -integerLe# (IS x) (IS y) = x <=# y -integerLe# x y | GT <- integerCompare' x y = 0# -integerLe# _ _ = 1# +integerLe# (IS x) (IS y) = x <=# y +integerLe# x y | GT <- integerCompare x y = 0# +integerLe# _ _ = 1# -- | Lower predicate. integerLt# :: Integer -> Integer -> Bool# -{-# NOINLINE integerLt# #-} -integerLt# (IS x) (IS y) = x <# y -integerLt# x y | LT <- integerCompare' x y = 1# -integerLt# _ _ = 0# +integerLt# (IS x) (IS y) = x <# y +integerLt# x y | LT <- integerCompare x y = 1# +integerLt# _ _ = 0# -- | Greater-or-equal predicate. integerGe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerGe# #-} -integerGe# (IS x) (IS y) = x >=# y -integerGe# x y | LT <- integerCompare' x y = 0# -integerGe# _ _ = 1# +integerGe# (IS x) (IS y) = x >=# y +integerGe# x y | LT <- integerCompare x y = 0# +integerGe# _ _ = 1# instance Eq Integer where (==) = integerEq @@ -330,20 +324,16 @@ instance Eq Integer where -- | Compare two Integer integerCompare :: Integer -> Integer -> Ordering -{-# NOINLINE integerCompare #-} -integerCompare = integerCompare' - -integerCompare' :: Integer -> Integer -> Ordering -{-# INLINE integerCompare' #-} -integerCompare' (IS x) (IS y) = compareInt# x y -integerCompare' (IP x) (IP y) = bigNatCompare x y -integerCompare' (IN x) (IN y) = bigNatCompare y x -integerCompare' (IS _) (IP _) = LT -integerCompare' (IS _) (IN _) = GT -integerCompare' (IP _) (IS _) = GT -integerCompare' (IN _) (IS _) = LT -integerCompare' (IP _) (IN _) = GT -integerCompare' (IN _) (IP _) = LT +{-# INLINEABLE integerCompare #-} +integerCompare (IS x) (IS y) = compareInt# x y +integerCompare (IP x) (IP y) = bigNatCompare x y +integerCompare (IN x) (IN y) = bigNatCompare y x +integerCompare (IS _) (IP _) = LT +integerCompare (IS _) (IN _) = GT +integerCompare (IP _) (IS _) = GT +integerCompare (IN _) (IS _) = LT +integerCompare (IP _) (IN _) = GT +integerCompare (IN _) (IP _) = LT instance Ord Integer where compare = integerCompare diff --git a/testsuite/tests/arityanal/should_compile/Arity02.stderr b/testsuite/tests/arityanal/should_compile/Arity02.stderr index 576718aff4..8f9c4eec08 100644 --- a/testsuite/tests/arityanal/should_compile/Arity02.stderr +++ b/testsuite/tests/arityanal/should_compile/Arity02.stderr @@ -1,38 +1,43 @@ ==================== Tidy Core ==================== -Result size of Tidy Core = {terms: 35, types: 23, coercions: 0, joins: 0/0} +Result size of Tidy Core = {terms: 51, types: 27, coercions: 0, joins: 0/0} --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} F2.f1 :: Integer -[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}] -F2.f1 = 0 +[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +F2.f1 = GHC.Num.Integer.IS 0# -- RHS size: {terms: 7, types: 6, coercions: 0, joins: 0/0} f2f :: forall {t1} {t2}. (t1 -> Integer -> t2) -> t1 -> t2 [GblId, Arity=2, Str=<1C1(C1(L))><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=True)}] f2f = \ (@t) (@t1) (h :: t -> Integer -> t1) (x :: t) -> h x F2.f1 --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} lvl :: Integer [GblId, Unf=OtherCon []] -lvl = 1 +lvl = GHC.Num.Integer.IS 1# Rec { --- RHS size: {terms: 16, types: 3, coercions: 0, joins: 0/0} +-- RHS size: {terms: 29, types: 7, coercions: 0, joins: 0/0} F2.f2_g [Occ=LoopBreaker] :: Integer -> Integer -> Integer -[GblId, Arity=2, Str=<SL><SL>, Unf=OtherCon []] +[GblId, Arity=2, Str=<1L><SL>, Unf=OtherCon []] F2.f2_g = \ (x :: Integer) (y :: Integer) -> - case GHC.Num.Integer.integerGt# x F2.f1 of { - __DEFAULT -> y; - 1# -> F2.f2_g (GHC.Num.Integer.integerSub x lvl) (GHC.Num.Integer.integerAdd x y) + case x of wild { + GHC.Num.Integer.IS x1 -> + case GHC.Prim.># x1 0# of { + __DEFAULT -> y; + 1# -> F2.f2_g (GHC.Num.Integer.integerSub wild lvl) (GHC.Num.Integer.integerAdd wild y) + }; + GHC.Num.Integer.IP x1 -> F2.f2_g (GHC.Num.Integer.integerSub wild lvl) (GHC.Num.Integer.integerAdd wild y); + GHC.Num.Integer.IN x1 -> y } end Rec } --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} F2.f3 :: Integer -[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}] -F2.f3 = 5 +[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +F2.f3 = GHC.Num.Integer.IS 5# -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} f2 :: Integer diff --git a/testsuite/tests/arityanal/should_compile/Arity09.stderr b/testsuite/tests/arityanal/should_compile/Arity09.stderr index 7d24fdeb86..e43de277b7 100644 --- a/testsuite/tests/arityanal/should_compile/Arity09.stderr +++ b/testsuite/tests/arityanal/should_compile/Arity09.stderr @@ -1,31 +1,31 @@ ==================== Tidy Core ==================== -Result size of Tidy Core = {terms: 25, types: 8, coercions: 0, joins: 0/0} +Result size of Tidy Core = {terms: 38, types: 11, coercions: 0, joins: 0/0} --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} lvl :: Integer [GblId, Unf=OtherCon []] -lvl = 100 - --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -lvl1 :: Integer -[GblId, Unf=OtherCon []] -lvl1 = 11 +lvl = GHC.Num.Integer.IS 11# --- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} F9.f1 :: Integer -[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}] -F9.f1 = 10 +[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +F9.f1 = GHC.Num.Integer.IS 10# Rec { --- RHS size: {terms: 15, types: 2, coercions: 0, joins: 0/0} +-- RHS size: {terms: 28, types: 6, coercions: 0, joins: 0/0} F9.f91_f [Occ=LoopBreaker] :: Integer -> Integer -[GblId, Arity=1, Str=<SL>, Unf=OtherCon []] +[GblId, Arity=1, Str=<1L>, Unf=OtherCon []] F9.f91_f = \ (n :: Integer) -> - case GHC.Num.Integer.integerLe# n lvl of { - __DEFAULT -> GHC.Num.Integer.integerSub n F9.f1; - 1# -> F9.f91_f (F9.f91_f (GHC.Num.Integer.integerAdd n lvl1)) + case n of wild { + GHC.Num.Integer.IS x1 -> + case GHC.Prim.<=# x1 100# of { + __DEFAULT -> GHC.Num.Integer.integerSub wild F9.f1; + 1# -> F9.f91_f (F9.f91_f (GHC.Num.Integer.integerAdd wild lvl)) + }; + GHC.Num.Integer.IP x1 -> GHC.Num.Integer.integerSub wild F9.f1; + GHC.Num.Integer.IN x1 -> F9.f91_f (F9.f91_f (GHC.Num.Integer.integerAdd wild lvl)) } end Rec } |