[commit: ghc] master: Add `isValidNatural` predicate (#9818) (4b65376)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/4b6537677fa9460ca5febe2eb79a2d9d5bdadba2/ghc

>---------------------------------------------------------------

commit 4b6537677fa9460ca5febe2eb79a2d9d5bdadba2
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date:   Sat Nov 22 14:52:04 2014 +0100

    Add `isValidNatural` predicate (#9818)
    
    This predicate function encodes the internal `Natural` invariants, and
    is useful for testsuites or code that directly constructs `Natural`
    values.
    
    C.f. `integer-gmp2`'s `isValidBigNat#` and `isValidInteger#` predicates
    for testing internal invariants.


>---------------------------------------------------------------

4b6537677fa9460ca5febe2eb79a2d9d5bdadba2
 libraries/base/GHC/Natural.hs | 21 +++++++++++++++++++++
 1 file changed, 21 insertions(+)

diff --git a/libraries/base/GHC/Natural.hs b/libraries/base/GHC/Natural.hs
index 7c362ac..0dead29 100644
--- a/libraries/base/GHC/Natural.hs
+++ b/libraries/base/GHC/Natural.hs
@@ -35,6 +35,7 @@ module GHC.Natural
       -- (i.e. which constructors are available) depends on the
       -- 'Integer' backend used!
       Natural(..)
+    , isValidNatural
       -- * Conversions
     , wordToNatural
     , naturalToWordMaybe
@@ -87,6 +88,17 @@ data Natural = NatS#                 GmpLimb# -- ^ in @[0, maxBound::Word]@
              deriving (Eq,Ord) -- NB: Order of constructors *must*
                                -- coincide with 'Ord' relation
 
+-- | Test whether all internal invariants are satisfied by 'Natural' value
+--
+-- This operation is mostly useful for test-suites and/or code which
+-- constructs 'Integer' values directly.
+--
+-- /Since: 4.8.0.0/
+isValidNatural :: Natural -> Bool
+isValidNatural (NatS# _)  = True
+isValidNatural (NatJ# bn) = isTrue# (isValidBigNat# bn)
+                            && I# (sizeofBigNat# bn) > 0
+
 {-# RULES
 "fromIntegral/Natural->Natural"  fromIntegral = id :: Natural -> Natural
 "fromIntegral/Natural->Integer"  fromIntegral = toInteger :: Natural->Integer
@@ -397,6 +409,15 @@ naturalToInt (NatJ# bn) = I# (bigNatToInt bn)
 newtype Natural = Natural Integer -- ^ __Invariant__: non-negative 'Integer'
                 deriving (Eq,Ord,Ix)
 
+-- | Test whether all internal invariants are satisfied by 'Natural' value
+--
+-- This operation is mostly useful for test-suites and/or code which
+-- constructs 'Integer' values directly.
+--
+-- /Since: 4.8.0.0/
+isValidNatural :: Natural -> Bool
+isValidNatural (Natural i) = i >= 0
+
 instance Read Natural where
     readsPrec d = map (\(n, s) -> (Natural n, s))
                   . filter ((>= 0) . (\(x,_)->x)) . readsPrec d