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 ]
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) ()