module PreludeTuple where

{-#Prelude#-}  -- Indicates definitions of compiler prelude symbols

import PreludeTuplePrims

-- This module contains support routines which handle tuple instances.
-- These are based on a implementation level data type which represents
-- general tuples and a data type to hold the set of dictionaries which
-- are associated with the tuple.

-- Each of these functions takes the tupledicts as the first argument.
-- Force all of these functions to take strict arguments because they'll
-- never be called with 0-length tuples anyway.

-- The following primitives operate on tuples.  

--  tupleSize :: TupleDicts -> Int
--  tupleSel :: Tuple -> Int -> Int -> a
--  dictSel :: TupleDicts -> method -> Int -> a
--  listToTuple :: [a] -> Tuple

-- Eq functions

tupleEq :: TupleDicts -> Tuple -> Tuple -> Bool
{-#  tupleEq :: Strictness("S,S,S") #-}
tupleEq dicts x y = tupleEq1 0 where
  tupleEq1 i | i == size = True
             | otherwise =
                  ((dictSel (cmpEq dicts i)) x' y') && tupleEq1 (i+1)
     where
        x' = tupleSel x i size
        y' = tupleSel y i size
  size = tupleSize dicts

cmpEq x y = x == y

tupleNeq dicts x y = not (tupleEq dicts x y)

-- Ord functions

tupleLe :: TupleDicts -> Tuple -> Tuple -> Bool
{-#  tupleLe :: Strictness("S,S,S") #-}
tupleLe dicts x y = tupleLe1 0 where
  tupleLe1 i | i == size = False
             | (dictSel (cmpLs dicts i)) x' y' = True
	     | (dictSel (ordEq dicts i)) x' y' = tupleLe1 (i+1)
	     | otherwise = False
      where
        x' = tupleSel x i size
        y' = tupleSel y i size
  size = tupleSize dicts

cmpLs x y = x < y

ordEq :: Ord a => a -> a -> Bool
ordEq x y = x == y

tupleLeq :: TupleDicts -> Tuple -> Tuple -> Bool
{-#  tupleLeq :: Strictness("S,S,S") #-}
tupleLeq dicts x y = tupleLeq1 0 where
  tupleLeq1 i | i == size = True
             | (dictSel (cmpLs dicts i)) x' y' = True
	     | (dictSel (ordEq dicts i)) x' y' = tupleLeq1 (i+1)
	     | otherwise = False
      where
        x' = tupleSel x i size
        y' = tupleSel y i size
  size = tupleSize dicts

tupleGe :: TupleDicts -> Tuple -> Tuple -> Bool
tupleGe d x y = tupleLe d y x

tupleGeq :: TupleDicts -> Tuple -> Tuple -> Bool
tupleGeq d x y = tupleLeq d y x

tupleMax,tupleMin :: TupleDicts -> Tuple -> Tuple -> Tuple
tupleMax d x y = if tupleGe d x y then x else y
tupleMin d x y = if tupleLe d x y then x else y

-- Ix functions

tupleRange :: TupleDicts -> (Tuple,Tuple) -> [Tuple]
{-#  tupleRange :: Strictness("S,S") #-}

tupleRange dicts (x,y) = map listToTuple (tupleRange' 0) where
  tupleRange' i | i == size = [[]]
                | otherwise =
                   [(i1 : i2) | i1 <- r, i2 <- tupleRange' (i+1)]
      where
        x' = tupleSel x i size
        y' = tupleSel y i size
        r = (dictSel (range' dicts i)) (x',y')
  size = tupleSize dicts

range' x = range x

tupleIndex :: TupleDicts -> (Tuple,Tuple) -> Tuple -> Int
{-#  tupleIndex :: Strictness("S,S,S") #-}

tupleIndex dicts (low,high) n = tupleIndex' (size-1) where
  size = tupleSize dicts
  tupleIndex' i | i == 0 = i'
                | otherwise = i' + r' * (tupleIndex' (i-1))
   where
    low' = tupleSel low i size
    high' = tupleSel high i size
    n' = tupleSel n i size
    i' = (dictSel (index' dicts i)) (low',high') n'
    r' = (dictSel (rangeSize dicts i)) (low',high')

index' x = index x

rangeSize               :: (Ix a) => (a,a) -> Int
rangeSize (l,u)         =  index (l,u) u + 1

tupleInRange :: TupleDicts -> (Tuple,Tuple) -> Tuple -> Bool
{-#  tupleInRange :: Strictness("S,S,S") #-}
tupleInRange dicts (low,high) n = tupleInRange' 0 where
  size = tupleSize dicts
  tupleInRange' i | i == size = True
                  | otherwise = (dictSel (inRange' dicts i)) (low',high') n'
		                && tupleInRange' (i+1)
   where
    low' = tupleSel low i size
    high' = tupleSel high i size
    n' = tupleSel n i size
   
inRange' x = inRange x

-- Text functions

tupleReadsPrec :: TupleDicts -> Int -> ReadS Tuple

tupleReadsPrec dicts p = readParen False
                          (\s -> map ( \ (t,w) -> (listToTuple t,w))
			             (tRP' s 0))
    where
      size = tupleSize dicts
      tRP' s i | i == 0 = [(t':t,w) |
                             ("(",s1) <- lex s,
                             (t',s2) <- nextItem s1,
                             (t,w) <- tRP' s2 (i+1)]
               | i == size = [([],w) | (")",w) <- lex s]
               | otherwise =
                        [(t':t,w) | 
                             (",",s1) <- lex s,
                             (t',s2) <- nextItem s1,
                             (t,w) <- tRP' s2 (i+1)]
       where
        nextItem s = (dictSel (reads dicts i)) s

tupleShowsPrec :: TupleDicts -> Int -> Tuple -> ShowS

tupleShowsPrec dicts p tuple =  
  showChar '(' . tSP' 0
    where
      size = tupleSize dicts
      tSP' i | i == (size-1) =
                 showTup . showChar ')'
             | otherwise =
                 showTup . showChar ',' . tSP' (i+1)
        where
          showTup = (dictSel (shows dicts i)) (tupleSel tuple i size)
                                    
tupleReadList :: TupleDicts -> ReadS [Tuple]

tupleReadList dicts =
                  readParen False (\r -> [pr | ("[",s)	<- lex r,
					       pr	<- readl s])
	          where readl  s = [([],t)   | ("]",t)  <- lex s] ++
				   [(x:xs,u) | (x,t)    <- tupleReads s,
					       (xs,u)   <- readl' t]
			readl' s = [([],t)   | ("]",t)  <- lex s] ++
			           [(x:xs,v) | (",",t)  <- lex s,
					       (x,u)	<- tupleReads t,
					       (xs,v)   <- readl' u]
                        tupleReads s = tupleReadsPrec dicts 0 s

tupleShowList :: TupleDicts -> [Tuple] -> ShowS

tupleShowList dicts [] = showString "[]"
tupleShowList dicts (x:xs)
		= showChar '[' . showsTuple x . showl xs
		  where showl []     = showChar ']'
			showl (x:xs) = showString ", " . showsTuple x
			                               . showl xs
                        showsTuple x = tupleShowsPrec dicts 0 x

-- Binary functions

tupleShowBin :: TupleDicts -> Tuple -> Bin -> Bin

tupleShowBin dicts t bin = tSB' 0
  where
    size = tupleSize dicts
    tSB' i | i == size = bin
    tSB' i | otherwise =
                  (dictSel (showBin' dicts i)) (tupleSel t i size) (tSB' (i+1))

showBin' x = showBin x

tupleReadBin :: TupleDicts -> Bin -> (Tuple,Bin)

tupleReadBin dicts bin = (listToTuple t,b) where
  size = tupleSize dicts
  (t,b) = tRB' bin 0
  tRB' b i | i == size = ([],b)
           | otherwise = (t':ts,b') where
     (t',b'') = (dictSel (readBin' dicts i)) b
     (ts,b') = tRB' b'' (i+1)

readBin' x = readBin x