Prelude

module Prelude (
    module PreludeList, module PreludeText, module PreludeIO,
    Integer,module Prelude{-
    Bool(False, True),
    Maybe(Nothing, Just),
    Either(Left, Right),
    Ordering(LT, EQ, GT),
    Char, String, Int, Integer, Float, Double, Rational, IO,

--      These built-in types are defined in the Prelude, but
--      are denoted by built-in syntax, and cannot legally
--      appear in an export list.
--  List type:
     []((:), [])
--  Tuple types: (,), (,,), etc.
--  Trivial type: ()
--  Functions: (->)

    Eq((==), (/=)),
    Ord(compare, (<), (<=), (>=), (>), max, min),
    Enum(succ, pred, toEnum, fromEnum, enumFrom, enumFromThen,
         enumFromTo, enumFromThenTo),
    Bounded(minBound, maxBound),
    Num((+), (-), (*), negate, abs, signum, fromInteger),
    Real(toRational),
    Integral(quot, rem, div, mod, quotRem, divMod, toInteger),
    Fractional((/), recip, fromRational),
    Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan,
             asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh),
    RealFrac(properFraction, truncate, round, ceiling, floor),
    RealFloat(floatRadix, floatDigits, floatRange, decodeFloat,
              encodeFloat, exponent, significand, scaleFloat, isNaN,
              isInfinite, isDenormalized, isIEEE, isNegativeZero, atan2),
    Monad((>>=), (>>), return, fail),
    Functor(fmap),
    mapM, mapM_, sequence, sequence_, (=<<),
    maybe, either,
    (&&), (||), not, otherwise,
    subtract, even, odd, gcd, lcm, (^), (^^),
    fromIntegral, realToFrac,
    fst, snd, curry, uncurry, id, const, (.), flip, ($), until,
    asTypeOf, error, undefined,
    seq, ($!)-}
  ) where

