diff --git a/AUTHORS b/AUTHORS new file mode 100644 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,4 @@ +=== Haskell prelude-safeenum package AUTHORS/THANKS file === + +The prelude-safeenum package was written by wren ng thornton and +is released under the terms in the LICENSE file. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,33 @@ +Copyright (c) 2012, 2013 wren ng thornton. +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 the copyright holders 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/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,50 @@ +prelude-safeenum +================ + +This is a very simple package and should be easy to install. You +should be able to use any of the following standard methods to +install it. + + -- With cabal-install and without the source: + $> cabal install prelude-safeenum + + -- With cabal-install and with the source already: + $> cd prelude-safeenum + $> cabal install + + -- Without cabal-install, but with the source already: + $> cd prelude-safeenum + $> runhaskell Setup.hs configure --user + $> runhaskell Setup.hs build + $> runhaskell Setup.hs test + $> runhaskell Setup.hs haddock --hyperlink-source + $> runhaskell Setup.hs copy + $> runhaskell Setup.hs register + +The test step is optional and currently does nothing. The Haddock +step is also optional. + + +Portability +=========== + +An attempt has been made to keep this library portable; however, +it does rely on a few language extensions. All the required language +extensions are: + + CPP + GeneralizedNewtypeDeriving + MagicHash -- only for GHC + Trustworthy -- only for GHC >= 7.1 + +The GeneralizedNewtypeDeriving extension is used for brevity in +Data.Number.CalkinWilf. If you'd like to use this package with a +compiler that does not support that extension, contact the maintainer +and it can be removed. + +This package is only "Trustworthy" rather than "Safe" for two +reasons: (1) Data.Number.CalkinWilf uses GeneralizedNewtypeDeriving, +and (2) Prelude.SafeEnum imports GHC.Exts for build/foldr fusion +and for the Char instances. + +----------------------------------------------------------- fin. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,7 @@ +#!/usr/bin/env runhaskell + +module Main (main) where +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/VERSION b/VERSION new file mode 100644 --- /dev/null +++ b/VERSION @@ -0,0 +1,3 @@ +0.1.0 (2013.05.29): + - forked from the (unpublished) data-fin package. + - made things Trustworthy, and some other cleanup. diff --git a/prelude-safeenum.cabal b/prelude-safeenum.cabal new file mode 100644 --- /dev/null +++ b/prelude-safeenum.cabal @@ -0,0 +1,59 @@ +---------------------------------------------------------------- +-- wren ng thornton ~ 2013.05.29 +---------------------------------------------------------------- + +-- By and large Cabal >=1.2 is fine; but >= 1.6 gives tested-with: +-- and source-repository:. +Cabal-Version: >= 1.6 +Build-Type: Simple + +Name: prelude-safeenum +Version: 0.1.0 +Stability: provisional +Homepage: http://code.haskell.org/~wren/ +Author: wren ng thornton +Maintainer: wren@community.haskell.org +Copyright: Copyright (c) 2012--2013 wren ng thornton +License: BSD3 +License-File: LICENSE + +Category: Prelude +Synopsis: + A redefinition of the Prelude's Enum class in order to render it safe. +Description: + A redefinition of the Prelude's Enum class in order to render + it safe. That is, the Haskell Language Report defines pred, + succ, fromEnum, and toEnum to be partial functions when the + type is Bounded, but this is unacceptable. We define a new + type-class hierarchy for enumeration which is safe and also + generalizes to cover types which can only be enumerated in one + direction. + +Tested-With: + GHC ==6.12.1, GHC ==7.6.1 +Extra-source-files: + AUTHORS, README, VERSION +Source-Repository head + Type: darcs + Location: http://community.haskell.org/~wren/prelude-safeenum + +---------------------------------------------------------------- +Flag base4 + Default: True + Description: base-4.0 emits "Prelude deprecated" messages in + order to get people to be explicit about which + version of base they use. +---------------------------------------------------------------- +Library + Hs-Source-Dirs: src + Exposed-Modules: Prelude.SafeEnum + , Data.Number.CalkinWilf + + -- I think this is all that needs doing to get rid of the warnings? + if flag(base4) + Build-Depends: base >= 4 && < 5 + else + Build-Depends: base < 4 + +---------------------------------------------------------------- +----------------------------------------------------------- fin. diff --git a/src/Data/Number/CalkinWilf.hs b/src/Data/Number/CalkinWilf.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/CalkinWilf.hs @@ -0,0 +1,184 @@ +{-# OPTIONS_GHC -Wall -fwarn-tabs #-} +{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} +#if __GLASGOW_HASKELL__ >= 701 +-- N.B., GeneralizedNewtypeDeriving isn't "safe". +{-# LANGUAGE Trustworthy #-} +#endif +---------------------------------------------------------------- +-- 2013.05.29 +-- | +-- Module : Data.Number.CalkinWilf +-- Copyright : 2012--2013 wren ng thornton +-- License : BSD3 +-- Maintainer : wren@community.haskell.org +-- Stability : provisional +-- Portability : Haskell98 + CPP + GeneralizedNewtypeDeriving +-- +-- Enumerate the rationals in Calkin--Wilf order. +-- +-- * Jeremy Gibbons, David Lester, and Richard Bird (2006). +-- /Enumerating the Rationals/. JFP 16(3):281--291. +-- DOI:10.1017\/S0956796806005880 +-- +---------------------------------------------------------------- +module Data.Number.CalkinWilf (CalkinWilf(..), unCalkinWilf) where + +import Prelude hiding (Enum(..)) +import qualified Prelude (Enum(..)) +import Prelude.SafeEnum +import Data.Ratio +import Data.List (elemIndex) + +---------------------------------------------------------------- +-- | Enumerate the rationals in Calkin--Wilf order. The enumeration +-- is symmetric about zero, ensuring that all the negative rationals +-- come before zero and all the positive rationals come after zero. +-- +-- BUG: while the 'succeeds', 'precedes', 'toEnum', and 'fromEnum' +-- methods are correct, they are horribly inefficient. This can be +-- rectified (or at least mitigated), but this remains to be done. +newtype CalkinWilf a = CalkinWilf (Ratio a) + deriving (Read, Show, Eq, Ord, Num, Fractional, Real, RealFrac) + -- BUG: Haddock does a horrible job with the generated contexts... + + +-- | Return the underlying 'Ratio'. Not using record syntax to +-- define this in order to pretty up the derived 'Show' instance. +unCalkinWilf :: CalkinWilf a -> Ratio a +unCalkinWilf (CalkinWilf q) = q +{-# INLINE unCalkinWilf #-} + + +succCW :: Integral a => CalkinWilf a -> CalkinWilf a +{-# SPECIALIZE succCW :: CalkinWilf Integer -> CalkinWilf Integer #-} +succCW x + | x < 0 = + let y = recip x + 1 + in 2 * fromInteger(floor y) - y + | otherwise = + let (n,y) = properFraction x + in recip (fromInteger n + 1 - y) + + +predCW :: Integral a => CalkinWilf a -> CalkinWilf a +{-# SPECIALIZE predCW :: CalkinWilf Integer -> CalkinWilf Integer #-} +predCW x + | x > 0 = + let y = recip x - 1 + in 2 * fromInteger(ceiling y) - y + | otherwise = + let (n,y) = properFraction x + in recip (fromInteger n - 1 - y) + + +-- TODO: We could probably speed everything below up by using the @mod@-based algorithm for 'igcd' and adding on the necessary number of bits; and by replacing [Bool] with a Word where the highest set bit indicates the end of the list. The trick, then, is what to do with [Bool] too large to fit into a Word? + + +-- TODO: does 'elemIndex' fail if the resulting Int would overflow? +cw2mbint :: Integral a => CalkinWilf a -> Maybe Int +{-# SPECIALIZE cw2mbint :: CalkinWilf Integer -> Maybe Int #-} +cw2mbint q = + case compare q 0 of + GT -> fmap (1+) (elemIndex (cw2bits q) boolseqs) + EQ -> Just 0 + LT -> fmap (negate . (1+)) (elemIndex (cw2bits (abs q)) boolseqs) + where + -- Using a local definition to try to avoid memoization + boolseqs = [] : [ b:bs | bs <- boolseqs, b <- [False,True]] + + +cw2bits :: Integral a => CalkinWilf a -> [Bool] +{-# SPECIALIZE cw2bits :: CalkinWilf Integer -> [Bool] #-} +cw2bits (CalkinWilf q) = snd (igcd (numerator q) (denominator q)) + + +igcd :: Integral a => a -> a -> (a,[Bool]) +{-# SPECIALIZE igcd :: Integer -> Integer -> (Integer,[Bool]) #-} +igcd 0 0 = (0,[]) +igcd m n + | m < 0 || n < 0 = error "igcd is undefined on negative arguments" + | otherwise = + case compare m n of + LT -> second (False:) (igcd m (n-m)) + GT -> second (True:) (igcd (m-n) n) + EQ -> (m,[]) + where + second f (x, y) = (x, f y) + + +int2cw :: Integral a => Int -> CalkinWilf a +{-# SPECIALIZE int2cw :: Int -> CalkinWilf Integer #-} +int2cw i + | i == minBound = (predCW . negate . posnat2cw . negate) (i+1) + | otherwise = + case compare i 0 of + GT -> posnat2cw i + EQ -> 0 + LT -> (negate . posnat2cw . negate) i -- Beware when i == minBound + +posnat2cw :: Integral a => Int -> CalkinWilf a +{-# SPECIALIZE posnat2cw :: Int -> CalkinWilf Integer #-} +posnat2cw i = bits2cw (boolseqs !! (i-1)) + where + -- Using a local definition to try to avoid memoization + boolseqs = [] : [ b:bs | bs <- boolseqs, b <- [False,True]] + +bits2cw :: Integral a => [Bool] -> CalkinWilf a +{-# SPECIALIZE bits2cw :: [Bool] -> CalkinWilf Integer #-} +bits2cw bs = + let (m,n) = foldr undo (1,1) bs + in CalkinWilf (m % n) + -- GHC.Real doesn't export (:%), but we know this is already normalized... + where + undo False (m,n) = (m, n+m) + undo True (m,n) = (m+n, n) + + +---------------------------------------------------------------- +instance Integral a => UpwardEnum (CalkinWilf a) where + succ = Just . succCW + -- BUG: What about when 'cw2mbint' fails? + x `succeeds` y = cw2mbint x > cw2mbint y + {-# INLINE succ #-} + {-# INLINE succeeds #-} + + +instance Integral a => DownwardEnum (CalkinWilf a) where + pred = Just . predCW + -- BUG: What about when 'cw2mbint' fails? + x `precedes` y = cw2mbint x < cw2mbint y + {-# INLINE pred #-} + {-# INLINE precedes #-} + + +instance Integral a => Enum (CalkinWilf a) where + toEnum = Just . int2cw + fromEnum = cw2mbint + {-# INLINE toEnum #-} + {-# INLINE fromEnum #-} + + +instance Integral a => Prelude.Enum (CalkinWilf a) where + succ = succCW + pred = predCW + toEnum = int2cw + fromEnum = maybe _fromEnum_OOR id . cw2mbint + enumFrom = iterate succCW + {-# INLINE succ #-} + {-# INLINE pred #-} + {-# INLINE toEnum #-} + {-# INLINE fromEnum #-} + {-# INLINE enumFrom #-} + + -- TODO: enumFromThen :: a -> a -> [a] + -- TODO: enumFromTo :: a -> a -> [a] + -- TODO: enumFromThenTo :: a -> a -> a -> [a] + +---------------------------------------------------------------- +_fromEnum_OOR :: a +_fromEnum_OOR = + error "Enum.fromEnum{CalkinWilf}: argument out of range" +{-# NOINLINE _fromEnum_OOR #-} + +---------------------------------------------------------------- +----------------------------------------------------------- fin. diff --git a/src/Prelude/SafeEnum.hs b/src/Prelude/SafeEnum.hs new file mode 100644 --- /dev/null +++ b/src/Prelude/SafeEnum.hs @@ -0,0 +1,732 @@ +-- We use -XMagicHash instead of the LANGUAGE pragma since we can't +-- CPP-guard language extensions on older versions of GHC. +{-# OPTIONS_GHC -Wall -fwarn-tabs -XMagicHash #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 701 +-- N.B., GHC.Exts isn't "safe". +{-# LANGUAGE Trustworthy #-} +#endif +---------------------------------------------------------------- +-- 2013.05.29 +-- | +-- Module : Prelude.SafeEnum +-- Copyright : 2012--2013 wren ng thornton +-- License : BSD3 +-- Maintainer : wren@community.haskell.org +-- Stability : provisional +-- Portability : Haskell98 + CPP (+ MagicHash) +-- +-- A redefinition of the "Prelude"\'s 'Prelude.Enum' class in order +-- to render it safe. That is, the Haskell Language Report defines +-- 'Prelude.pred', 'Prelude.succ', 'Prelude.fromEnum' and +-- 'Prelude.toEnum' to be partial functions when the type is +-- 'Bounded'[1], but this is unacceptable. So these classes are +-- offered as a replacement, correcting the types of those functions. +-- We intentionally clash with the names of the Prelude's class; +-- if you wish to use both in the same file, then import this module +-- (or the Prelude) qualified. +-- +-- While we're at it, we also generalize the notion of enumeration. +-- Rather than requiring that the type is linearly enumerable, we +-- distinguish between forward enumeration (which allows for multiple +-- predecessors) and backward enumeration (which allows for multiple +-- successors). Moreover, we do not require that the enumeration +-- order coincides with the 'Ord' ordering (if one exists), though +-- it's advisable that they do (for your sanity). However, we also +-- ensure that the notion of enumeration (in either direction) is +-- well-defined, which rules out instances for 'Float' and 'Double', +-- and renders instances for 'Ratio' problematic. 'Ratio' instances +-- /can/ be provided so long as the base type is enumerable (and +-- 'Integral', naturally); but they must be done in an obscure +-- order[2] that does not coincide with 'Ord', which is not what +-- people expect. +-- +-- The @MagicHash@ extension is only actually required if on GHC. +-- This extension is used only so that the implementation of the +-- instances for 'Char' match those of the Prelude's 'Prelude.Enum'. +-- I have not benchmarked to determine whether this low-level hackery +-- is actually still necessary. +-- +-- [1] +-- +-- [2] Jeremy Gibbons, David Lester, and Richard Bird (2006). +-- /Enumerating the Rationals/. JFP 16(3):281--291. +-- DOI:10.1017\/S0956796806005880 +-- +---------------------------------------------------------------- +module Prelude.SafeEnum + ( UpwardEnum(..) + , DownwardEnum(..) + , Enum(..) + ) where + +import Prelude hiding (Enum(..)) +import qualified Prelude (Enum(..)) + +#ifdef __GLASGOW_HASKELL__ +import GHC.Exts (build, Int(I#), Char(C#), ord#, chr#, (==#), (<=#), (+#), (-#), leChar#) +#else +import Data.Char (chr, ord) +#endif +---------------------------------------------------------------- +---------------------------------------------------------------- +infix 4 `precedes`, `succeeds` + + +---------------------------------------------------------------- +-- | A class for upward enumerable types. That is, we can enumerate +-- larger and larger values, eventually getting all of them. We +-- require that 'succeeds' forms a strict partial order. That is, +-- it must obey the following laws (N.B., if the first two laws +-- hold, then the third one follows for free): +-- +-- > if x `succeeds` y && y `succeeds` z then x `succeeds` z +-- > if x `succeeds` y then not (y `succeeds` x) +-- > not (x `succeeds` x) +-- +-- Moreover, we require that 'succeeds' agrees with 'succ', and +-- that 'succ' is exhaustive for 'succeeds' (assuming @Eq a@, by +-- magic if need be): +-- +-- > if succ x == Just y then y `succeeds` x +-- > if x `succeeds` y then x `elem` enumFrom y +-- +-- Minimal complete definition: 'succ', 'succeeds'. +class UpwardEnum a where + + -- | The successor of a value, or @Nothing@ is there isn't one. + -- For the numeric types in the Prelude, 'succ' adds 1. + succ :: a -> Maybe a + + -- | A variant of @('>')@ with regards to the enumeration order. + succeeds :: a -> a -> Bool + + -- converse well-founded ~ Noetherian + -- | Return @x@ followed by all it's successors, in order. The + -- resulting list is always non-empty, since it includes @x@. + -- If the resulting list is always finite, then the 'succeeds' + -- ordering is converse well-founded. In GHC, the default + -- implementation is a \"good producer\" for list fusion. + enumFrom :: a -> [a] +#ifdef __GLASGOW_HASKELL__ + {-# INLINE enumFrom #-} + enumFrom x0 = build (enumFromFB x0) + where + {-# INLINE [0] enumFromFB #-} + enumFromFB x cons nil = x `cons` + case succ x of + Nothing -> nil + Just y -> enumFromFB y cons nil +#else + enumFrom x = x : + case succ x of + Nothing -> [] + Just y -> enumFrom y +#endif + + -- | Return the elements of @'enumFrom' x@, filtering out + -- everything that succeeds @z@. If @x@ succeeds @z@, then the + -- resulting list is empty; otherwise, it is non-empty, since + -- it includes @x@. In GHC, the default implementation is a + -- \"good producer\" for list fusion. + enumFromTo :: a -> a -> [a] +#ifdef __GLASGOW_HASKELL__ + {-# INLINE enumFromTo #-} + enumFromTo x0 z0 = build (enumFromToFB x0 z0) + where + {-# INLINE [0] enumFromToFB #-} + enumFromToFB x z cons nil + | x `succeeds` z = nil + | otherwise = x `cons` + case succ x of + Nothing -> nil + Just y -> enumFromToFB y z cons nil +#else + enumFromTo x z + | x `succeeds` z = [] + | otherwise = x : + case succ x of + Nothing -> [] + Just y -> enumFromTo y z +#endif + + +---------------------------------------------------------------- +-- | A class for downward enumerable types. That is, we can enumerate +-- smaller and smaller values, eventually getting all of them. We +-- require that 'precedes' forms a strict partial order. That is, +-- it must obey the following laws (N.B., if the first two laws +-- hold, then the third one follows for free): +-- +-- > if x `precedes` y && y `precedes` z then x `precedes` z +-- > if x `precedes` y then not (y `precedes` x) +-- > not (x `precedes` x) +-- +-- Moreover, we require that 'precedes' agrees with 'pred', and +-- that 'pred' is exhaustive for 'precedes' (assuming @Eq a@, by +-- magic if need be): +-- +-- > if pred x == Just y then y `precedes` x +-- > if x `precedes` y then x `elem` enumDownFrom y +-- +-- Minimal complete definition: 'pred', 'precedes'. +class DownwardEnum a where + + -- | The predecessor of a value, or @Nothing@ is there isn't one. + -- For the numeric types in the Prelude, 'pred' subtracts 1. + pred :: a -> Maybe a + + -- | A variant of @('<')@ with regards to the enumeration order. + precedes :: a -> a -> Bool + + -- well-founded ~ Artinian + -- | Return @x@ followed by all it's predecessors, in (reverse) + -- order. The resulting list is always non-empty, since it + -- includes @x@. If the resulting list is always finite, then + -- the 'precedes' ordering is well-founded. In GHC, the default + -- implementation is a \"good producer\" for list fusion. + enumDownFrom :: a -> [a] +#ifdef __GLASGOW_HASKELL__ + {-# INLINE enumDownFrom #-} + enumDownFrom x0 = build (enumDownFromFB x0) + where + {-# INLINE [0] enumDownFromFB #-} + enumDownFromFB x cons nil = x `cons` + case pred x of + Nothing -> nil + Just y -> enumDownFromFB y cons nil +#else + enumDownFrom x = x : + case pred x of + Nothing -> [] + Just y -> enumDownFrom y +#endif + + -- | Return the elements of @'enumDownFrom' x@, filtering out + -- everything that precedes @z@. If @x@ precedes @z@, then the + -- resulting list is empty; otherwise, it is non-empty, since + -- it includes @x@. In GHC, the default implementation is a + -- \"good producer\" for list fusion. + enumDownFromTo :: a -> a -> [a] +#ifdef __GLASGOW_HASKELL__ + {-# INLINE enumDownFromTo #-} + enumDownFromTo x0 z0 = build (enumDownFromToFB x0 z0) + where + {-# INLINE [0] enumDownFromToFB #-} + enumDownFromToFB x z cons nil + | x `precedes` z = nil + | otherwise = x `cons` + case pred x of + Nothing -> nil + Just y -> enumDownFromToFB y z cons nil +#else + enumDownFromTo x z + | x `precedes` z = [] + | otherwise = x : + case pred x of + Nothing -> [] + Just y -> enumDownFromTo y z +#endif + +---------------------------------------------------------------- +-- | A class for types with a linear enumeration order. We require +-- that the partial orders of the superclasses agree: +-- +-- > x `succeeds` y == y `precedes` x +-- +-- That the enumeration order is preserved\/reflected: +-- +-- > i `succeeds` j == toEnum i `succeeds` toEnum j +-- > x `succeeds` y == fromEnum x `succeeds` fromEnum y +-- +-- And that 'toEnum' and 'fromEnum' form a weak isomorphism; i.e., +-- for some @p@ and @q@, the following must hold: +-- +-- > fromEnum <=< toEnum == (\i -> if p i then Just i else Nothing) +-- > toEnum <=< fromEnum == (\x -> if q x then Just x else Nothing) +-- +-- In other words, the following type-restricted functions form an +-- isomorphism of linear orderings. +-- +-- > toEnum' :: {i :: Int | toEnum i == Just _} -> a +-- > fromEnum' :: {x :: a | fromEnum x == Just _} -> Int +-- +-- Minimal complete definition: 'toEnum', 'fromEnum'. N.B., the +-- default definitions for 'enumFromThen' and 'enumFromThenTo' only +-- make sense when the type @a@ is \"smaller\" than 'Int' (i.e., +-- 'fromEnum' always succeeds); if 'fromEnum' ever fails, then you +-- must override the defaults in order to correctly infer the stride +-- for values which cannot be converted to 'Int'. +class (UpwardEnum a, DownwardEnum a) => Enum a where + + -- | Convert from an 'Int'. + toEnum :: Int -> Maybe a + + -- | Convert to an 'Int'. + fromEnum :: a -> Maybe Int + + + -- | Enumerate values with an inferred stride. The resulting + -- list is always non-empty, since it includes @x@. Naturally, + -- this should agree with 'enumFrom' and 'enumDownFrom' (assuming + -- @Eq a@, by magic if need be): + -- + -- > if succ x == Just y then enumFromThen x y == enumFrom x + -- > if pred x == Just y then enumFromThen x y == enumDownFrom x + -- + -- In the default implementation: if 'fromEnum' fails on either + -- argument, then the result is exactly @[x]@; and if 'toEnum' + -- fails on any of the enumerated integers, then the first + -- failure terminates the enumeration. If either of these + -- properties is inappropriate, then you should override the + -- default. In GHC, the default implementation is a \"good + -- producer\" for list fusion. + enumFromThen :: a -> a -> [a] + enumFromThen x y = + maybe [x] id $! do + x' <- fromEnum x + y' <- fromEnum y + return $! takeEnum (enumFromThen x' y') + + + -- | Enumerate values with an inferred stride and a given limit. + -- If @x@ precedes @y@ (and therefore we're enumerating forward) + -- but @x@ succeeds @z@ (and therefore is past the limit), then + -- the result is empty. Similarly, if @x@ succeeds @y@ (and + -- therefore we're enumerating backward) but @x@ precedes @z@ + -- (and therefore is past the limit), then the result is empty. + -- Otherwise the result is non-empty since it contains @x@. + -- Naturally, this should agree with 'enumFromTo' and + -- 'enumDownFromTo' (assuming @Eq a@, by magic if need be): + -- + -- > if succ x == Just y then enumFromThenTo x y z == enumFromTo x z + -- > if pred x == Just y then enumFromThenTo x y z == enumDownFromTo x z + -- + -- In the default implementation: if 'fromEnum' fails on any + -- argument, then the result is either @[]@ or @[x]@ (as + -- appropriate); and if 'toEnum' fails on any of the enumerated + -- integers, then the first failure terminates the enumeration. + -- If either of these properties is inappropriate, then you + -- should override the default. In GHC, the default implementation + -- is a \"good producer\" for list fusion. + enumFromThenTo :: a -> a -> a -> [a] + enumFromThenTo x y z + | x `precedes` y && x `succeeds` z = [] + | x `succeeds` y && x `precedes` z = [] + | otherwise = + maybe [x] id $! do + x' <- fromEnum x + y' <- fromEnum y + z' <- fromEnum z + return $! takeEnum (enumFromThenTo x' y' z') + + +-- | Convert the integers via 'toEnum', and keep taking the results +-- until the first @Nothing@. In GHC, this is both a \"good producer\" +-- and a \"good consumer\" for list fusion. +takeEnum :: Enum a => [Int] -> [a] +#ifdef __GLASGOW_HASKELL__ +{-# INLINE takeEnum #-} +takeEnum xs0 = build (\cons nil -> foldr (takeEnumCons cons nil) nil xs0) + where + {-# INLINE takeEnumCons #-} + takeEnumCons cons nil x ys = + case toEnum x of + Nothing -> nil + Just y -> y `cons` ys +#else +takeEnum [] = [] +takeEnum (x:xs) = + case toEnum x of + Nothing -> [] + Just y -> y : takeEnum xs +#endif + +---------------------------------------------------------------- +---------------------------------------------------------------- +----- Inherited instances from the Prelude + +preludeEnumDownFrom :: (DownwardEnum a, Prelude.Enum a) => a -> [a] +preludeEnumDownFrom x = + case pred x of + Nothing -> [x] + Just y -> Prelude.enumFromThen x y +{-# INLINE preludeEnumDownFrom #-} + + +preludeEnumDownFromTo :: (DownwardEnum a, Prelude.Enum a) => a -> a -> [a] +preludeEnumDownFromTo x z = + case pred x of + Nothing -> [x] + Just y -> Prelude.enumFromThenTo x y z +{-# INLINE preludeEnumDownFromTo #-} + + +instance UpwardEnum () where + succ () = Nothing + succeeds = (>) + enumFrom = Prelude.enumFrom + enumFromTo = Prelude.enumFromTo + {-# INLINE succ #-} + {-# INLINE succeeds #-} + {-# INLINE enumFrom #-} + {-# INLINE enumFromTo #-} + +instance DownwardEnum () where + pred () = Nothing + precedes = (<) + enumDownFrom = preludeEnumDownFrom + enumDownFromTo = preludeEnumDownFromTo + {-# INLINE pred #-} + {-# INLINE precedes #-} + {-# INLINE enumDownFrom #-} + {-# INLINE enumDownFromTo #-} + +instance Enum () where + toEnum i + | i == 0 = Just () + | otherwise = Nothing + fromEnum () = Just 0 + enumFromThen = Prelude.enumFromThen + enumFromThenTo = Prelude.enumFromThenTo + {-# INLINE toEnum #-} + {-# INLINE fromEnum #-} + {-# INLINE enumFromThen #-} + {-# INLINE enumFromThenTo #-} + +---------------------------------------------------------------- +instance UpwardEnum Bool where + succ False = Just True + succ True = Nothing + succeeds = (>) + enumFrom = Prelude.enumFrom + enumFromTo = Prelude.enumFromTo + {-# INLINE succ #-} + {-# INLINE succeeds #-} + {-# INLINE enumFrom #-} + {-# INLINE enumFromTo #-} + +instance DownwardEnum Bool where + pred True = Just False + pred False = Nothing + precedes = (<) + enumDownFrom = preludeEnumDownFrom + enumDownFromTo = preludeEnumDownFromTo + {-# INLINE pred #-} + {-# INLINE precedes #-} + {-# INLINE enumDownFrom #-} + {-# INLINE enumDownFromTo #-} + +instance Enum Bool where + toEnum i + | i == 0 = Just False + | i == 1 = Just True + | otherwise = Nothing + fromEnum False = Just 0 + fromEnum True = Just 1 + enumFromThen = Prelude.enumFromThen + enumFromThenTo = Prelude.enumFromThenTo + {-# INLINE toEnum #-} + {-# INLINE fromEnum #-} + {-# INLINE enumFromThen #-} + {-# INLINE enumFromThenTo #-} + +---------------------------------------------------------------- +instance UpwardEnum Ordering where + succ LT = Just EQ + succ EQ = Just GT + succ GT = Nothing + succeeds = (>) + enumFrom = Prelude.enumFrom + enumFromTo = Prelude.enumFromTo + {-# INLINE succ #-} + {-# INLINE succeeds #-} + {-# INLINE enumFrom #-} + {-# INLINE enumFromTo #-} + +instance DownwardEnum Ordering where + pred GT = Just EQ + pred EQ = Just LT + pred LT = Nothing + precedes = (<) + enumDownFrom = preludeEnumDownFrom + enumDownFromTo = preludeEnumDownFromTo + {-# INLINE pred #-} + {-# INLINE precedes #-} + {-# INLINE enumDownFrom #-} + {-# INLINE enumDownFromTo #-} + +instance Enum Ordering where + toEnum i + | i == 0 = Just LT + | i == 1 = Just EQ + | i == 2 = Just GT + | otherwise = Nothing + fromEnum LT = Just 0 + fromEnum EQ = Just 1 + fromEnum GT = Just 2 + enumFromThen = Prelude.enumFromThen + enumFromThenTo = Prelude.enumFromThenTo + {-# INLINE toEnum #-} + {-# INLINE fromEnum #-} + {-# INLINE enumFromThen #-} + {-# INLINE enumFromThenTo #-} + +---------------------------------------------------------------- +instance UpwardEnum Char where +#ifdef __GLASGOW_HASKELL__ + succ (C# c#) + | not (ord# c# ==# 0x10FFFF#) = Just $! C# (chr# (ord# c# +# 1#)) + | otherwise = Nothing +#else + succ c + | not (ord c == 0x10FFFF) = Just $! chr (ord c + 1) + | otherwise = Nothing +#endif + succeeds = (>) + enumFrom = Prelude.enumFrom + enumFromTo = Prelude.enumFromTo + {-# INLINE succ #-} + {-# INLINE succeeds #-} + {-# INLINE enumFrom #-} + {-# INLINE enumFromTo #-} + +instance DownwardEnum Char where +#ifdef __GLASGOW_HASKELL__ + pred (C# c#) + | not (ord# c# ==# 0#) = Just $! C# (chr# (ord# c# -# 1#)) + | otherwise = Nothing +#else + pred c + | not (ord c == 0) = Just $! chr (ord c - 1) + | otherwise = Nothing +#endif + precedes = (<) + enumDownFrom = preludeEnumDownFrom + enumDownFromTo = preludeEnumDownFromTo + {-# INLINE pred #-} + {-# INLINE precedes #-} + {-# INLINE enumDownFrom #-} + {-# INLINE enumDownFromTo #-} + +instance Enum Char where +#ifdef __GLASGOW_HASKELL__ + toEnum (I# i#) + | 0# <=# i# && i# <=# 0x10FFFF# = Just $! C# (chr# i#) + | otherwise = Nothing + fromEnum (C# c#) + | leChar# (chr# 0#) c# + && leChar# c# (chr# 0x10FFFF#) = Just $! I# (ord# c#) + | otherwise = Nothing +#else + toEnum i + | 0 <= i && i <= 0x10FFFF = Just $! chr i + | otherwise = Nothing + fromEnum c + | chr 0 <= c && c <= chr 0x10FFFF = Just $! ord c + | otherwise = Nothing +#endif + enumFromThen = Prelude.enumFromThen + enumFromThenTo = Prelude.enumFromThenTo + {-# INLINE toEnum #-} + {-# INLINE fromEnum #-} + {-# INLINE enumFromThen #-} + {-# INLINE enumFromThenTo #-} + +---------------------------------------------------------------- +instance UpwardEnum Int where + succ x + | x == maxBound = Nothing + | otherwise = Just $! x + 1 + succeeds = (>) + enumFrom = Prelude.enumFrom + enumFromTo = Prelude.enumFromTo + {-# INLINE succ #-} + {-# INLINE succeeds #-} + {-# INLINE enumFrom #-} + {-# INLINE enumFromTo #-} + +instance DownwardEnum Int where + pred x + | x == minBound = Nothing + | otherwise = Just $! x - 1 + precedes = (<) + enumDownFrom = preludeEnumDownFrom + enumDownFromTo = preludeEnumDownFromTo + {-# INLINE pred #-} + {-# INLINE precedes #-} + {-# INLINE enumDownFrom #-} + {-# INLINE enumDownFromTo #-} + +instance Enum Int where + toEnum = Just + fromEnum = Just + enumFromThen = Prelude.enumFromThen + enumFromThenTo = Prelude.enumFromThenTo + {-# INLINE toEnum #-} + {-# INLINE fromEnum #-} + {-# INLINE enumFromThen #-} + {-# INLINE enumFromThenTo #-} + +---------------------------------------------------------------- +-- TODO: instances for Int8, Int16, Int32, Int64 + +---------------------------------------------------------------- +-- TODO: instances for Word, Word8, Word16, Word32, Word64 + +---------------------------------------------------------------- +instance UpwardEnum Integer where + succ n = Just $! n + 1 + succeeds = (>) + enumFrom = Prelude.enumFrom + enumFromTo = Prelude.enumFromTo + {-# INLINE succ #-} + {-# INLINE succeeds #-} + {-# INLINE enumFrom #-} + {-# INLINE enumFromTo #-} + +instance DownwardEnum Integer where + pred n = Just $! n - 1 + precedes = (<) + enumDownFrom = preludeEnumDownFrom + enumDownFromTo = preludeEnumDownFromTo + {-# INLINE pred #-} + {-# INLINE precedes #-} + {-# INLINE enumDownFrom #-} + {-# INLINE enumDownFromTo #-} + +instance Enum Integer where + toEnum n = Just $! Prelude.toEnum n + fromEnum n + | min_ <= n && n <= max_ = Just $! Prelude.fromEnum n + | otherwise = Nothing + where + min_ = fromIntegral (minBound :: Int) + max_ = fromIntegral (maxBound :: Int) + enumFromThen = Prelude.enumFromThen + enumFromThenTo = Prelude.enumFromThenTo + {-# INLINE toEnum #-} + {-# INLINE fromEnum #-} + {-# INLINE enumFromThen #-} + {-# INLINE enumFromThenTo #-} + +---------------------------------------------------------------- +{- +-- The 'succ'\/'pred' functions are not complete for 'succeeds'\/'precedes' + +instance UpwardEnum Float where + succ n = Just $! n + 1 + succeeds = (>) + enumFrom = Prelude.enumFrom + enumFromTo = Prelude.enumFromTo + {-# INLINE succ #-} + {-# INLINE succeeds #-} + {-# INLINE enumFrom #-} + {-# INLINE enumFromTo #-} + +instance DownwardEnum Float where + pred n = Just $! n - 1 + precedes = (<) + enumDownFrom = preludeEnumDownFrom + enumDownFromTo = preludeEnumDownFromTo + {-# INLINE pred #-} + {-# INLINE precedes #-} + {-# INLINE enumDownFrom #-} + {-# INLINE enumDownFromTo #-} + +instance Enum Float where + toEnum n = Just $! Prelude.toEnum n -- Does int2Float ever error? + fromEnum n = Just $! Prelude.fromEnum n -- Does fromInteger . truncate? + enumFromThen = Prelude.enumFromThen + enumFromThenTo = Prelude.enumFromThenTo + {-# INLINE toEnum #-} + {-# INLINE fromEnum #-} + {-# INLINE enumFromThen #-} + {-# INLINE enumFromThenTo #-} + +---------------------------------------------------------------- +instance UpwardEnum Double where + succ n = Just $! n + 1 + succeeds = (>) + enumFrom = Prelude.enumFrom + enumFromTo = Prelude.enumFromTo + {-# INLINE succ #-} + {-# INLINE succeeds #-} + {-# INLINE enumFrom #-} + {-# INLINE enumFromTo #-} + +instance DownwardEnum Double where + pred n = Just $! n - 1 + precedes = (<) + enumDownFrom = preludeEnumDownFrom + enumDownFromTo = preludeEnumDownFromTo + {-# INLINE pred #-} + {-# INLINE precedes #-} + {-# INLINE enumDownFrom #-} + {-# INLINE enumDownFromTo #-} + +instance Enum Double where + toEnum n = Just $! Prelude.toEnum n -- Does int2Double ever error? + fromEnum n = Just $! Prelude.fromEnum n -- Does fromInteger . truncate? + enumFromThen = Prelude.enumFromThen + enumFromThenTo = Prelude.enumFromThenTo + {-# INLINE toEnum #-} + {-# INLINE fromEnum #-} + {-# INLINE enumFromThen #-} + {-# INLINE enumFromThenTo #-} +-} + + +---------------------------------------------------------------- +-- TODO: the following (as appropriate) +{- +instance Enum (Data.Fixed.Fixed a) + +instance Enum System.IO.IOMode +instance Enum GHC.IO.Device.SeekMode +instance Enum Foreign.C.Types.CUIntMax +instance Enum Foreign.C.Types.CIntMax +instance Enum Foreign.C.Types.CUIntPtr +instance Enum Foreign.C.Types.CIntPtr +instance Enum Foreign.C.Types.CSUSeconds +instance Enum Foreign.C.Types.CUSeconds +instance Enum Foreign.C.Types.CTime +instance Enum Foreign.C.Types.CClock +instance Enum Foreign.C.Types.CSigAtomic +instance Enum Foreign.C.Types.CWchar +instance Enum Foreign.C.Types.CSize +instance Enum Foreign.C.Types.CPtrdiff +instance Enum Foreign.C.Types.CDouble +instance Enum Foreign.C.Types.CFloat +instance Enum Foreign.C.Types.CULLong +instance Enum Foreign.C.Types.CLLong +instance Enum Foreign.C.Types.CULong +instance Enum Foreign.C.Types.CLong +instance Enum Foreign.C.Types.CUInt +instance Enum Foreign.C.Types.CInt +instance Enum Foreign.C.Types.CUShort +instance Enum Foreign.C.Types.CShort +instance Enum Foreign.C.Types.CUChar +instance Enum Foreign.C.Types.CSChar +instance Enum Foreign.C.Types.CChar +instance Enum Data.Char.GeneralCategory +instance Enum Foreign.Ptr.IntPtr +instance Enum Foreign.Ptr.WordPtr +instance Enum System.Posix.Types.Fd +instance Enum System.Posix.Types.CRLim +instance Enum System.Posix.Types.CTcflag +instance Enum System.Posix.Types.CSpeed +instance Enum System.Posix.Types.CCc +instance Enum System.Posix.Types.CUid +instance Enum System.Posix.Types.CNlink +instance Enum System.Posix.Types.CGid +instance Enum System.Posix.Types.CSsize +instance Enum System.Posix.Types.CPid +instance Enum System.Posix.Types.COff +instance Enum System.Posix.Types.CMode +instance Enum System.Posix.Types.CIno +instance Enum System.Posix.Types.CDev +-} + +---------------------------------------------------------------- +----------------------------------------------------------- fin.