Whoa there! Thanks for re-organising the code, but how about Note [Avoid patError] to explain the problem and the weird code? Every moment spent writing a Note is a moment well spent! http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Comments
Simon | -----Original Message----- | From: [email protected] [mailto:[email protected]] | On Behalf Of Ian Lynagh | Sent: 06 August 2011 12:20 | To: [email protected] | Subject: [commit: integer-simple] master: Make pattern matches more obviously | complete (d29bbf1) | | Repository : ssh://darcs.haskell.org//srv/darcs/packages/integer-simple | | On branch : master | | http://hackage.haskell.org/trac/ghc/changeset/d29bbf1c24c48e65a59d4c18dd160e | ba9867146f | | >--------------------------------------------------------------- | | commit d29bbf1c24c48e65a59d4c18dd160eba9867146f | Author: Ian Lynagh <[email protected]> | Date: Fri Aug 5 23:38:52 2011 +0100 | | Make pattern matches more obviously complete | | Fixes the build when compiling with -O0 | | >--------------------------------------------------------------- | | GHC/Integer/Type.hs | 96 +++++++++++++++++++++++++++++++-------- | ------------ | 1 files changed, 58 insertions(+), 38 deletions(-) | | diff --git a/GHC/Integer/Type.hs b/GHC/Integer/Type.hs | index 49e9c68..7748234 100644 | --- a/GHC/Integer/Type.hs | +++ b/GHC/Integer/Type.hs | @@ -301,15 +301,20 @@ negateInteger (Negative p) = Positive p | negateInteger Naught = Naught | | plusInteger :: Integer -> Integer -> Integer | -Positive p1 `plusInteger` Positive p2 = Positive (p1 `plusPositive` p2) | -Negative p1 `plusInteger` Negative p2 = Negative (p1 `plusPositive` p2) | -Positive p1 `plusInteger` Negative p2 = case p1 `comparePositive` p2 of | - GT -> Positive (p1 `minusPositive` p2) | - EQ -> Naught | - LT -> Negative (p2 `minusPositive` p1) | -Negative p1 `plusInteger` Positive p2 = Positive p2 `plusInteger` Negative p1 | -Naught `plusInteger` (!i) = i | -(!i) `plusInteger` Naught = i | +Positive p1 `plusInteger` Positive p2 = Positive (p1 `plusPositive` p2) | +Negative p1 `plusInteger` Negative p2 = Negative (p1 `plusPositive` p2) | +Positive p1 `plusInteger` Negative p2 | + = case p1 `comparePositive` p2 of | + GT -> Positive (p1 `minusPositive` p2) | + EQ -> Naught | + LT -> Negative (p2 `minusPositive` p1) | +Negative p1 `plusInteger` Positive p2 | + = Positive p2 `plusInteger` Negative p1 | +Naught `plusInteger` Naught = Naught | +Naught `plusInteger` i@(Positive _) = i | +Naught `plusInteger` i@(Negative _) = i | +i@(Positive _) `plusInteger` Naught = i | +i@(Negative _) `plusInteger` Naught = i | | minusInteger :: Integer -> Integer -> Integer | i1 `minusInteger` i2 = i1 `plusInteger` negateInteger i2 | @@ -486,15 +491,16 @@ Some x xs `comparePositive` Some y ys = case xs | `comparePositive` ys of | else EQ | res -> res | None `comparePositive` None = EQ | -(!_) `comparePositive` None = GT | -None `comparePositive` (!_) = LT | +(Some {}) `comparePositive` None = GT | +None `comparePositive` (Some {}) = LT | | plusPositive :: Positive -> Positive -> Positive | plusPositive x0 y0 = addWithCarry 0## x0 y0 | where -- digit `elem` [0, 1] | addWithCarry :: Digit -> Positive -> Positive -> Positive | - addWithCarry c (!xs) None = addOnCarry c xs | - addWithCarry c None (!ys) = addOnCarry c ys | + addWithCarry c None None = addOnCarry c None | + addWithCarry c xs@(Some {}) None = addOnCarry c xs | + addWithCarry c None ys@(Some {}) = addOnCarry c ys | addWithCarry c xs@(Some x xs') ys@(Some y ys') | = if x `ltWord#` y then addWithCarry c ys xs | -- Now x >= y | @@ -550,28 +556,38 @@ Some x xs `minusPositive` Some y ys | case z `plusWord#` x of | z' -> -- z = 2^n + (x - y), calculated without overflow | Some z' ((xs `minusPositive` ys) `minusPositive` onePositive) | -(!xs) `minusPositive` None = xs | -None `minusPositive` (!_) = errorPositive -- XXX Can't happen | +xs@(Some {}) `minusPositive` None = xs | +None `minusPositive` None = None | +None `minusPositive` (Some {}) = errorPositive -- XXX Can't happen | -- XXX None `minusPositive` _ = error "minusPositive: Requirement x > y not met" | | timesPositive :: Positive -> Positive -> Positive | -- XXX None's can't happen here: | -None `timesPositive` (!_) = errorPositive | -(!_) `timesPositive` None = errorPositive | +None `timesPositive` None = errorPositive | +None `timesPositive` (Some {}) = errorPositive | +(Some {}) `timesPositive` None = errorPositive | -- x and y are the last digits in Positive numbers, so are not 0: | -Some x None `timesPositive` Some y None = x `timesDigit` y | -xs@(Some _ None) `timesPositive` (!ys) = ys `timesPositive` xs | --- y is the last digit in a Positive number, so is not 0: | -Some x xs' `timesPositive` ys@(Some y None) | - = -- We could actually skip this test, and everything would | - -- turn out OK. We already play tricks like that in timesPositive. | - let zs = Some 0## (xs' `timesPositive` ys) | - in if x `eqWord#` 0## | - then zs | - else (x `timesDigit` y) `plusPositive` zs | -Some x xs' `timesPositive` ys@(Some _ _) | - = (Some x None `timesPositive` ys) `plusPositive` | - Some 0## (xs' `timesPositive` ys) | +xs@(Some x xs') `timesPositive` ys@(Some y ys') | + = case xs' of | + None -> | + case ys' of | + None -> | + x `timesDigit` y | + Some {} -> | + ys `timesPositive` xs | + Some {} -> | + case ys' of | + None -> | + -- y is the last digit in a Positive number, so is not 0. | + let zs = Some 0## (xs' `timesPositive` ys) | + in -- We could actually skip this test, and everything would | + -- turn out OK. We already play tricks like that in timesPositive. | + if x `eqWord#` 0## | + then zs | + else (x `timesDigit` y) `plusPositive` zs | + Some {} -> | + (Some x None `timesPositive` ys) `plusPositive` | + Some 0## (xs' `timesPositive` ys) | | {- | -- Requires arguments /= 0 | @@ -708,8 +724,9 @@ some (!w) None = if w `eqWord#` 0## then None else | Some w None | some (!w) (!ws) = Some w ws | | andDigits :: Digits -> Digits -> Digits | -andDigits (!_) None = None | -andDigits None (!_) = None | +andDigits None None = None | +andDigits (Some {}) None = None | +andDigits None (Some {}) = None | andDigits (Some w1 ws1) (Some w2 ws2) = Some (w1 `and#` w2) (andDigits ws1 | ws2) | | -- DigitsOnes is just like Digits, only None is really 0xFFFFFFF..., | @@ -719,19 +736,22 @@ andDigits (Some w1 ws1) (Some w2 ws2) = Some (w1 | `and#` w2) (andDigits ws1 ws2) | newtype DigitsOnes = DigitsOnes Digits | | andDigitsOnes :: DigitsOnes -> Digits -> Digits | -andDigitsOnes (!_) None = None | -andDigitsOnes (DigitsOnes None) (!ws2) = ws2 | +andDigitsOnes (DigitsOnes None) None = None | +andDigitsOnes (DigitsOnes None) ws2@(Some {}) = ws2 | +andDigitsOnes (DigitsOnes (Some {})) None = None | andDigitsOnes (DigitsOnes (Some w1 ws1)) (Some w2 ws2) | = Some (w1 `and#` w2) (andDigitsOnes (DigitsOnes ws1) ws2) | | orDigits :: Digits -> Digits -> Digits | -orDigits None (!ds) = ds | -orDigits (!ds) None = ds | +orDigits None None = None | +orDigits None ds@(Some {}) = ds | +orDigits ds@(Some {}) None = ds | orDigits (Some w1 ds1) (Some w2 ds2) = Some (w1 `or#` w2) (orDigits ds1 ds2) | | xorDigits :: Digits -> Digits -> Digits | -xorDigits None (!ds) = ds | -xorDigits (!ds) None = ds | +xorDigits None None = None | +xorDigits None ds@(Some {}) = ds | +xorDigits ds@(Some {}) None = ds | xorDigits (Some w1 ds1) (Some w2 ds2) = Some (w1 `xor#` w2) (xorDigits ds1 | ds2) | | -- XXX We'd really like word2Double# for this | | | | _______________________________________________ | Cvs-libraries mailing list | [email protected] | http://www.haskell.org/mailman/listinfo/cvs-libraries _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