import PreludeBuiltin  -- Contains all `prim' values
import qualified Builtin
import PreludeList
import PreludeText
import PreludeInteger(Integer,intFromInteger,integerFromInt,doubleFromInteger)
import PreludeIO(FilePath, IO, IOError, ioError, userError, catch,
		 putChar, putStr, putStrLn, print,
		 getChar, getLine, getContents, interact,
		 readFile, writeFile, appendFile, readIO, readLn)
import Ratio( Ratio, numerator, denominator, (%), doubleFromRational )
import Ix

type Rational =  Ratio Integer -- the type checker refers to Prelude.Rational!!!
type RatioInt =  Ratio Int

infixr 9  .
infixr 8  ^, ^^, **
infixl 7  *, /, `quot`, `rem`, `div`, `mod`
infixl 6  +, -

-- The (:) operator is built-in syntax, and cannot legally be given
-- a fixity declaration; but its fixity is given by:
infixr 5  :

infix  4  ==, /=, <, <=, >=, >
infixr 3  &&
infixr 2  ||
infixl 1  >>, >>=
infixr 1  =<<
infixr 0  $, $!, `seq`

-- * Standard types, classes, instances and related functions

-- ** Equality and Ordered classes

class  Eq a  where
    (==), (/=)       :: a -> a -> Bool
  --eqList           :: [a] -> [a] -> Bool

        -- Minimal complete definition:
        --      (==) or (/=)
    x /= y           =  not (x == y)
    x == y           =  not (x /= y)
  --eqList xs ys     = eqList' (==) xs ys

class  Eq a => Ord a  where
    compare              :: a -> a -> Ordering
    (<), (<=), (>=), (>) :: a -> a -> Bool
    max, min             :: a -> a -> a
--  compareList          :: [a] -> [a] -> Ordering

        -- Minimal complete definition:
        --      (<=) or compare
        -- Using compare can be more efficient for complex types.
    compare x y
         | x == y    =  EQ
         | x <= y    =  LT
         | otherwise =  GT

--  compareList = compareList' compare

    x <= y           =  compare x y /= GT
    x <  y           =  compare x y == LT
    x >= y           =  compare x y /= LT
    x >  y           =  compare x y == GT

-- note that (min x y, max x y) = (x,y) or (y,x)
    max x y
         | x <= y    =  y
         | otherwise =  x
    min x y
         | x <= y    =  x
         | otherwise =  y

compareList xs ys =
  case xs of
    x:xs -> case ys of
              y:ys -> case compare x y of
                        EQ -> compareList xs ys
                        LT -> LT
                        GT -> GT
              _ -> GT
    _    -> case ys of
              [] -> EQ
              _  -> LT

-- ** Enumeration and Bounded classes

class  Enum a  where
    succ, pred       :: a -> a
    toEnum           :: Int -> a
    fromEnum         :: a -> Int
    enumFrom         :: a -> [a]             -- [n..]
    enumFromThen     :: a -> a -> [a]        -- [n,n'..]
    enumFromTo       :: a -> a -> [a]        -- [n..m]
    enumFromThenTo   :: a -> a -> a -> [a]   -- [n,n'..m]

        -- Minimal complete definition:
        --      toEnum, fromEnum
--
-- NOTE: these default methods only make sense for types
--   that map injectively into Int using fromEnum
--  and toEnum.
-- (Obviously leads to circular definitions if used in instance Enum Int)
    succ             =  toEnum . (+1) . fromEnum
    pred             =  toEnum . (subtract 1) . fromEnum
    enumFrom x       =  map toEnum [fromEnum x ..]
    enumFromTo x y   =  map toEnum [fromEnum x .. fromEnum y]
    enumFromThen x y =  map toEnum [fromEnum x, fromEnum y ..]
    enumFromThenTo x y z =
                        map toEnum [fromEnum x, fromEnum y .. fromEnum z]

class  Bounded a  where
    minBound         :: a
    maxBound         :: a

-- ** Numeric classes

class  {-(Eq a, Show a) =>-} Num a  where
    (+), (-), (*)    :: a -> a -> a
    negate           :: a -> a
    abs, signum      :: a -> a
    fromInteger      :: Integer -> a
--  fromInt          :: Int -> a -- non-standard

        -- Minimal complete definition:
        --      All, except negate or (-)
    x - y            =  x + negate y
    negate x         =  0 - x

--  fromInt = fromInteger . integerFromInt

class  (Num a, Ord a) => Real a  where
    toRational       ::  a -> Rational

class  (Real a, Enum a) => Integral a  where
    quot, rem        :: a -> a -> a
    div, mod         :: a -> a -> a
    quotRem, divMod  :: a -> a -> (a,a)
    toInteger        :: a -> Integer

        -- Minimal complete definition:
        --      quotRem, toInteger
    n `quot` d       =  fst (quotRem n d)
    n `rem` d        =  snd (quotRem n d)

    n `div` d        =  if signum r == - signum d then q-1 else q
      where
        q = n `quot` d
        r = n `rem` d

    n `mod` d        =  if signum r == - signum d then r+d else r
      where
        q = n `quot` d
        r = n `rem` d

    divMod n d       =  if signum r == - signum d then (q-1, r+d) else (q,r)
      where
        q = n `quot` d
        r = n `rem` d

class  (Num a) => Fractional a  where
    (/)              :: a -> a -> a
    recip            :: a -> a
    fromRational     :: Rational -> a
--  fromIntRat       :: Ratio Int -> a   -- not in Haskell 98

        -- Minimal complete definition:
        --      fromRational and (recip or (/))
    recip x          =  1 / x
    x / y            =  x * recip y

--  fromIntRat r = fromRational (integerFromInt (numerator r) %
--                               integerFromInt (denominator r))

 
class  (Fractional a) => Floating a  where
    pi                  :: a
    exp, log, sqrt      :: a -> a
    (**), logBase       :: a -> a -> a
    sin, cos, tan       :: a -> a
    asin, acos, atan    :: a -> a
    sinh, cosh, tanh    :: a -> a
    asinh, acosh, atanh :: a -> a

        -- Minimal complete definition:
        --      pi, exp, log, sin, cos, sinh, cosh
        --      asin, acos, atan
        --      asinh, acosh, atanh
    x ** y           =  exp (log x * y)
    logBase x y      =  log y / log x
    sqrt x           =  x ** 0.5
    tan  x           =  sin  x / cos  x
    tanh x           =  sinh x / cosh x

class  (Real a, Fractional a) => RealFrac a  where
    properFraction   :: (Integral b) => a -> (b,a)
    truncate, round  :: (Integral b) => a -> b
    ceiling, floor   :: (Integral b) => a -> b

        -- Minimal complete definition:
        --      properFraction
    truncate x       =  m  where (m,_) = properFraction x

    round x          =  let (n,r) = properFraction x
                            m     = if r < 0 then n - 1 else n + 1
                          in case signum (abs r - 0.5) of
                                -1 -> n
                                0  -> if even n then n else m
                                1  -> m

    ceiling x        =  if r > 0 then n + 1 else n
                        where (n,r) = properFraction x

    floor x          =  if r < 0 then n - 1 else n
                        where (n,r) = properFraction x

class  (RealFrac a, Floating a) => RealFloat a  where
    floatRadix       :: a -> Integer
    floatDigits      :: a -> Int
    floatRange       :: a -> (Int,Int)
    decodeFloat      :: a -> (Integer,Int)
    encodeFloat      :: Integer -> Int -> a
    exponent         :: a -> Int
    significand      :: a -> a
    scaleFloat       :: Int -> a -> a
    isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE
                     :: a -> Bool
    atan2            :: a -> a -> a

        -- Minimal complete definition:
        --      All except exponent, significand,
        --                 scaleFloat, atan2
    exponent x       =  if m == 0 then 0 else n + floatDigits x
                        where (m,n) = decodeFloat x

    significand x    =  encodeFloat m (- floatDigits x)
                        where (m,_) = decodeFloat x

    scaleFloat k x   =  encodeFloat m (n+k)
                        where (m,n) = decodeFloat x

    atan2 y x
      | x>0           =  atan (y/x)
      | x==0 && y>0   =  pi/2
      | x<0  && y>0   =  pi + atan (y/x)
      |(x<=0 && y<0)  ||
       (x<0 && isNegativeZero y) ||
       (isNegativeZero x && isNegativeZero y)
                      = -atan2 (-y) x
      | y==0 && (x<0 || isNegativeZero x)
                      =  pi    -- must be after the previous test on zero y
      | x==0 && y==0  =  y     -- must be after the other double zero tests
      | otherwise     =  x + y -- x or y is a NaN, return a NaN (via +)

-- ** Numeric functions

subtract         :: Num a => a -> a -> a
--subtract         =  flip (-)
subtract x y       = y - x

even, odd        :: Integral a => a -> Bool
even n           =  n `rem` 2 == 0
odd n            =  n `rem` 2 == 1

gcd              :: Integral a => a -> a -> a
gcd 0 0          =  error "Prelude.gcd: gcd 0 0 is undefined"
gcd x y          =  gcd' (abs x) (abs y)
                    where gcd' x 0  =  x
                          gcd' x y  =  gcd' y (x `rem` y)

lcm              :: Integral a => a -> a -> a
lcm _ 0          =  0
lcm 0 _          =  0
lcm x y          =  abs ((x `quot` (gcd x y)) * y)

(^)              :: (Num a, Integral b) => a -> b -> a
x ^ 0            =  1
x ^ n | n > 0    =  f x (n-1) x
                    where f _ 0 y = y
                          f x n y = g x n  where
                                    g x n | even n  = g (x*x) (n `quot` 2)
                                          | otherwise = f x (n-1) (x*y)
_ ^ _            = error "Prelude.^: negative exponent"

(^^)             :: (Fractional a, Integral b) => a -> b -> a
x ^^ n           =  if n >= 0 then x^n else recip (x^(-n))

fromIntegral     :: (Integral a, Num b) => a -> b
fromIntegral     =  fromInteger . toInteger

realToFrac     :: (Real a, Fractional b) => a -> b
realToFrac      =  fromRational . toRational

-- ** Monadic classes

infixl 4 <$>, <$

class  Functor f  where
    fmap              :: (a -> b) -> f a -> f b

    -- | Replace the value.
    (<$) :: a -> f b -> f a
    (<$) = fmap . const

-- | A synonym for 'fmap'.
(<$>) :: Functor f => (a -> b) -> f a -> f b
f <$> a = fmap f a

class  Functor m => Monad m  where
    (>>=)  :: m a -> (a -> m b) -> m b
    (>>)   :: m a -> m b -> m b
    return :: a -> m a
    fail   :: String -> m a

        -- Minimal complete definition:
        --      (>>=), return
    m >> k   =  m >>= \ x -> k
    fail s   =  error s

sequence       :: Monad m => [m a] -> m [a]
sequence       =  foldr mcons (return [])
                    where mcons p q = p >>= \x -> q >>= \y -> return (x:y)

sequence_      :: Monad m => [m a] -> m ()
sequence_      =  foldr (>>) (return ())

-- The xxxM functions take list arguments, but lift the function or
-- list element to a monad type

mapM             :: Monad m => (a -> m b) -> [a] -> m [b]
mapM f []        =  return []
mapM f (x:xs)    =  do y<-f x; (y:) <$> mapM f xs

mapM_            :: Monad m => (a -> m b) -> [a] -> m ()
mapM_ f []       =  return ()
mapM_ f (x:xs)   =  f x >> mapM_ f xs

(=<<)            :: Monad m => (a -> m b) -> m a -> m b
f =<< x          =  x >>= f

-- * Trivial type

data  ()  =  ()  deriving (Eq, Ord, Enum, Bounded, Ix)

-- * Function type

--data a -> b  -- No constructor for functions is exported.
data (->) a b

-- | Identity function
id               :: a -> a
id x             =  x

-- | Constant function
const            :: a -> b -> a
const x _        =  x

-- | Function composition
(.)              :: (b -> c) -> (a -> b) -> a -> c
f . g            =  \ x -> f (g x)

-- | flip f  takes its (first) two arguments in the reverse order of f.
flip             :: (a -> b -> c) -> b -> a -> c
flip f x y       =  f y x

seq = primSeq

-- right-associating infix application operators
-- (useful in continuation-passing style)

($), ($!) :: (a -> b) -> a -> b
f $  x    =  f x
f $! x    =  x `seq` f x

-- * Boolean type

data  Bool  =  False | True    deriving (Eq, Ord, Enum, Read, Show, Bounded, Ix)

-- ** Boolean functions

{-# INLINE &&, || #-}
(&&), (||)       :: Bool -> Bool -> Bool
True  && x       =  x
_     && _       =  False
True  || _       =  True
_     || x       =  x


not              :: Bool -> Bool
not True         =  False
not _            =  True

otherwise        :: Bool
otherwise        =  True

-- * Character type

data Char -- = ... 'a' | 'b' ... -- 2^16 unicode values

instance  Eq Char  where
--  c == c'          =  fromEnum c == fromEnum c'
--  c /= c'          =  fromEnum c /= fromEnum c'
    (==) = primCharEq
    c/=c' = not (primCharEq c c')
{-
    eqList = eqString

eqString s1 s2 =
  case s1 of
    c1:s1 -> case s2 of
              c2:s2 | primCharEq c1 c2 -> eqString s1 s2
              _ -> False
    _     -> case s2 of
               [] -> True
               _  -> False
-}
instance  Ord Char  where
    compare         =  compareChar
    c <= c'         =  primCharLte c c'
    c >= c'         =  primCharLte c' c
    c < c'          =  not (primCharLte c' c)
    c > c'          =  not (primCharLte c c')
--  compareList = compareString


compareChar c c' = compareInt (primCharToInt c) (primCharToInt c')

{-
compareChar c1 c2 =
  case primIntSignum (primIntSub (primCharToInt c1) (primCharToInt c2)) of
    -1 -> LT
    0 -> EQ
    1 -> GT

compareString s1 s2 =
  case s1 of
    x:xs -> case s2 of
              y:ys -> lexOrder (compareChar x y) (compareString xs ys)
              _ -> GT
    _    -> case s2 of
              [] -> EQ
              _  -> LT
-}
instance  Enum Char  where
    toEnum            = primIntToChar
    fromEnum          = primCharToInt
    enumFrom c        = map toEnum [fromEnum c .. fromEnum (maxBound::Char)]
    enumFromThen c c' = map toEnum [fromEnum c, fromEnum c' .. fromEnum lastChar]
                      where lastChar :: Char
                            lastChar | c' < c    = minBound
                                     | otherwise = maxBound

instance  Bounded Char  where
    minBound            =  '\0'
    maxBound            =  primUnicodeMaxChar

type  String = [Char]

-- * Maybe type

data  Maybe a  =  Nothing | Just a      deriving (Eq, Ord, Read, Show)

maybe              :: b -> (a -> b) -> Maybe a -> b
maybe n f Nothing  =  n
maybe n f (Just x) =  f x

instance  Functor Maybe  where
    fmap f Nothing    =  Nothing
    fmap f (Just x)   =  Just (f x)


instance  Monad Maybe  where
    (Just x) >>= k   =  k x
    Nothing  >>= k   =  Nothing
    return           =  Just
    fail s           =  Nothing

-- * Either type

data  Either a b  =  Left a | Right b   deriving (Eq, Ord, Read, Show)

either               :: (a -> c) -> (b -> c) -> Either a b -> c
either f g (Left x)  =  f x
either f g (Right y) =  g y

instance Functor (Either e) where
  fmap f (Right x) = Right (f x)
  fmap f (Left e)  = Left e

-- * IO type
{- -- Defined in PreludeIO
data  IO a -- abstract

instance  Functor IO where
   fmap f x           =  x >>= (return . f)

instance Monad IO where
   (>>=)  = undefined -- ...
   return = undefined -- ...
   fail s = ioError (userError s)
-}
-- * Ordering type

data  Ordering  =  LT | EQ | GT
          deriving (Eq, Ord, Enum, Read, Show, Bounded, Ix)
--instance Eq Ordering

-- | For use in derived Ord instances:
lexOrder EQ o = o
lexOrder o  _ = o

-- * Standard numeric types.  The data declarations for these types cannot
-- be expressed directly in Haskell since the constructor lists would be
-- far too large.

data  Int  -- =  minBound ... -1 | 0 | 1 ... maxBound

instance  Eq       Int  where (==) = primIntEq; x/=y = not (primIntEq x y)

instance  Ord      Int  where
  compare = compareInt
  (<=) = primIntLte
  x>=y = primIntLte y x
  x>y = not (primIntLte x y)
  x<y = not (primIntLte y x)

instance  Num      Int  where
  (+) = primIntAdd; (-) = primIntSub; (*) = primIntMul
  negate = primIntNegate
  abs = primIntAbs
  signum = primIntSignum
--signum x = fromEnum (x>0) - fromEnum (x<0)
  fromInteger = intFromInteger
--fromInt = id

compareInt x y = toEnum (signum (x-y)+1) :: Ordering
{-
compareInt x y = if primIntLte x y
                 then if primIntEq x y
                      then EQ
                      else LT
                 else GT
--}
instance  Real     Int  where toRational n = toInteger n % 1

instance  Integral Int  where
   toInteger = integerFromInt
   n `quotRem` d = (n `primIntQuot` d,n `primIntRem` d)
   rem = primIntRem
   quot = primIntQuot
   
instance  Enum     Int  where
    toEnum = id
    fromEnum = id
  
    succ x = x+1
    pred x = x-1

    enumFrom x = enumFromTo x maxBound
    enumFromThen x y = enumFromThenTo x y (if x<=y then maxBound else minBound)
    enumFromTo = genericEnumFromTo
    enumFromThenTo x y z = enumFromStepTo x (y-x) z

genericEnumFromTo x y = if x<=y then x:genericEnumFromTo (succ x) y else []

enumFromStepTo x d y = case compare d 0 of
                         LT -> enumDownFromStepTo x d y
                         EQ -> repeat x
                         GT -> enumUpFromStepTo x d y

enumUpFromStepTo   x d y = if x<=y then x:enumUpFromStepTo   (x+d) d y else []
enumDownFromStepTo x d y = if x>=y then x:enumDownFromStepTo (x+d) d y else []

instance  Bounded  Int  where
    minBound = primIntMinBound
    maxBound = primIntMaxBound

--data  Integer  -- =  ... -1 | 0 | 1 ...

{-
instance  Eq       Integer  where (==) = primIntegerEq
instance  Ord      Integer  where (<=) = primIntegerLte
instance  Num      Integer  where
  (+) = primIntegerAdd; (-) = primIntegerSub; (*) = primIntegerMul
  negate = primIntegerNegate; abs = primIntegerAbs; signum = primIntegerSignum
  fromInteger = id

instance  Enum     Integer  where
  succ x = x+1
  pred x = x-1

  toEnum = primInt2Integer
  fromEnum = fromInteger

  enumFrom x = x:enumFrom (succ x)
  enumFromThen x y = enumFromStep x (y-x)
  enumFromTo = genericEnumFromTo
  enumFromThenTo x y z = enumFromStepTo x (y-x) z
-}
enumFromStep x d = x:enumFromStep (x+d) d
{-
instance  Real     Integer  --where ...
instance  Integral Integer  where
   toInteger = id
   n `quotRem` d = (n `primIntegerQuot` d,n `primIntegerRem` d)
-}
newtype  Float = Float Double

instance  Eq         Float  where Float x==Float y = x==y
instance  Ord        Float  where Float x<=Float y = x<=y
instance  Num        Float  where
  (+) = float2 (+)
  (-) = float2 (-)
  (*) = float2 (*)
  negate = float1 negate
  abs = float1 abs
  signum = float1 signum
  fromInteger = Float . fromInteger

float2 f (Float x) (Float y) = Float (f x y)
float1 f (Float x) = Float (f x)


instance  Real       Float  --where ...
instance  Fractional Float  where
  fromRational r = Float (fromRational r)
  (/) = float2 (/)
  
instance  Floating   Float  --where ...

instance  RealFrac   Float  where
  properFraction (Float x) = (i,Float r) where (i,r) = properFraction x
  truncate (Float x) = truncate x
  round (Float x) = round x
  ceiling (Float x) = ceiling x
  floor (Float x) = floor x
  
--instance  RealFloat  Float  --where ...

data  Double

instance  Eq         Double  where (==) = primDoubleEq

instance  Ord        Double  where
  (<=) = primDoubleLte
  x>=y = primDoubleLte y x
  x>y  = not (x<=y)
  x<y  = not (y<=x)

instance  Num        Double  where
  (+) = primDoubleAdd; (-) = primDoubleSub; (*) = primDoubleMul
  negate = primDoubleNegate; abs = primDoubleAbs;
  signum = primDoubleSignum
  fromInteger = doubleFromInteger
--fromInt = Builtin.intToFloat

instance  Real       Double  --where ...
instance  Fractional Double  where
  (/) = primDoubleDiv
  fromRational = doubleFromRational
--fromIntRat = doubleFromIntRat

instance  Floating   Double  where
  pi = 3.141592653589793
  exp = primDoubleExp
  log = primDoubleLog
  sin = primDoubleSin
  cos = primDoubleCos
  tan = primDoubleTan
  -- ...

--{-
instance  RealFrac   Double where
  properFraction x = (primIntegralFromDouble t,t-x) -- hmm
    where t = primDoubleTrunc x
  truncate = primIntegralFromDouble . primDoubleTrunc
  round = primIntegralFromDouble . primDoubleRound
  ceiling = primIntegralFromDouble . primDoubleCeil
  floor = primIntegralFromDouble . primDoubleFloor
--}

instance  RealFloat  Double  where
    floatRadix _ = 2
    floatDigits _ = 53
    floatRange _ = (-1021,1024)
--  encodeFloat = primDoubleEncodeFloat
    encodeFloat m n = doubleFromInteger m * 2^^n
    --http://www.altocumulus.org/haskell98-report-html/basic.html#sect6.4.6
    decodeFloat x = (truncate (x*2^^e),-e)
      where e = floatDigits x-ceiling (primDoubleLog2 x)
    scaleFloat k x = x*2^^k
    isNaN _ = False -- !!!
    isInfinite _ = False -- !!!
    isNegativeZero _ = False -- !!!


instance  RealFloat  Float  where -- !!!
    floatRadix _ = 2
    floatDigits _ = 24
    floatRange _ = (-125,128)
--  encodeFloat = primDoubleEncodeFloat
    encodeFloat m n = Float (doubleFromInteger m * 2^^n)
    --http://www.altocumulus.org/haskell98-report-html/basic.html#sect6.4.6
    decodeFloat (Float x) = (truncate (x*2^^e),-e)
      where e = floatDigits x-ceiling (primDoubleLog2 x)
    scaleFloat k x = x*2^^k
    isNaN _ = False -- !!!
    isInfinite _ = False -- !!!
    isNegativeZero _ = False -- !!!

-- The Enum instances for Floats and Doubles are slightly unusual.
-- The `toEnum' function truncates numbers to Int.  The definitions
-- of enumFrom and enumFromThen allow floats to be used in arithmetic
-- series: [0,0.1 .. 0.95].  However, roundoff errors make these somewhat
-- dubious.  This example may have either 10 or 11 elements, depending on
-- how 0.1 is represented.

