--LICENSE: BSD3 (or also similar, like GHC, etc.)
--INITIAL AUTHOR: Isaac Dupree <id@isaac.cedarswampstudios.org>
--see IntegerInTermsOfInt.hs - the main file currently

-- The Int defined here shall not be restricted by Prelude.Int's
-- limitations, and it shall be restricted by artificial limitations
-- of its own.  Given maximal strictness and checking because that
-- is its purpose.
module TestingInt (Int) where

import Prelude hiding (Int)
import Data.Bits
import Control.Applicative

import TestingDebug

--WORKAROUND
--default ()



--INTERESTING
type Impl = Integer--must not be IntegerInTermsOfInt
--can't parameterize type on the runtime values min/maxBound :(
maxIntInteger :: Impl
maxIntInteger = 2^(
    5
--    9
--    29 --min required by report
    ::Impl) - 1
minIntInteger :: Impl
minIntInteger = negate maxIntInteger




data Int = I Impl | NaN
                  deriving (Eq, Ord)
f1 :: String -> (Impl -> Impl) -> Int -> Int
f1 name f (I a) = mkI (name++" "++show a) (f a)
f1 name f _ = NaN
f2 :: String -> (Impl -> Impl -> Impl) -> Int -> Int -> Int
f2 name f (I a) (I b) = mkI (name++" "++show a++" "++show b) (f a b)
f2 name f _ _ = NaN
f2div1 name f a b = if b == 0
  then traces (name++" "++show a++" "++show b++" = division by zero") NaN
  else f2 name f a b
f22 :: String -> (Impl -> Impl -> (Impl,Impl)) -> Int -> Int -> (Int,Int)
f22 name f (I a) (I b) = case f a b of
  (top,bot) -> ( mkI ("fst "++name++" "++show a++" "++show b) top
               , mkI ("snd "++name++" "++show a++" "++show b) bot )
f22 name f _ _ = (NaN,NaN)
f2div2 name f a b = if b == 0
 then traces (name++" "++show a++" "++show b++" = division by zero") (NaN,NaN)
 else f22 name f a b
f2s :: Show int => String -> (Impl -> int -> Impl) -> Int -> int -> Int
f2s name f (I a) b = mkI (name++" "++show a++" "++show b) (f a b)
f2s name f _ _ = NaN
f2sp :: Num int => String -> (Impl -> int -> Impl) -> Int -> int -> Int
f2sp name f (I a) b = if signum b == negate 1
  then traces (name++" "++show a++" "++show b++" = bad shift argument") NaN
  else mkI (name++" "++show a++" "++show b) (f a b)
f2sp name f _ _ = NaN

unI :: Int -> Impl
unI (I i) = i
--crash I guess if NaN - no, quickcheck hates that
unI NaN = 0

mkI :: String -> Impl -> Int
mkI str i = if i < minIntInteger || i > maxIntInteger
           then traces (str++" = out-of-bounds Int: "++show i)
                  NaN--I 0--(maxIntInteger^(5::Integer) + 7)
              --error ("out-of-bounds Int: "++show i)
           else I i

instance Bounded Int where
  maxBound = I maxIntInteger
  minBound = I minIntInteger

--note that showsPrec in class Show involves type Prelude.Int
instance Show Int where
  showsPrec a (I b) = showsPrec a b
  showsPrec a NaN = ("NaN"++)
  show (I a) = show a
  show NaN = "NaN"

instance Num Int where
  (+) = f2 "+" (+)
  (-) = f2 "-" (-)
  (*) = f2 "*" (*)
  negate = f1 "negate" negate
  abs = f1 "abs" abs
  signum = f1 "signum" signum
  fromInteger a = mkI ("fromInteger "++show a) a

instance Real Int where
  toRational a = toRational (unI a)

instance Integral Int where
  div = f2div1 "div" div
  mod = f2div1 "mod" mod
  quot = f2div1 "quot" quot
  rem = f2div1 "rem" rem
  divMod = f2div2 "divMod" divMod
  quotRem = f2div2 "quotRem" quotRem
  toInteger a = (unI a)

--involves Prelude.Int even more, aagh
instance Enum Int where
  succ = f1 "succ" succ
  pred = f1 "pred" pred
  fromEnum a = fromInteger (unI a)
  toEnum a = mkI ("toEnum "++show a) (toInteger a)
--okay, so I don't need to use these, so I'll not bother
--  enumFrom (I a) = map mkI (enumFrom a)
--  enumFromThen (I a) (I b) = map mkI (enumFromThen a b)
--  enumFromTo (I a) (I b) = map mkI (enumFromTo a b)
--  enumFromThenTo (I a) (I b) (I c) = map mkI (enumFromThenTo a b c)

instance Bits Int where
  isSigned _ = True
  (.&.) = f2 ".&." (.&.)
  (.|.) = f2 ".|." (.|.)
  xor = f2 "xor" xor
  complement = f1 "complement" complement
  shift = f2s "shift" shift
  shiftL = f2sp "shiftL" shiftL
  shiftR = f2sp "shiftR" shiftR
  rotate = f2s "rotate" rotate
  rotateL = f2sp "rotateL" rotateL
  rotateR = f2sp "rotateR" rotateR