{-# LANGUAGE UnboxedTuples, MagicHash #-}
{-# OPTIONS_GHC -fbyte-code #-}

{-
  Test unboxed tuples and sums in the bytecode interpreter.

  The bytecode interpreter uses the stack for everything, while
  compiled code uses STG registers for arguments and return values.
 -}

module Main where

import qualified Obj      as O
import qualified ByteCode as B

import GHC.Exts
import GHC.Word

main :: IO ()
main = do

    case B.swap (O.swap (B.swap (O.swap (# "x", 1 #)))) of
      (# y1, y2 #) -> print (y1, y2)

    -- one-tuples
    testX "tuple1"
          B.tuple1_a O.tuple1_a
          B.tuple1   O.tuple1
          (\f -> f 90053)

    -- check that the contents of a one-tuple aren't evaluated
    B.tuple1_b B.tuple1 (error "error tuple1_b") "tuple1_b"
    B.tuple1_b O.tuple1 (error "error tuple1_b") "tuple1_b"
    O.tuple1_b B.tuple1 (error "error tuple1_b") "tuple1_b"
    O.tuple1_b O.tuple1 (error "error tuple1_b") "tuple1_b"

    -- various size tuples with boxed/unboxed elements
    testX "tuple2p"
          B.tuple2p_a O.tuple2p_a
          B.tuple2p   O.tuple2p
          (\f -> f (1234::Integer) 1235 1236 1237)

    testX "tuple2n"
          B.tuple2n_a O.tuple2n_a
          B.tuple2n   O.tuple2n
          (\f -> f 7654 7653 7652 7651)

    testX "tuple3"
          B.tuple3_a O.tuple3_a
          B.tuple3   O.tuple3
          (\f -> f (1000::Integer) 1001 1002 1003
                   1004 1005 1006 1007
                   1008 1009 1010 1011)

    testX "tuple4a"
          B.tuple4a_a O.tuple4a_a
          B.tuple4a   O.tuple4a
          (\f -> f 2000 2001 2002 2003)

    testX "tuple4b"
          B.tuple4b_a O.tuple4b_a
          B.tuple4b   O.tuple4b
          (\f -> f 3000 3001 3002 3003
                   3004 3005 3006 3007
                   3008 3009 3010 3011
                   3012 3013 3014 3015
                   3016 3017 3018 3019)

    testX "tuple4c"
          B.tuple4c_a O.tuple4c_a
          B.tuple4c   O.tuple4c
          (\f -> f 3000 3001 3002 3003
                   3004 3005 3006 3007
                   3008 3009 3010 3011
                   3012 3013 3014 3015)

    testX "tuple5"
          B.tuple5_a O.tuple5_a
          B.tuple5   O.tuple5
          (\f -> f 4000 4001 4002 4003
                   4004 4005 4006 4007
                   4008 4009 4010 4011
                   4012 4013 4014 4015)

    testX "tuple6"
          B.tuple6_a O.tuple6_a
          B.tuple6   O.tuple6
          (\f -> f 6006)

    -- tuples with void and empty tuples
    testX "tuplev1"
          B.tuple_v1_a O.tuple_v1_a
          B.tuple_v1   O.tuple_v1
          (\f -> f False)

    testX "tuplev2"
          B.tuple_v2_a O.tuple_v2_a
          B.tuple_v2   O.tuple_v2
          (\f -> f False)

    testX "tuplev3"
          B.tuple_v3_a O.tuple_v3_a
          B.tuple_v3   O.tuple_v3
          (\f -> f 30001)

    testX "tuplev4"
          B.tuple_v4_a O.tuple_v4_a
          B.tuple_v4   O.tuple_v4
          (\f -> f 40001)

    testX "tuplev5"
          B.tuple_v5_a O.tuple_v5_a
          B.tuple_v5   O.tuple_v5
          (\f -> f 50001)

    testX "tuplev6"
          B.tuple_v6_a O.tuple_v6_a
          B.tuple_v6   O.tuple_v6
          (\f -> f 601 602 603 604)

    -- representation-polymorphic
    print $ B.lev_poly_a B.lev_poly B.tuple3 991
    print $ B.lev_poly_a B.lev_poly O.tuple3 992
    print $ B.lev_poly_a O.lev_poly B.tuple3 993
    print $ B.lev_poly_a O.lev_poly O.tuple3 994
    print $ O.lev_poly_a B.lev_poly B.tuple3 995
    print $ O.lev_poly_a B.lev_poly O.tuple3 996
    print $ O.lev_poly_a O.lev_poly B.tuple3 997
    print $ O.lev_poly_a O.lev_poly O.tuple3 998

    print $ B.lev_poly_b B.lev_poly B.lev_poly_boxed 981
    print $ B.lev_poly_b B.lev_poly O.lev_poly_boxed 982
    print $ B.lev_poly_b O.lev_poly B.lev_poly_boxed 983
    print $ B.lev_poly_b O.lev_poly O.lev_poly_boxed 984
    print $ O.lev_poly_b B.lev_poly B.lev_poly_boxed 985
    print $ O.lev_poly_b B.lev_poly O.lev_poly_boxed 986
    print $ O.lev_poly_b O.lev_poly B.lev_poly_boxed 987
    print $ O.lev_poly_b O.lev_poly O.lev_poly_boxed 988

    -- sums
    testX "sum1a"
          B.sum1_a O.sum1_a
          B.sum1   O.sum1
          (\f -> f 0 1 "23" True)

    testX "sum1b"
          B.sum1_a O.sum1_a
          B.sum1   O.sum1
          (\f -> f 1 1 "23" True)

    testX "sum2a"
          B.sum2_a O.sum2_a
          B.sum2   O.sum2
          (\f -> f 0 "sum2")

    testX "sum2b"
          B.sum2_a O.sum2_a
          B.sum2   O.sum2
          (\f -> f 1 "sum2")

    testX "sum2c"
          B.sum2_a O.sum2_a
          B.sum2   O.sum2
          (\f -> f 2 "sum2")

    testX "sum2d"
          B.sum2_a O.sum2_a
          B.sum2   O.sum2
          (\f -> f 3 "sum2")

    testX "sum2e"
          B.sum2_a O.sum2_a
          B.sum2   O.sum2
          (\f -> f 4 "sum2")



testX :: (Eq a, Show a)
      => String -> (p -> t) -> (p -> t) -> p -> p -> (t -> a) -> IO ()
testX msg a1 a2 b1 b2 ap =
    let (r:rs) = [ap (f g) | f <- [a1,a2], g <- [b1,b2]]
    in putStrLn (msg ++ " " ++ show (all (==r) rs) ++ " " ++ show r)