instance  Enum Float  where
    succ x           =  x+1
    pred x           =  x-1
    toEnum           =  fromIntegral
    fromEnum         =  fromInteger . truncate   -- may overflow
    enumFrom         =  numericEnumFrom
    enumFromThen     =  numericEnumFromThen
    enumFromTo       =  numericEnumFromTo
    enumFromThenTo   =  numericEnumFromThenTo

instance  Enum Double  where
    succ x           =  x+1
    pred x           =  x-1
    toEnum           =  fromIntegral
    fromEnum         =  fromInteger . truncate   -- may overflow
    enumFrom         =  numericEnumFrom
    enumFromThen     =  numericEnumFromThen
    enumFromTo       =  numericEnumFromTo
    enumFromThenTo   =  numericEnumFromThenTo


numericEnumFrom         :: (Fractional a) => a -> [a]
numericEnumFromThen     :: (Fractional a) => a -> a -> [a]
numericEnumFromTo       :: (Fractional a, Ord a) => a -> a -> [a]
numericEnumFromThenTo   :: (Fractional a, Ord a) => a -> a -> a -> [a]

numericEnumFrom         =  iterate (+1)
numericEnumFromThen n m =  iterate (+(m-n)) n
numericEnumFromTo n m   =  takeWhile (<= m+1/2) (numericEnumFrom n)
numericEnumFromThenTo n n' m = takeWhile p (numericEnumFromThen n n')
                             where
                               p | n' > n    = (<= m + (n'-n)/2)
                                 | otherwise = (>= m + (n'-n)/2)

-- * Lists

-- | This data declaration is not legal Haskell but it indicates the idea
data [a] =  [] | a : [a]

instance Eq a => Eq [a] where
  (==) = eqList
  xs/=ys = not (eqList xs ys)
--eqList xs ys = eqList' eqList xs ys

eqList xs ys =
  case xs of
    x:xs -> case ys of
              y:ys | x==y -> eqList xs ys
              _ -> False
    _    -> case ys of
              [] -> True
              _ -> False

instance Ord a => Ord [a] where
  compare = compareList

instance Functor [] where
    fmap = map

instance  Monad []  where
    m >>= k          = concatMap k m
    return x         = [x]
    fail s           = []

-- * Tuples (supported upto size 15, as required by the Haskell 98 report)

data  (a,b)
   =  (,) a b
   deriving (Eq, Ord, Bounded, Ix) -- Show/Read in PreludeText (Ix was in Ix)
data  (a,b,c)
   =  (,,) a b c
   deriving (Eq, Ord, Bounded, Ix) -- Show/Read in PreludeText
data  (a,b,c,d)
   =  (,,,) a b c d
   deriving (Eq, Ord, Bounded, Ix) -- Show/Read in PreludeText
data  (a,b,c,d,e)
   =  (,,,,) a b c d e
   deriving (Eq, Ord, Bounded, Show, Read)
data  (a,b,c,d,e,f)
   =  (,,,,,) a b c d e f
  deriving (Eq, Ord, Bounded, Show, Read)
data  (a,b,c,d,e,f,g)
   =  (,,,,,,) a b c d e f g
   deriving (Eq, Ord, Bounded, Show, Read)
data  (a,b,c,d,e,f,g,h)
   =  (,,,,,,,) a b c d e f g h
  deriving (Eq, Ord, Bounded, Show, Read)
data  (a,b,c,d,e,f,g,h,i)
   =  (,,,,,,,,) a b c d e f g h i
   deriving (Eq, Ord, Bounded, Show, Read)
data  (a,b,c,d,e,f,g,h,i,j)
   =  (,,,,,,,,,) a b c d e f g h i j
   deriving (Eq, Ord, Bounded, Show, Read)
data  (a,b,c,d,e,f,g,h,i,j,k)
   =  (,,,,,,,,,,) a b c d e f g h i j k
   deriving (Eq, Ord, Bounded, Show, Read)
data  (a,b,c,d,e,f,g,h,i,j,k,l)
   =  (,,,,,,,,,,,) a b c d e f g h i j k l
   deriving (Eq, Ord, Bounded, Show, Read)
data  (a,b,c,d,e,f,g,h,i,j,k,l,m)
   =  (,,,,,,,,,,,,) a b c d e f g h i j k l m
   deriving (Eq, Ord, Bounded, Show, Read)
data  (a,b,c,d,e,f,g,h,i,j,k,l,m,n)
   =  (,,,,,,,,,,,,,) a b c d e f g h i j k l m n
   deriving (Eq, Ord, Bounded, Show, Read)
data  (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)
   =  (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o
   deriving (Eq, Ord, Bounded, Show, Read)
data  (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p)
   =  (,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p
   deriving (Eq, Ord, Bounded, Show, Read)
data  (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q)
   =  (,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q
   deriving (Eq, Ord, Bounded, Show, Read)


-- component projections for pairs:
-- (NB: not provided for triples, quadruples, etc.)

fst              :: (a,b) -> a
fst (x,y)        =  x

snd              :: (a,b) -> b
snd (x,y)        =  y

instance Functor ((,) a) where  fmap f (x,y) = (x,f y)

-- | curry converts an uncurried function to a curried function;
curry            :: ((a, b) -> c) -> a -> b -> c
curry f x y      =  f (x, y)

-- | uncurry converts a curried function to a function on pairs.
uncurry          :: (a -> b -> c) -> ((a, b) -> c)
uncurry f p      =  f (fst p) (snd p)

-- * Misc functions

-- | until p f  yields the result of applying f until p holds.
until            :: (a -> Bool) -> (a -> a) -> a -> a
until p f x
     | p x       =  x
     | otherwise =  until p f (f x)

-- | asTypeOf is a type-restricted version of const.  It is usually used
-- as an infix operator, and its typing forces its first argument
-- (which is usually overloaded) to have the same type as the second.
asTypeOf         :: a -> a -> a
asTypeOf         =  const

-- | error stops execution and displays an error message
error            :: String -> a
error            =  primError

-- | It is expected that compilers will recognize this and insert error
-- messages that are more appropriate to the context in which undefined
-- appears.
undefined        :: a
undefined        =  error "Prelude.undefined"

    
-- For the P-Logic extension:
data Prop