--
-- Copyright (c) 2009-2010, ERICSSON AB All rights reserved.
-- 
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
-- 
--     * Redistributions of source code must retain the above copyright notice,
--       this list of conditions and the following disclaimer.
--     * Redistributions in binary form must reproduce the above copyright
--       notice, this list of conditions and the following disclaimer in the
--       documentation and/or other materials provided with the distribution.
--     * Neither the name of the ERICSSON AB nor the names of its contributors
--       may be used to endorse or promote products derived from this software
--       without specific prior written permission.
-- 
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS
-- BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
-- OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
-- THE POSSIBILITY OF SUCH DAMAGE.
--

module Feldspar.Compiler.Platforms
    ( availablePlatforms
    , c99
    , tic64x
    ) where


import Feldspar.Compiler.Options
import Feldspar.Compiler.Imperative.Representation
import Feldspar.Compiler.Imperative.Semantics(IsRestrict(..))
import Feldspar.Compiler.Imperative.CodeGeneration (typeof)



availablePlatforms :: [Platform]
availablePlatforms = [ c99, tic64x ]


-- ansiC = Platform "ansiC" undefined [] [] ["\"feldspar.h\""] NoRestrict


c99 = Platform {
    name = "c99",
    types =
        [ (Numeric ImpSigned S8,    "int8_t",   "int8")
        , (Numeric ImpSigned S16,   "int16_t",  "int16")
        , (Numeric ImpSigned S32,   "int32_t",  "int32")
        , (Numeric ImpSigned S64,   "int64_t",  "int64")
        , (Numeric ImpUnsigned S8,  "uint8_t",  "uint8")
        , (Numeric ImpUnsigned S16, "uint16_t", "uint16")
        , (Numeric ImpUnsigned S32, "uint32_t", "uint32")
        , (Numeric ImpUnsigned S64, "uint64_t", "uint64")
        , (BoolType,  "int",    "int")
        , (FloatType, "float",  "float")
        ] ,
    values = [] ,
    primitives =
        [ (FeldPrimDesc "(==)" [AllT, AllT],    Left $ Op2 "==")
        , (FeldPrimDesc "(/=)" [AllT, AllT],    Left $ Op2 "!=")
        , (FeldPrimDesc "(<)" [AllT, AllT],     Left $ Op2 "<")
        , (FeldPrimDesc "(>)" [AllT, AllT],     Left $ Op2 ">")
        , (FeldPrimDesc "(<=)" [AllT, AllT],    Left $ Op2 "<=")
        , (FeldPrimDesc "(>=)" [AllT, AllT],    Left $ Op2 ">=")
        , (FeldPrimDesc "not" [BoolT],          Left $ Op1 "!")
        , (FeldPrimDesc "(&&)" [BoolT, BoolT],  Left $ Op2 "&&")
        , (FeldPrimDesc "(||)" [BoolT, BoolT],  Left $ Op2 "||")
        
        , (FeldPrimDesc "quot" [AllT, AllT],    Right optimizedDivide)
        , (FeldPrimDesc "rem" [AllT, AllT],     Left $ Op2 "%")
        , (FeldPrimDesc "(^)" [AllT, AllT],     Left $ Fun "pow" firstInFP)
        , (FeldPrimDesc "negate" [AllT],        Left $ Op1 "-")
        , (FeldPrimDesc "abs" [IntTU],          Left Assig)
        , (FeldPrimDesc "abs" [FloatT],         Left $ Fun "fabsf" noneFP)
        , (FeldPrimDesc "abs" [AllT],           Left $ Fun "abs" firstInFP)
        , (FeldPrimDesc "signum" [AllT],        Left $ Fun "signum" firstInFP)
        , (FeldPrimDesc "(+)" [AllT, AllT],     Left $ Op2 "+")
        , (FeldPrimDesc "(-)" [AllT, AllT],     Left $ Op2 "-")
        , (FeldPrimDesc "(*)" [AllT, AllT],     Right optimizedMultiply)
        , (FeldPrimDesc "(/)" [AllT, AllT],     Left $ Op2 "/")
        
        , (FeldPrimDesc "(.&.)" [IntT, IntT],   Left $ Op2 "&")
        , (FeldPrimDesc "(.|.)" [IntT, IntT],   Left $ Op2 "|")
        , (FeldPrimDesc "xor" [IntT, IntT],     Left $ Op2 "^")
        , (FeldPrimDesc "complement" [IntT],    Left $ Op1 "~")
        , (FeldPrimDesc "bit" [IntT],           Right bitFunToShift)
        , (FeldPrimDesc "setBit" [IntT, IntT],  Left $ Fun "setBit" firstInFP)
        , (FeldPrimDesc "clearBit" [IntT, IntT],      Left $ Fun "clearBit" firstInFP)
        , (FeldPrimDesc "complementBit" [IntT, IntT], Left $ Fun "complementBit" firstInFP)
        , (FeldPrimDesc "testBit" [IntT, IntT], Left $ Fun "testBit" firstInFP)
        , (FeldPrimDesc "shiftL" [IntT, IntT],  Left $ Op2 "<<")
        , (FeldPrimDesc "shiftR" [IntT, IntT],  Left $ Op2 ">>")
        , (FeldPrimDesc "rotateL" [IntT, IntT], Left $ Fun "rotateL" firstInFP)
        , (FeldPrimDesc "rotateR" [IntT, IntT], Left $ Fun "rotateR" firstInFP)
        , (FeldPrimDesc "reverseBits" [IntT],   Left $ Fun "reverseBits" firstInFP)
        , (FeldPrimDesc "bitScan" [IntT],       Left $ Fun "bitScan" firstInFP)
        , (FeldPrimDesc "bitCount" [IntT],      Left $ Fun "bitCount" firstInFP)
        , (FeldPrimDesc "bitSize" [IntT],       Right bitSizeFunToConst)
        , (FeldPrimDesc "isSigned" [IntT],      Right isSignedFunToConst)
        ] ,
    includes = ["\"feldspar_c99.h\"", "<stdint.h>", "<math.h>"],
    isRestrict = NoRestrict
}


