diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c34e9fb --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +*~ +/dist/ diff --git a/Data/IntCast.hs b/Data/IntCast.hs new file mode 100644 index 0000000..f5d71ca --- /dev/null +++ b/Data/IntCast.hs @@ -0,0 +1,295 @@ +{-# LANGUAGE CPP, DataKinds, TypeFamilies, TypeOperators, UndecidableInstances #-} + +#if __GLASGOW_HASKELL__ < 707 +#error This code requires GHC 7.7+ +#endif + +#include "MachDeps.h" +#include "HsBaseConfig.h" + +-- | +-- Module: Data.IntCast +-- Copyright: © 2014 Herbert Valerio Riedel +-- License: BSD-style (see the LICENSE file) +-- +-- Maintainer: Herbert Valerio Riedel +-- Stability: experimental +-- Portability: GHC ≥ 7.8 +-- +-- This module provides for statically or dynamically checked +-- conversions between 'Integral' types. +module Data.IntCast + ( -- * Conversion functions + -- ** statically checked + intCast + , intCastIso + , intCastEq + -- ** dynamically checked + , intCastMaybe + + -- * Registering new integer types + -- | + -- * For 'intCastMaybe' you need to provide type-class instances of 'Bits' + -- (and 'Integral'). + -- + -- * For 'intCast', 'intCastIso', and 'intCastEq' simply + -- declare instances for the 'IntBaseType' type-family (as well + -- as type-class instances of 'Integral') as described below. + , IntBaseType + , IntBaseTypeK(..) + + -- * Type-level predicates + -- | The following type-level predicates are used by 'intCast', + -- 'intCastIso', and 'intCastEq' respectively. + , IsIntSubType + , IsIntBaseSubType + , IsIntTypeIso + , IsIntBaseTypeIso + , IsIntTypeEq + , IsIntBaseTypeEq + ) where + +-- Haskell 2010+ +import Data.Int +import Data.Word +import Foreign.C.Types + +-- non-Haskell 2010 +import GHC.TypeLits +import Data.Bits + +-- | (Kind) Meta-information about integral types. +-- +-- If also a 'Bits' instance is defined, the type-level information +-- provided by 'IntBaseType' ought to match the meta-information that +-- is conveyed by the 'Bits' class' 'isSigned' and 'bitSizeMaybe' +-- methods. +data IntBaseTypeK + -- | fixed-width /n/-bit integers with value range [-2ⁿ⁻¹, 2ⁿ⁻¹-1]. + = FixedIntTag Nat + -- | fixed-width /n/-bit integers with value range [0, 2ⁿ-1]. + | FixedWordTag Nat + -- | integers with value range ]-∞,+∞[. + | BigIntTag + -- | naturals with value range [0,+∞[. + | BigWordTag + +-- | The (open) type family 'IntBaseType' encodes type-level +-- information about the value range of an integral type. +-- +-- This module also provides type family instances for the standard +-- Haskell 2010 integral types (including "Foreign.C.Types"). +-- +-- Here's a simple example for registering a custom type with the +-- "Data.IntCast" facilities: +-- +-- @ +-- /-- user-implemented unsigned 4-bit integer/ +-- data Nibble = … +-- +-- /-- declare meta-information/ +-- type instance 'IntBaseType' MyWord7 = 'FixedIntTag' 4 +-- +-- /-- user-implemented signed 7-bit integer/ +-- data MyInt7 = … +-- +-- /-- declare meta-information/ +-- type instance 'IntBaseType' MyWord7 = 'FixedIntTag' 7 +-- @ +-- +-- The type-level predicate 'IsIntSubType' provides a partial +-- ordering based on the types above. See also 'intCast'. +type family IntBaseType a :: IntBaseTypeK + +type instance IntBaseType Integer = BigIntTag + +-- Haskell2010 Basic fixed-width Integer Types +type instance IntBaseType Int8 = FixedIntTag 8 +type instance IntBaseType Int16 = FixedIntTag 16 +type instance IntBaseType Int32 = FixedIntTag 32 +type instance IntBaseType Int64 = FixedIntTag 64 +type instance IntBaseType Word8 = FixedWordTag 8 +type instance IntBaseType Word16 = FixedWordTag 16 +type instance IntBaseType Word32 = FixedWordTag 32 +type instance IntBaseType Word64 = FixedWordTag 64 + +#if defined(WORD_SIZE_IN_BITS) +type instance IntBaseType Int = FixedIntTag WORD_SIZE_IN_BITS +type instance IntBaseType Word = FixedWordTag WORD_SIZE_IN_BITS +#else +#error Cannot determine bit-size of 'Int'/'Word' type +#endif + +-- Haskell2010 FFI Integer Types +type instance IntBaseType CChar = IntBaseType HTYPE_CHAR +type instance IntBaseType CInt = IntBaseType HTYPE_INT +type instance IntBaseType CIntMax = IntBaseType HTYPE_INTMAX_T +type instance IntBaseType CIntPtr = IntBaseType HTYPE_INTPTR_T +type instance IntBaseType CLLong = IntBaseType HTYPE_LONG_LONG +type instance IntBaseType CLong = IntBaseType HTYPE_LONG +type instance IntBaseType CPtrdiff = IntBaseType HTYPE_PTRDIFF_T +type instance IntBaseType CSChar = IntBaseType HTYPE_SIGNED_CHAR +type instance IntBaseType CShort = IntBaseType HTYPE_SHORT +type instance IntBaseType CSigAtomic = IntBaseType HTYPE_SIG_ATOMIC_T +type instance IntBaseType CSize = IntBaseType HTYPE_SIZE_T +type instance IntBaseType CUChar = IntBaseType HTYPE_UNSIGNED_CHAR +type instance IntBaseType CUInt = IntBaseType HTYPE_UNSIGNED_INT +type instance IntBaseType CUIntMax = IntBaseType HTYPE_UINTMAX_T +type instance IntBaseType CUIntPtr = IntBaseType HTYPE_UINTPTR_T +type instance IntBaseType CULLong = IntBaseType HTYPE_UNSIGNED_LONG_LONG +type instance IntBaseType CULong = IntBaseType HTYPE_UNSIGNED_LONG +type instance IntBaseType CUShort = IntBaseType HTYPE_UNSIGNED_SHORT + +-- Internal class providing the partial order of (improper) subtype-relations +type family IsIntBaseSubType a b :: Bool where + -- this relation is reflexive + IsIntBaseSubType a a = True + + -- Every integer is a subset of 'Integer' + IsIntBaseSubType a BigIntTag = True + + -- Even though Haskell2010 doesn't provide naturals, we can use the + -- tag 'Nat' to denote such entities + IsIntBaseSubType (FixedWordTag a) BigWordTag = True + + -- sub-type relations between fixed-with types + IsIntBaseSubType (FixedIntTag a) (FixedIntTag b) = a <=? b + IsIntBaseSubType (FixedWordTag a) (FixedWordTag b) = a <=? b + IsIntBaseSubType (FixedWordTag a) (FixedIntTag b) = a+1 <=? b + + -- everything else is not a sub-type + IsIntBaseSubType a b = False + +type IsIntSubType a b = IsIntBaseSubType (IntBaseType a) (IntBaseType b) + +-- Same bit-size predicate +type family IsIntBaseTypeIso a b :: Bool where + IsIntBaseTypeIso (FixedIntTag n) (FixedIntTag n) = True + IsIntBaseTypeIso (FixedIntTag n) (FixedWordTag n) = True + IsIntBaseTypeIso (FixedWordTag n) (FixedIntTag n) = True + IsIntBaseTypeIso (FixedWordTag n) (FixedWordTag n) = True + IsIntBaseTypeIso a b = False + +type IsIntTypeIso a b = IsIntBaseTypeIso (IntBaseType a) (IntBaseType b) + +type family IsIntBaseTypeEq a b :: Bool where + IsIntBaseTypeEq (FixedIntTag n) (FixedIntTag n) = True + IsIntBaseTypeEq (FixedWordTag n) (FixedWordTag n) = True + IsIntBaseTypeEq BigIntTag BigIntTag = True + IsIntBaseTypeEq BigWordTag BigWordTag = True + IsIntBaseTypeEq a b = False + +type IsIntTypeEq a b = IsIntBaseTypeEq (IntBaseType a) (IntBaseType b) + +-- | Statically checked integer conversion which satisfies the property +-- +-- * @'toInteger' ≡ 'toInteger' . intCast@ +-- +-- Note: This is just a type-restricted alias of 'fromIntegral' and +-- should therefore lead to the same compiled code as if +-- 'fromIntegral' had been used instead of 'intCast'. +intCast :: (Integral a, Integral b, IsIntSubType a b ~ True) => a -> b +intCast = fromIntegral +{-# INLINE intCast #-} + +-- | Statically checked integer conversion which satisfies the properties +-- +-- * @∀β . 'intCastIso' ('intCastIso' a ∷ β) == a@ +-- +-- * @'toInteger' ('intCastIso' a) == 'toInteger' b (__if__ 'toInteger' a == 'toInteger' b)@ +-- +-- Note: This is just a type-restricted alias of 'fromIntegral' and +-- should therefore lead to the same compiled code as if +-- 'fromIntegral' had been used instead of 'intCast'. +intCastIso :: (Integral a, Integral b, IsIntTypeIso a b ~ True) => a -> b +intCastIso = fromIntegral +{-# INLINE intCastIso #-} + +-- | Version of 'intCast' restricted to casts between types with same value domain. +intCastEq :: (Integral a, Integral b, IsIntTypeEq a b ~ True) => a -> b +intCastEq = fromIntegral +{-# INLINE intCastEq #-} + +---------------------------------------------------------------------------- +---------------------------------------------------------------------------- +-- dynamically checked conversion + +-- | 'Bits' class based value-level predicate with same semantics as 'IsIntSubType' +isBitSubType :: (Bits a, Bits b) => a -> b -> Bool +isBitSubType _x _y + -- reflexive + | xWidth == yWidth, xSigned == ySigned = True + + -- Every integer is a subset of 'Integer' + | ySigned, Nothing == yWidth = True + | not xSigned, not ySigned, Nothing == yWidth = True + + -- sub-type relations between fixed-with types + | xSigned == ySigned, Just xW <- xWidth, Just yW <- yWidth = xW <= yW + | not xSigned, ySigned, Just xW <- xWidth, Just yW <- yWidth = xW < yW + + | otherwise = False + where + xWidth = bitSizeMaybe _x + xSigned = isSigned _x + + yWidth = bitSizeMaybe _y + ySigned = isSigned _y +{-# INLINE isBitSubType #-} + +-- | Run-time-checked integer conversion +-- +-- This is an optimized version of the following generic code below +-- +-- > intCastMaybeRef :: (Integral a, Integral b) => a -> Maybe b +-- > intCastMaybeRef x +-- > | toInteger x == toInteger y = Just y +-- > | otherwise = Nothing +-- > where +-- > y = fromIntegral x +-- +-- The code above is rather inefficient as it needs to go via the +-- 'Integer' type. The function 'intCastMaybe', however, is marked @INLINEABLE@ and +-- if both integral types are statically known, GHC will be able +-- optimize the code signficantly (for @-O1@ and better). +-- +-- For instance (as of GHC 7.8.1) the following definitions +-- +-- > w16_to_i32 = intCastMaybe :: Word16 -> Maybe Int32 +-- > +-- > i16_to_w16 = intCastMaybe :: Int16 -> Maybe Word16 +-- +-- are translated into the following (simplified) /GHC Core/ language +-- +-- > w16_to_i32 = \x -> Just (case x of _ { W16# x# -> I32# (word2Int# x#) }) +-- > +-- > i16_to_w16 = \x -> case eta of _ +-- > { I16# b1 -> case tagToEnum# (<=# 0 b1) of _ +-- > { False -> Nothing +-- > ; True -> Just (W16# (narrow16Word# (int2Word# b1))) +-- > } +-- > } +intCastMaybe :: (Integral a, Integral b, Bits a, Bits b) => a -> Maybe b +-- the code below relies on GHC optimizing away statically decidable branches +intCastMaybe x + | maybe True (<= x) yMinBound + , maybe True (x <=) yMaxBound = Just y + | otherwise = Nothing + where + y = fromIntegral x + + xWidth = bitSizeMaybe x + yWidth = bitSizeMaybe y + + yMinBound | isBitSubType x y = Nothing + | isSigned x, not (isSigned y) = Just 0 + | isSigned x, isSigned y, Just yW <- yWidth + = Just (negate $ bit (yW-1)) -- N.B. assumes sub-type + | otherwise = Nothing + + yMaxBound | isBitSubType x y = Nothing + | isSigned x, not (isSigned y), Just xW <- xWidth, Just yW <- yWidth + , xW <= yW+1 = Nothing -- max-bound beyond a's domain + | Just yW <- yWidth = if isSigned y then Just (bit (yW-1)-1) else Just (bit yW-1) + | otherwise = Nothing +{-# INLINEABLE intCastMaybe #-} diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..0ce51e0 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Herbert Valerio Riedel + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Herbert Valerio Riedel nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/int-cast.cabal b/int-cast.cabal new file mode 100644 index 0000000..a2c8708 --- /dev/null +++ b/int-cast.cabal @@ -0,0 +1,42 @@ +name: int-cast +version: 0.1.0.0 +synopsis: Checked conversions between integral types +homepage: https://github.com/hvr/int-cast +bug-reports: https://github.com/hvr/int-cast/issues +license: BSD3 +license-file: LICENSE +author: Herbert Valerio Riedel +maintainer: hvr@gnu.org +category: Data +build-type: Simple +cabal-version: >=1.10 +description: + Provides statically or dynamically checked conversions between integral types. + +source-repository head + type: git + location: https://github.com/hvr/int-cast.git + +source-repository this + type: git + location: https://github.com/hvr/int-cast.git + tag: 0.1.0.0 + +library + default-language: Haskell2010 + other-extensions: + CPP + DataKinds + TypeFamilies + TypeOperators + UndecidableInstances + build-depends: base ==4.7.* + exposed-modules: Data.IntCast + +test-suite int-cast-test + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test . + main-is: Suite.hs + ghc-options: -Wall + build-depends: int-cast, base, test-framework ==0.8.*, test-framework-quickcheck2 ==0.3.* \ No newline at end of file diff --git a/test/Suite.hs b/test/Suite.hs new file mode 100644 index 0000000..7f9b83b --- /dev/null +++ b/test/Suite.hs @@ -0,0 +1,169 @@ +module Main (main) where + +import Data.Bits +import Data.Word + +import Data.Int + +-- import Test.Framework (defaultMain, testGroup, testCase) +import Test.Framework +import Test.Framework.Providers.QuickCheck2 +-- import Test.HUnit + +import Data.IntCast (intCastMaybe) + +-- test casting from type a to b (2nd argument is used as type-index only) +-- testIntCastMaybe :: a -> b -> Bool +testIntCastMaybe :: (Bits a, Integral a, Bits b, Integral b) => a -> b -> Bool +testIntCastMaybe x _y = refRes == iutRes + where + refRes = intCastMaybeRef x `asTypeOf` (Just _y) + iutRes = intCastMaybe x `asTypeOf` (Just _y) + +intCastMaybeRef :: (Integral a1, Integral a) => a -> Maybe a1 +intCastMaybeRef x + | toInteger x == toInteger y = Just y + | otherwise = Nothing + where + y = fromIntegral x + +{- list generated with + +let intTypes = words "Int Int8 Int16 Int32 Int64 Word Word8 Word16 Word32 Word64 Integer" +putStrLn $ + concat [ " [ " + , intercalate "\n , " + [ concat [ "testProperty \"", t1, "->", t2, "\" (testIntCastMaybe :: ", t1, " -> ", t2, "-> Bool)"] + | t1 <- types, t2 <- types + ] + , "\n ]" + ] + +-} +testGrp_intCastMaybe :: Test +testGrp_intCastMaybe = testGroup "intCastMaybe" + [ testProperty "Int->Int" (testIntCastMaybe :: Int -> Int-> Bool) + , testProperty "Int->Int8" (testIntCastMaybe :: Int -> Int8-> Bool) + , testProperty "Int->Int16" (testIntCastMaybe :: Int -> Int16-> Bool) + , testProperty "Int->Int32" (testIntCastMaybe :: Int -> Int32-> Bool) + , testProperty "Int->Int64" (testIntCastMaybe :: Int -> Int64-> Bool) + , testProperty "Int->Word" (testIntCastMaybe :: Int -> Word-> Bool) + , testProperty "Int->Word8" (testIntCastMaybe :: Int -> Word8-> Bool) + , testProperty "Int->Word16" (testIntCastMaybe :: Int -> Word16-> Bool) + , testProperty "Int->Word32" (testIntCastMaybe :: Int -> Word32-> Bool) + , testProperty "Int->Word64" (testIntCastMaybe :: Int -> Word64-> Bool) + , testProperty "Int->Integer" (testIntCastMaybe :: Int -> Integer-> Bool) + , testProperty "Int8->Int" (testIntCastMaybe :: Int8 -> Int-> Bool) + , testProperty "Int8->Int8" (testIntCastMaybe :: Int8 -> Int8-> Bool) + , testProperty "Int8->Int16" (testIntCastMaybe :: Int8 -> Int16-> Bool) + , testProperty "Int8->Int32" (testIntCastMaybe :: Int8 -> Int32-> Bool) + , testProperty "Int8->Int64" (testIntCastMaybe :: Int8 -> Int64-> Bool) + , testProperty "Int8->Word" (testIntCastMaybe :: Int8 -> Word-> Bool) + , testProperty "Int8->Word8" (testIntCastMaybe :: Int8 -> Word8-> Bool) + , testProperty "Int8->Word16" (testIntCastMaybe :: Int8 -> Word16-> Bool) + , testProperty "Int8->Word32" (testIntCastMaybe :: Int8 -> Word32-> Bool) + , testProperty "Int8->Word64" (testIntCastMaybe :: Int8 -> Word64-> Bool) + , testProperty "Int8->Integer" (testIntCastMaybe :: Int8 -> Integer-> Bool) + , testProperty "Int16->Int" (testIntCastMaybe :: Int16 -> Int-> Bool) + , testProperty "Int16->Int8" (testIntCastMaybe :: Int16 -> Int8-> Bool) + , testProperty "Int16->Int16" (testIntCastMaybe :: Int16 -> Int16-> Bool) + , testProperty "Int16->Int32" (testIntCastMaybe :: Int16 -> Int32-> Bool) + , testProperty "Int16->Int64" (testIntCastMaybe :: Int16 -> Int64-> Bool) + , testProperty "Int16->Word" (testIntCastMaybe :: Int16 -> Word-> Bool) + , testProperty "Int16->Word8" (testIntCastMaybe :: Int16 -> Word8-> Bool) + , testProperty "Int16->Word16" (testIntCastMaybe :: Int16 -> Word16-> Bool) + , testProperty "Int16->Word32" (testIntCastMaybe :: Int16 -> Word32-> Bool) + , testProperty "Int16->Word64" (testIntCastMaybe :: Int16 -> Word64-> Bool) + , testProperty "Int16->Integer" (testIntCastMaybe :: Int16 -> Integer-> Bool) + , testProperty "Int32->Int" (testIntCastMaybe :: Int32 -> Int-> Bool) + , testProperty "Int32->Int8" (testIntCastMaybe :: Int32 -> Int8-> Bool) + , testProperty "Int32->Int16" (testIntCastMaybe :: Int32 -> Int16-> Bool) + , testProperty "Int32->Int32" (testIntCastMaybe :: Int32 -> Int32-> Bool) + , testProperty "Int32->Int64" (testIntCastMaybe :: Int32 -> Int64-> Bool) + , testProperty "Int32->Word" (testIntCastMaybe :: Int32 -> Word-> Bool) + , testProperty "Int32->Word8" (testIntCastMaybe :: Int32 -> Word8-> Bool) + , testProperty "Int32->Word16" (testIntCastMaybe :: Int32 -> Word16-> Bool) + , testProperty "Int32->Word32" (testIntCastMaybe :: Int32 -> Word32-> Bool) + , testProperty "Int32->Word64" (testIntCastMaybe :: Int32 -> Word64-> Bool) + , testProperty "Int32->Integer" (testIntCastMaybe :: Int32 -> Integer-> Bool) + , testProperty "Int64->Int" (testIntCastMaybe :: Int64 -> Int-> Bool) + , testProperty "Int64->Int8" (testIntCastMaybe :: Int64 -> Int8-> Bool) + , testProperty "Int64->Int16" (testIntCastMaybe :: Int64 -> Int16-> Bool) + , testProperty "Int64->Int32" (testIntCastMaybe :: Int64 -> Int32-> Bool) + , testProperty "Int64->Int64" (testIntCastMaybe :: Int64 -> Int64-> Bool) + , testProperty "Int64->Word" (testIntCastMaybe :: Int64 -> Word-> Bool) + , testProperty "Int64->Word8" (testIntCastMaybe :: Int64 -> Word8-> Bool) + , testProperty "Int64->Word16" (testIntCastMaybe :: Int64 -> Word16-> Bool) + , testProperty "Int64->Word32" (testIntCastMaybe :: Int64 -> Word32-> Bool) + , testProperty "Int64->Word64" (testIntCastMaybe :: Int64 -> Word64-> Bool) + , testProperty "Int64->Integer" (testIntCastMaybe :: Int64 -> Integer-> Bool) + , testProperty "Word->Int" (testIntCastMaybe :: Word -> Int-> Bool) + , testProperty "Word->Int8" (testIntCastMaybe :: Word -> Int8-> Bool) + , testProperty "Word->Int16" (testIntCastMaybe :: Word -> Int16-> Bool) + , testProperty "Word->Int32" (testIntCastMaybe :: Word -> Int32-> Bool) + , testProperty "Word->Int64" (testIntCastMaybe :: Word -> Int64-> Bool) + , testProperty "Word->Word" (testIntCastMaybe :: Word -> Word-> Bool) + , testProperty "Word->Word8" (testIntCastMaybe :: Word -> Word8-> Bool) + , testProperty "Word->Word16" (testIntCastMaybe :: Word -> Word16-> Bool) + , testProperty "Word->Word32" (testIntCastMaybe :: Word -> Word32-> Bool) + , testProperty "Word->Word64" (testIntCastMaybe :: Word -> Word64-> Bool) + , testProperty "Word->Integer" (testIntCastMaybe :: Word -> Integer-> Bool) + , testProperty "Word8->Int" (testIntCastMaybe :: Word8 -> Int-> Bool) + , testProperty "Word8->Int8" (testIntCastMaybe :: Word8 -> Int8-> Bool) + , testProperty "Word8->Int16" (testIntCastMaybe :: Word8 -> Int16-> Bool) + , testProperty "Word8->Int32" (testIntCastMaybe :: Word8 -> Int32-> Bool) + , testProperty "Word8->Int64" (testIntCastMaybe :: Word8 -> Int64-> Bool) + , testProperty "Word8->Word" (testIntCastMaybe :: Word8 -> Word-> Bool) + , testProperty "Word8->Word8" (testIntCastMaybe :: Word8 -> Word8-> Bool) + , testProperty "Word8->Word16" (testIntCastMaybe :: Word8 -> Word16-> Bool) + , testProperty "Word8->Word32" (testIntCastMaybe :: Word8 -> Word32-> Bool) + , testProperty "Word8->Word64" (testIntCastMaybe :: Word8 -> Word64-> Bool) + , testProperty "Word8->Integer" (testIntCastMaybe :: Word8 -> Integer-> Bool) + , testProperty "Word16->Int" (testIntCastMaybe :: Word16 -> Int-> Bool) + , testProperty "Word16->Int8" (testIntCastMaybe :: Word16 -> Int8-> Bool) + , testProperty "Word16->Int16" (testIntCastMaybe :: Word16 -> Int16-> Bool) + , testProperty "Word16->Int32" (testIntCastMaybe :: Word16 -> Int32-> Bool) + , testProperty "Word16->Int64" (testIntCastMaybe :: Word16 -> Int64-> Bool) + , testProperty "Word16->Word" (testIntCastMaybe :: Word16 -> Word-> Bool) + , testProperty "Word16->Word8" (testIntCastMaybe :: Word16 -> Word8-> Bool) + , testProperty "Word16->Word16" (testIntCastMaybe :: Word16 -> Word16-> Bool) + , testProperty "Word16->Word32" (testIntCastMaybe :: Word16 -> Word32-> Bool) + , testProperty "Word16->Word64" (testIntCastMaybe :: Word16 -> Word64-> Bool) + , testProperty "Word16->Integer" (testIntCastMaybe :: Word16 -> Integer-> Bool) + , testProperty "Word32->Int" (testIntCastMaybe :: Word32 -> Int-> Bool) + , testProperty "Word32->Int8" (testIntCastMaybe :: Word32 -> Int8-> Bool) + , testProperty "Word32->Int16" (testIntCastMaybe :: Word32 -> Int16-> Bool) + , testProperty "Word32->Int32" (testIntCastMaybe :: Word32 -> Int32-> Bool) + , testProperty "Word32->Int64" (testIntCastMaybe :: Word32 -> Int64-> Bool) + , testProperty "Word32->Word" (testIntCastMaybe :: Word32 -> Word-> Bool) + , testProperty "Word32->Word8" (testIntCastMaybe :: Word32 -> Word8-> Bool) + , testProperty "Word32->Word16" (testIntCastMaybe :: Word32 -> Word16-> Bool) + , testProperty "Word32->Word32" (testIntCastMaybe :: Word32 -> Word32-> Bool) + , testProperty "Word32->Word64" (testIntCastMaybe :: Word32 -> Word64-> Bool) + , testProperty "Word32->Integer" (testIntCastMaybe :: Word32 -> Integer-> Bool) + , testProperty "Word64->Int" (testIntCastMaybe :: Word64 -> Int-> Bool) + , testProperty "Word64->Int8" (testIntCastMaybe :: Word64 -> Int8-> Bool) + , testProperty "Word64->Int16" (testIntCastMaybe :: Word64 -> Int16-> Bool) + , testProperty "Word64->Int32" (testIntCastMaybe :: Word64 -> Int32-> Bool) + , testProperty "Word64->Int64" (testIntCastMaybe :: Word64 -> Int64-> Bool) + , testProperty "Word64->Word" (testIntCastMaybe :: Word64 -> Word-> Bool) + , testProperty "Word64->Word8" (testIntCastMaybe :: Word64 -> Word8-> Bool) + , testProperty "Word64->Word16" (testIntCastMaybe :: Word64 -> Word16-> Bool) + , testProperty "Word64->Word32" (testIntCastMaybe :: Word64 -> Word32-> Bool) + , testProperty "Word64->Word64" (testIntCastMaybe :: Word64 -> Word64-> Bool) + , testProperty "Word64->Integer" (testIntCastMaybe :: Word64 -> Integer-> Bool) + , testProperty "Integer->Int" (testIntCastMaybe :: Integer -> Int-> Bool) + , testProperty "Integer->Int8" (testIntCastMaybe :: Integer -> Int8-> Bool) + , testProperty "Integer->Int16" (testIntCastMaybe :: Integer -> Int16-> Bool) + , testProperty "Integer->Int32" (testIntCastMaybe :: Integer -> Int32-> Bool) + , testProperty "Integer->Int64" (testIntCastMaybe :: Integer -> Int64-> Bool) + , testProperty "Integer->Word" (testIntCastMaybe :: Integer -> Word-> Bool) + , testProperty "Integer->Word8" (testIntCastMaybe :: Integer -> Word8-> Bool) + , testProperty "Integer->Word16" (testIntCastMaybe :: Integer -> Word16-> Bool) + , testProperty "Integer->Word32" (testIntCastMaybe :: Integer -> Word32-> Bool) + , testProperty "Integer->Word64" (testIntCastMaybe :: Integer -> Word64-> Bool) + , testProperty "Integer->Integer" (testIntCastMaybe :: Integer -> Integer-> Bool) + ] + +main :: IO () +main = defaultMain [testGrp_intCastMaybe]