diff options
| author | Herbert Valerio Riedel <hvr@gnu.org> | 2014-11-22 15:03:33 +0100 |
|---|---|---|
| committer | Herbert Valerio Riedel <hvr@gnu.org> | 2014-11-22 15:14:02 +0100 |
| commit | 41300b7687c7fc60832f5fa91fce897fc2679ccd (patch) | |
| tree | 786c7f7297a788939cf8dcc8c36515c568e5d0d5 /libraries/base/GHC/Natural.hs | |
| parent | b836139099fc203a8b94849655d7dfb95dd80f4a (diff) | |
| download | haskell-41300b7687c7fc60832f5fa91fce897fc2679ccd.tar.gz | |
Implement {gcd,lcm}/Natural optimisation (#9818)
This provides the equivalent of the existing `{gcd,lcm}/Integer`
optimisations for the `Natural` type, when using the `integer-gmp2`
backend.
Diffstat (limited to 'libraries/base/GHC/Natural.hs')
| -rw-r--r-- | libraries/base/GHC/Natural.hs | 27 |
1 files changed, 27 insertions, 0 deletions
diff --git a/libraries/base/GHC/Natural.hs b/libraries/base/GHC/Natural.hs index 38a705e87e..3adfd40d46 100644 --- a/libraries/base/GHC/Natural.hs +++ b/libraries/base/GHC/Natural.hs @@ -177,6 +177,33 @@ instance Real Natural where toRational (NatS# w) = toRational (W# w) toRational (NatJ# bn) = toRational (Jp# bn) +#if OPTIMISE_INTEGER_GCD_LCM +{-# RULES +"gcd/Natural->Natural->Natural" gcd = gcdNatural +"lcm/Natural->Natural->Natural" lcm = lcmNatural + #-} + +-- | Compute greatest common divisor. +gcdNatural :: Natural -> Natural -> Natural +gcdNatural (NatS# 0##) y = y +gcdNatural x (NatS# 0##) = x +gcdNatural (NatS# 1##) _ = (NatS# 1##) +gcdNatural _ (NatS# 1##) = (NatS# 1##) +gcdNatural (NatJ# x) (NatJ# y) = bigNatToNatural (gcdBigNat x y) +gcdNatural (NatJ# x) (NatS# y) = NatS# (gcdBigNatWord x y) +gcdNatural (NatS# x) (NatJ# y) = NatS# (gcdBigNatWord y x) +gcdNatural (NatS# x) (NatS# y) = NatS# (gcdWord x y) + +-- | compute least common multiplier. +lcmNatural :: Natural -> Natural -> Natural +lcmNatural (NatS# 0##) _ = (NatS# 0##) +lcmNatural _ (NatS# 0##) = (NatS# 0##) +lcmNatural (NatS# 1##) y = y +lcmNatural x (NatS# 1##) = x +lcmNatural x y = (x `quot` (gcdNatural x y)) * y + +#endif + instance Enum Natural where succ n = n `plusNatural` NatS# 1## pred n = n `minusNatural` NatS# 1## |