tic64x = Platform {
    name = "tic64x",
    types =
        [ (Numeric ImpSigned S8,    "char",     "char")
        , (Numeric ImpSigned S16,   "short",    "short")
        , (Numeric ImpSigned S32,   "int",      "int")
        , (Numeric ImpSigned S40,   "long",     "long")
        , (Numeric ImpSigned S64,   "long long","llong")
        , (Numeric ImpUnsigned S8,  "unsigned char",  "uchar")
        , (Numeric ImpUnsigned S16, "unsigned short", "ushort")
        , (Numeric ImpUnsigned S32, "unsigned",       "uint")
        , (Numeric ImpUnsigned S40, "unsigned long",  "ulong")
        , (Numeric ImpUnsigned S64, "unsigned long long", "ullong")
        , (BoolType,  "int",    "int")
        , (FloatType, "float",  "float")
        ] ,
    values = [] ,
    primitives =
        [ (FeldPrimDesc "abs" [IntTS_ S32],           Left $ Fun "_abs" noneFP)
        , (FeldPrimDesc "abs" [FloatT],               Left $ Fun "_fabsf" noneFP)
        , (FeldPrimDesc "rotateL" [IntTU_ S32, IntT], Left $ Fun "_rotl" noneFP)
        , (FeldPrimDesc "reverseBits" [IntTU_ S32],   Left $ Fun "_bitr" noneFP)
        , (FeldPrimDesc "bitCount" [IntTU_ S32],      Right optimizedBitCount)
        ]
        ++ primitives c99,
    includes = ["\"feldspar_tic64x.h\"", "<c6x.h>"],
    isRestrict = Restrict
}


