content: {-# LANGUAGE DatatypeContexts #-}
  module ShouldFail where
  
  infixr 1 `rangeOf`
  
  data Ord a => SubRange a = SubRange (a, a) a
  
  type IntSubRange = SubRange Int 
  
  
  subRangeValue :: SubRange a -> a
  subRangeValue (SubRange (lower, upper) value) = value
  
  subRange :: SubRange a -> (a, a)
  subRange (SubRange r value) = r
  
  newRange :: (Ord a, Show a) => (a, a) -> a -> SubRange a
  newRange r value = checkRange (SubRange r value)
  
  
  checkRange :: (Ord a, Show a) => SubRange a -> SubRange a
  checkRange (SubRange (lower, upper) value)
    = if (value < lower) || (value > upper) then
        error ("### sub range error. range = " ++ show lower ++ 
                ".." ++ show upper ++ " value = " ++ show value ++ "\n")
      else
        SubRange (lower, upper) value
  
  
  instance Eq a => Eq (SubRange a) where
    (==) a b = subRangeValue a == subRangeValue  b
  
  instance (Ord a) => Ord (SubRange a) where
    (<)  = relOp (<)
    (<=) = relOp (<=)
    (>=) = relOp (>=)
    (>)  = relOp (>)
  
  relOp :: Ord a => (a->a->Bool) -> SubRange a -> SubRange a -> Bool
  relOp op a b = (subRangeValue a) `op` (subRangeValue b)
  
  rangeOf :: (Ord a, Show a) => SubRange a -> SubRange a -> SubRange a
  rangeOf a b = checkRange (SubRange (subRange b) (subRangeValue a))
  
  showRange :: Show a => SubRange a -> String
  showRange (SubRange (lower, upper) value)
    = show value ++ " :" ++ show lower ++ ".." ++ show upper
  
  showRangePair :: (Show a, Show b) => (SubRange a, SubRange b) -> String
  showRangePair (a, b)
    = "(" ++ showRange a ++ ", " ++ showRange b ++ ")"
  
  showRangeTriple :: (Show a, Show b, Show c) =>
                     (SubRange a, SubRange b, SubRange c) -> String
  showRangeTriple (a, b, c) 
    = "(" ++ showRange a ++ ", " ++ showRange b ++ ", " ++ showRange c ++ ")"
  
  
  
  instance Num a => Num (SubRange a) where
    negate = numSubRangeNegate
    (+) = numSubRangeAdd
    (-) = numSubRangeSubtract
    (*) = numSubRangeMultiply
    fromInteger a = SubRange (fromInteger a, fromInteger a) (fromInteger a)
  
  numSubRangeNegate :: (Ord a, Show a, Num a) => SubRange a -> SubRange a
  numSubRangeNegate (SubRange (lower, upper) value)
    = checkRange (SubRange (lower, upper) (-value))
  
  numSubRangeBinOp :: Num a => (a -> a -> a) -> 
                      SubRange a -> SubRange a -> SubRange a
  numSubRangeBinOp op a b
    = SubRange (result, result) result
      where
      result = (subRangeValue a) `op` (subRangeValue b)
  
  -- partain:
  numSubRangeAdd, numSubRangeSubtract, numSubRangeMultiply :: Num a => SubRange a -> SubRange a -> SubRange a
  
  numSubRangeAdd = numSubRangeBinOp (+)
  numSubRangeSubtract = numSubRangeBinOp (-)
  numSubRangeMultiply = numSubRangeBinOp (*)
  
  unsignedBits :: Int -> (Int, Int)
  unsignedBits n = (0, 2^n-1)
  
  signedBits :: Int -> (Int, Int)
  signedBits n = (-2^(n-1), 2^(n-1)-1)   
  
  
  si_n :: Int -> Int -> IntSubRange
  si_n bits value = SubRange (signedBits bits) value
  
  si8, si10, si16 :: Int -> IntSubRange
  si8  = si_n 8
  si10 = si_n 10
  si16 = si_n 16
  