optimizedMultiply :: TransformPrim
optimizedMultiply _ [x, y] [o] = case (x,y) of
    (_, (Expression (ConstantExpression (Constant (IntConstant _) _)) _)) -> optimizedMultiply' x y
    ((Expression (ConstantExpression (Constant (IntConstant _) _)) _), _) -> optimizedMultiply' y x
    (_, _) -> [(Op2 "*", [x, y], [o])]
  where
    optimizedMultiply' int con
        | (machTypes IntT $ typeof int) 
          && (con' >= 0) 
          && (2 ^ (numberOfTwoPrimeFactors con') == con')
              = [ (Op2 "<<", [int, (intToCe $ numberOfTwoPrimeFactors con')], [o]) ]
        | (machTypes IntT $ typeof int) 
          && (con' < 0) 
          && (2 ^ (numberOfTwoPrimeFactors $ con'*(-1)) == con'*(-1))
              = [ (Op2 "<<", [int, (intToCe $ numberOfTwoPrimeFactors $ con'*(-1))], [o])
                , (Op1 "-", [lToe o], [o])
                ]
        | otherwise = [(Op2 "*", [x, y], [o])]
      where
        con' = ceToInt con


optimizedDivide :: TransformPrim
optimizedDivide _ [x, y] [o] = case (x,y) of
    (_, (Expression (ConstantExpression (Constant (IntConstant _) _)) _)) -> optimizedDivide' x y
    (_, _) -> [(Op2 "/", [x, y], [o])]
  where
    optimizedDivide' int con
        | (machTypes IntT $ typeof int) 
          && (con' >= 0) 
          && (2 ^ (numberOfTwoPrimeFactors con') == con')
              = [ (Op2 ">>", [int, (intToCe $ numberOfTwoPrimeFactors con')], [o]) ]
        | (machTypes IntT $ typeof int) 
          && (con' < 0) 
          && (2 ^ (numberOfTwoPrimeFactors $ con'*(-1)) == con'*(-1))
              = [ (Op2 ">>", [int, (intToCe $ numberOfTwoPrimeFactors $ con'*(-1))], [o])
                , (Op1 "-", [lToe o], [o])
                ]
        | otherwise = [(Op2 "/", [x, y], [o])]
      where
        con' = ceToInt con


bitFunToShift _ [i] [o] = [ (Op2 "<<", [intToCe 1, i], [o]) ]


bitSizeFunToConst :: TransformPrim
bitSizeFunToConst _ [i] [o] = case (typeof i) of
    (Numeric _ S8)  -> [ (Assig, [intToCe 8], [o]) ]
    (Numeric _ S16) -> [ (Assig, [intToCe 16], [o]) ]
    (Numeric _ S32) -> [ (Assig, [intToCe 32], [o]) ]
    (Numeric _ S40) -> [ (Assig, [intToCe 40], [o]) ]
    (Numeric _ S64) -> [ (Assig, [intToCe 64], [o]) ]


isSignedFunToConst :: TransformPrim
isSignedFunToConst _ [i] [o] = case (typeof i) of
    (Numeric ImpSigned _)   -> [ (Assig, [boolToCe True], [o]) ]
    (Numeric ImpUnsigned _) -> [ (Assig, [boolToCe False], [o]) ]


optimizedBitCount :: TransformPrim
optimizedBitCount _ [i] [o]
    = [ (Fun "_bitc4" noneFP, [i], [o])
      , (Fun "_dotpu4" noneFP, [lToe o, intToCe 0x01010101], [o])
      ]


numberOfTwoPrimeFactors 2 = 1
numberOfTwoPrimeFactors x | x `mod` 2 == 0  = (numberOfTwoPrimeFactors $ x `div` 2) + 1
                          | otherwise       = 0



ceToInt (Expression (ConstantExpression (Constant (IntConstant (IntConstantType x _)) _)) _) = x
intToCe x = Expression (ConstantExpression $ Constant (IntConstant $ IntConstantType x ()) ()) ()
boolToCe x = Expression (ConstantExpression $ Constant (BoolConstant $ BoolConstantType x ()) ()) ()

lToe x = Expression (LeftValueExpression x) ()