module Feldspar.Compiler.Backend.C.Platforms ( availablePlatforms , c99 , tic64x ) where import Feldspar.Compiler.Backend.C.Options import Feldspar.Compiler.Imperative.Representation import Feldspar.Compiler.Backend.C.CodeGeneration (typeof) availablePlatforms :: [Platform] availablePlatforms = [ c99, tic64x ] -- ansiC = Platform "ansiC" undefined [] [] ["\"feldspar.h\""] NoRestrict c99 = Platform { name = "c99", types = [ (NumType Signed S8, "int8_t", "int8") , (NumType Signed S16, "int16_t", "int16") , (NumType Signed S32, "int32_t", "int32") , (NumType Signed S64, "int64_t", "int64") , (NumType Unsigned S8, "uint8_t", "uint8") , (NumType Unsigned S16, "uint16_t", "uint16") , (NumType Unsigned S32, "uint32_t", "uint32") , (NumType Unsigned S64, "uint64_t", "uint64") , (BoolType, "int", "int") , (FloatType, "float", "float") , (ComplexType (NumType Signed S8), "complexOf_int8", "complexOf_int8") , (ComplexType (NumType Signed S16), "complexOf_int16", "complexOf_int16") , (ComplexType (NumType Signed S32), "complexOf_int32", "complexOf_int32") , (ComplexType (NumType Signed S64), "complexOf_int64", "complexOf_int64") , (ComplexType (NumType Unsigned S8), "complexOf_uint8", "complexOf_uint8") , (ComplexType (NumType Unsigned S16), "complexOf_uint16", "complexOf_uint16") , (ComplexType (NumType Unsigned S32), "complexOf_uint32", "complexOf_uint32") , (ComplexType (NumType Unsigned S64), "complexOf_uint64", "complexOf_uint64") , (ComplexType FloatType, "float complex", "complexOf_float") ] , values = [ (ComplexType (NumType Signed S8), (\cx -> "complex_fun_int8(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType (NumType Signed S16), (\cx -> "complex_fun_int16(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType (NumType Signed S32), (\cx -> "complex_fun_int32(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType (NumType Signed S64), (\cx -> "complex_fun_int64(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType (NumType Unsigned S8), (\cx-> "complex_fun_uint8(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType (NumType Unsigned S16), (\cx -> "complex_fun_uint16(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType (NumType Unsigned S32), (\cx -> "complex_fun_uint32(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType (NumType Unsigned S64), (\cx -> "complex_fun_uint64(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType FloatType, (\cx -> "(" ++ showRe cx ++ "+" ++ showIm cx ++ "i)")) ] , primitives = [ (FeldPrimDesc "(==)" [ComplexT IntT, ComplexT IntT], Left $ Fun "equal" firstInFP) -- Eq instanced for Bool, Int, Float, Complex (Eq.hs) , (FeldPrimDesc "(==)" [AllT, AllT], Left $ Op2 "==") , (FeldPrimDesc "(/=)" [ComplexT IntT, ComplexT IntT], Left $ Fun "!equal" firstInFP) , (FeldPrimDesc "(/=)" [AllT, AllT], Left $ Op2 "!=") , (FeldPrimDesc "(<)" [RealT, RealT], Left $ Op2 "<") -- Ord instanced for Int, Float (Ord.hs) , (FeldPrimDesc "(>)" [RealT, RealT], Left $ Op2 ">") , (FeldPrimDesc "(<=)" [RealT, RealT], Left $ Op2 "<=") , (FeldPrimDesc "(>=)" [RealT, RealT], Left $ Op2 ">=") , (FeldPrimDesc "not" [BoolT], Left $ Op1 "!") -- Logic operations for Bool (Logic.hs) , (FeldPrimDesc "(&&)" [BoolT, BoolT], Left $ Op2 "&&") , (FeldPrimDesc "(||)" [BoolT, BoolT], Left $ Op2 "||") , (FeldPrimDesc "quot" [IntT, IntT], Left $ Op2 "/") -- , (FeldPrimDesc "quot" [IntT, IntT], Right optimizedDivide) -- Integral instanced for Int (Integral.hs) -- This optimization is invalid for odd negative numbers , (FeldPrimDesc "rem" [IntT, IntT], Left $ Op2 "%") , (FeldPrimDesc "(^)" [IntT, IntT], Left $ Fun "pow" firstInFP) , (FeldPrimDesc "negate" [ComplexT FloatT], Left $ Op1 "-") -- Num instanced for Int, Float, Complex (Num.hs) , (FeldPrimDesc "negate" [ComplexT IntT], Left $ Fun "negate" firstInFP) , (FeldPrimDesc "negate" [RealT], Left $ Op1 "-") , (FeldPrimDesc "abs" [ComplexT FloatT], Left $ Fun "cabsf" noneFP) , (FeldPrimDesc "abs" [ComplexT IntT], Left $ Fun "abs" firstInFP) , (FeldPrimDesc "abs" [FloatT], Left $ Fun "fabsf" noneFP) , (FeldPrimDesc "abs" [IntTU], Left Assig) -- , (FeldPrimDesc "abs" [IntTS], Right absIntTS) , (FeldPrimDesc "abs" [IntTS], Left $ Fun "abs" firstInFP) , (FeldPrimDesc "signum" [ComplexT RealT], Left $ Fun "signum" firstInFP) -- , (FeldPrimDesc "signum" [RealT], Right signumRealT) , (FeldPrimDesc "signum" [RealT], Left $ Fun "signum" firstInFP) , (FeldPrimDesc "(+)" [ComplexT IntT, ComplexT IntT], Left $ Fun "add" firstInFP) , (FeldPrimDesc "(+)" [ComplexT FloatT, ComplexT FloatT], Left $ Op2 "+") , (FeldPrimDesc "(+)" [RealT, RealT], Left $ Op2 "+") , (FeldPrimDesc "(-)" [ComplexT IntT, ComplexT IntT], Left $ Fun "sub" firstInFP) , (FeldPrimDesc "(-)" [ComplexT FloatT, ComplexT FloatT], Left $ Op2 "-") , (FeldPrimDesc "(-)" [RealT, RealT], Right optimizedSubtract) , (FeldPrimDesc "(*)" [ComplexT IntT, ComplexT IntT], Left $ Fun "mult" firstInFP) , (FeldPrimDesc "(*)" [ComplexT FloatT, ComplexT FloatT], Left $ Op2 "*") , (FeldPrimDesc "(*)" [RealT, RealT], Right optimizedMultiply) , (FeldPrimDesc "(/)" [ComplexT FloatT, ComplexT FloatT], Left $ Op2 "/") -- Fractional instanced for Float, Complex Float (Fractional.hs) , (FeldPrimDesc "(/)" [FloatT, FloatT], Left $ Op2 "/") , (FeldPrimDesc "exp" [FloatT], Left $ Fun "expf" noneFP) -- Floating instanced for Float, Complex Float (Floating.hs) , (FeldPrimDesc "exp" [ComplexT FloatT], Left $ Fun "cexpf" noneFP) , (FeldPrimDesc "sqrt" [FloatT], Left $ Fun "sqrtf" noneFP) , (FeldPrimDesc "sqrt" [ComplexT FloatT], Left $ Fun "csqrtf" noneFP) , (FeldPrimDesc "log" [FloatT], Left $ Fun "logf" noneFP) , (FeldPrimDesc "log" [ComplexT FloatT], Left $ Fun "clogf" noneFP) , (FeldPrimDesc "(**)" [FloatT, FloatT], Left $ Fun "powf" noneFP) , (FeldPrimDesc "(**)" [ComplexT FloatT, ComplexT FloatT], Left $ Fun "cpowf" noneFP) , (FeldPrimDesc "logBase" [FloatT, FloatT], Left $ Fun "logBase" firstInFP) , (FeldPrimDesc "logBase" [ComplexT FloatT, ComplexT FloatT], Left $ Fun "logBase" firstInFP) , (FeldPrimDesc "sin" [FloatT], Left $ Fun "sinf" noneFP) , (FeldPrimDesc "sin" [ComplexT FloatT], Left $ Fun "csinf" noneFP) , (FeldPrimDesc "tan" [FloatT], Left $ Fun "tanf" noneFP) , (FeldPrimDesc "tan" [ComplexT FloatT], Left $ Fun "ctanf" noneFP) , (FeldPrimDesc "cos" [FloatT], Left $ Fun "cosf" noneFP) , (FeldPrimDesc "cos" [ComplexT FloatT], Left $ Fun "ccosf" noneFP) , (FeldPrimDesc "asin" [FloatT], Left $ Fun "asinf" noneFP) , (FeldPrimDesc "asin" [ComplexT FloatT], Left $ Fun "casinf" noneFP) , (FeldPrimDesc "atan" [FloatT], Left $ Fun "atanf" noneFP) , (FeldPrimDesc "atan" [ComplexT FloatT], Left $ Fun "catanf" noneFP) , (FeldPrimDesc "acos" [FloatT], Left $ Fun "acosf" noneFP) , (FeldPrimDesc "acos" [ComplexT FloatT], Left $ Fun "cacosf" noneFP) , (FeldPrimDesc "sinh" [FloatT], Left $ Fun "sinhf" noneFP) , (FeldPrimDesc "sinh" [ComplexT FloatT], Left $ Fun "csinhf" noneFP) , (FeldPrimDesc "tanh" [FloatT], Left $ Fun "tanhf" noneFP) , (FeldPrimDesc "tanh" [ComplexT FloatT], Left $ Fun "ctanhf" noneFP) , (FeldPrimDesc "cosh" [FloatT], Left $ Fun "coshf" noneFP) , (FeldPrimDesc "cosh" [ComplexT FloatT], Left $ Fun "ccoshf" noneFP) , (FeldPrimDesc "asinh" [FloatT], Left $ Fun "asinhf" noneFP) , (FeldPrimDesc "asinh" [ComplexT FloatT], Left $ Fun "casinhf" noneFP) , (FeldPrimDesc "atanh" [FloatT], Left $ Fun "atanhf" noneFP) , (FeldPrimDesc "atanh" [ComplexT FloatT], Left $ Fun "catanhf" noneFP) , (FeldPrimDesc "acosh" [FloatT], Left $ Fun "acoshf" noneFP) , (FeldPrimDesc "acosh" [ComplexT FloatT], Left $ Fun "cacoshf" noneFP) , (FeldPrimDesc "(.&.)" [IntT, IntT], Left $ Op2 "&") -- Bits instanced for Int (Bits.hs) , (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) , (FeldPrimDesc "complex" [RealT, RealT], Left $ Fun "complex" firstInFP) -- Complex operations for Complex (Complex.hs) , (FeldPrimDesc "creal" [ComplexT FloatT], Left $ Fun "crealf" noneFP) , (FeldPrimDesc "creal" [ComplexT IntT], Left $ Fun "creal" firstInFP) , (FeldPrimDesc "cimag" [ComplexT FloatT], Left $ Fun "cimagf" noneFP) , (FeldPrimDesc "cimag" [ComplexT IntT], Left $ Fun "cimag" firstInFP) , (FeldPrimDesc "conjugate" [ComplexT FloatT], Left $ Fun "conjf" noneFP) , (FeldPrimDesc "conjugate" [ComplexT IntT], Left $ Fun "conj" firstInFP) , (FeldPrimDesc "magnitude" [ComplexT FloatT], Left $ Fun "cabsf" noneFP) , (FeldPrimDesc "magnitude" [ComplexT IntT], Left $ Fun "magnitude" firstInFP) , (FeldPrimDesc "phase" [ComplexT FloatT], Left $ Fun "cargf" noneFP) , (FeldPrimDesc "phase" [ComplexT IntT], Left $ Fun "phase" firstInFP) , (FeldPrimDesc "mkPolar" [RealT, RealT], Left $ Fun "mkPolar" firstInFP) , (FeldPrimDesc "cis" [RealT], Left $ Fun "cis" firstInFP) , (FeldPrimDesc "f2i" [FloatT], Right (\_ [i] ot -> PrgDesc [] [] (Fnc Cas [Fnc (Fun "truncf" noneFP) [Exp i] FloatType] ot))) , (FeldPrimDesc "i2n" [IntT], Right i2n) , (FeldPrimDesc "b2i" [BoolT], Left $ Cas) , (FeldPrimDesc "round" [FloatT], Right (\_ [i] ot -> PrgDesc [] [] (Fnc Cas [Fnc (Fun "roundf" noneFP) [Exp i] FloatType] ot))) , (FeldPrimDesc "ceiling" [FloatT], Right (\_ [i] ot -> PrgDesc [] [] (Fnc Cas [Fnc (Fun "ceilf" noneFP) [Exp i] FloatType] ot))) , (FeldPrimDesc "floor" [FloatT], Right (\_ [i] ot -> PrgDesc [] [] (Fnc Cas [Fnc (Fun "floorf" noneFP) [Exp i] FloatType] ot))) ] , includes = ["\"feldspar_c99.h\"", "\"feldspar_array.h\"", "", "", "", ""], isRestrict = NoRestrict } tic64x = Platform { name = "tic64x", types = [ (NumType Signed S8, "char", "char") , (NumType Signed S16, "short", "short") , (NumType Signed S32, "int", "int") , (NumType Signed S40, "long", "long") , (NumType Signed S64, "long long","llong") , (NumType Unsigned S8, "unsigned char", "uchar") , (NumType Unsigned S16, "unsigned short", "ushort") , (NumType Unsigned S32, "unsigned", "uint") , (NumType Unsigned S40, "unsigned long", "ulong") , (NumType Unsigned S64, "unsigned long long", "ullong") , (BoolType, "int", "int") , (FloatType, "float", "float") , (ComplexType (NumType Signed S8), "complexOf_char", "complexOf_char") , (ComplexType (NumType Signed S16), "unsigned", "complexOf_short") , (ComplexType (NumType Signed S32), "complexOf_int", "complexOf_int") , (ComplexType (NumType Signed S40), "complexOf_long", "complexOf_long") , (ComplexType (NumType Signed S64), "complexOf_llong", "complexOf_llong") , (ComplexType (NumType Unsigned S8), "complexOf_uchar", "complexOf_uchar") , (ComplexType (NumType Unsigned S16), "unsigned", "complexOf_ushort") , (ComplexType (NumType Unsigned S32), "complexOf_uint", "complexOf_uint") , (ComplexType (NumType Unsigned S40), "complexOf_ulong", "complexOf_ulong") , (ComplexType (NumType Unsigned S64), "complexOf_ullong", "complexOf_ullong") , (ComplexType FloatType, "complexOf_float", "complexOf_float") ] , values = [ (ComplexType (NumType Signed S8), (\cx -> "complex_fun_char(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType (NumType Signed S16), (\cx -> "_pack2(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType (NumType Signed S32), (\cx -> "complex_fun_int(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType (NumType Signed S40), (\cx -> "complex_fun_long(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType (NumType Signed S64), (\cx -> "complex_fun_llong(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType (NumType Unsigned S8), (\cx -> "complex_fun_uchar(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType (NumType Unsigned S16), (\cx -> "_pack2(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType (NumType Unsigned S32), (\cx -> "complex_fun_uint(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType (NumType Unsigned S40), (\cx -> "complex_fun_ulong(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType (NumType Unsigned S64), (\cx -> "complex_fun_ullong(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) , (ComplexType FloatType, (\cx -> "complex_fun_float(" ++ showRe cx ++ "," ++ showIm cx ++ ")")) ] , primitives = [ (FeldPrimDesc "(==)" [ComplexT FloatT, ComplexT FloatT], Left $ Fun "equal" firstInFP) , (FeldPrimDesc "(==)" [ComplexT (IntT_ S16), ComplexT (IntT_ S16)], Left $ Op2 "==") , (FeldPrimDesc "(/=)" [ComplexT FloatT, ComplexT FloatT], Left $ Fun "!equal" firstInFP) , (FeldPrimDesc "(/=)" [ComplexT (IntT_ S16), ComplexT (IntT_ S16)], Left $ Op2 "!=") , (FeldPrimDesc "negate" [ComplexT FloatT], Left $ Fun "negate" firstInFP) , (FeldPrimDesc "negate" [ComplexT (IntT_ S16)], Right (\_ [i] ot -> PrgDesc [] [] (Fnc (Fun "_sub2" noneFP) [Exp $ intToCe 0, Exp i] ot))) , (FeldPrimDesc "abs" [ComplexT FloatT], Left $ Fun "abs" firstInFP) , (FeldPrimDesc "abs" [FloatT], Left $ Fun "_fabsf" noneFP) , (FeldPrimDesc "abs" [IntTS_ S32], Left $ Fun "_abs" noneFP) , (FeldPrimDesc "(+)" [ComplexT FloatT, ComplexT FloatT], Left $ Fun "add" firstInFP) , (FeldPrimDesc "(+)" [ComplexT (IntT_ S16), ComplexT (IntT_ S16)], Left $ Fun "_add2" noneFP) , (FeldPrimDesc "(-)" [ComplexT FloatT, ComplexT FloatT], Left $ Fun "sub" firstInFP) , (FeldPrimDesc "(-)" [ComplexT (IntT_ S16), ComplexT (IntT_ S16)], Left $ Fun "_sub2" noneFP) , (FeldPrimDesc "(*)" [ComplexT FloatT, ComplexT FloatT], Left $ Fun "mult" firstInFP) -- , (FeldPrimDesc "(*)" [ComplexT (IntT_ S16), ComplexT (IntT_ S16)], Left $ Fun "_cmpyr" noneFP) -- Just on TI C64x+ , (FeldPrimDesc "(/)" [ComplexT FloatT, ComplexT FloatT], Left $ Fun "div" firstInFP) , (FeldPrimDesc "exp" [ComplexT FloatT], Left $ Fun "exp" firstInFP) , (FeldPrimDesc "sqrt" [ComplexT FloatT], Left $ Fun "sqrt" firstInFP) , (FeldPrimDesc "log" [ComplexT FloatT], Left $ Fun "log" firstInFP) , (FeldPrimDesc "(**)" [ComplexT FloatT, ComplexT FloatT], Left $ Fun "cpow" firstInFP) , (FeldPrimDesc "logBase" [ComplexT FloatT, ComplexT FloatT], Left $ Fun "logBase" firstInFP) , (FeldPrimDesc "sin" [ComplexT FloatT], Left $ Fun "sin" firstInFP) , (FeldPrimDesc "tan" [ComplexT FloatT], Left $ Fun "tan" firstInFP) , (FeldPrimDesc "cos" [ComplexT FloatT], Left $ Fun "cos" firstInFP) , (FeldPrimDesc "asin" [ComplexT FloatT], Left $ Fun "asin" firstInFP) , (FeldPrimDesc "atan" [ComplexT FloatT], Left $ Fun "atan" firstInFP) , (FeldPrimDesc "acos" [ComplexT FloatT], Left $ Fun "acos" firstInFP) , (FeldPrimDesc "sinh" [ComplexT FloatT], Left $ Fun "sinh" firstInFP) , (FeldPrimDesc "tanh" [ComplexT FloatT], Left $ Fun "tanh" firstInFP) , (FeldPrimDesc "cosh" [ComplexT FloatT], Left $ Fun "cosh" firstInFP) , (FeldPrimDesc "asinh" [ComplexT FloatT], Left $ Fun "asinh" firstInFP) , (FeldPrimDesc "atanh" [ComplexT FloatT], Left $ Fun "atanh" firstInFP) , (FeldPrimDesc "acosh" [ComplexT FloatT], Left $ Fun "acosh" firstInFP) , (FeldPrimDesc "rotateL" [IntTU_ S32, IntT], Left $ Fun "_rotl" noneFP) , (FeldPrimDesc "reverseBits" [IntTU_ S32], Left $ Fun "_bitr" noneFP) , (FeldPrimDesc "bitCount" [IntTU_ S32], Right optimizedBitCount) , (FeldPrimDesc "complex" [IntT_ S16, IntT_ S16], Left $ Fun "_pack2" noneFP) , (FeldPrimDesc "creal" [ComplexT FloatT], Left $ Fun "creal" firstInFP) , (FeldPrimDesc "cimag" [ComplexT FloatT], Left $ Fun "cimag" firstInFP) , (FeldPrimDesc "conjugate" [ComplexT FloatT], Left $ Fun "conj" firstInFP) , (FeldPrimDesc "magnitude" [ComplexT FloatT], Left $ Fun "magnitude" firstInFP) , (FeldPrimDesc "phase" [ComplexT FloatT], Left $ Fun "phase" firstInFP) , (FeldPrimDesc "i2n" [IntT_ S16], Right (\_ [i] ot -> PrgDesc [] [] (Fnc (Fun "_pack2" noneFP) [Exp i, Exp $ intToCe 0] ot))) ] ++ primitives c99, includes = ["\"feldspar_tic64x.h\"", "\"feldspar_array.h\"", "", "", ""], isRestrict = Restrict } optimizedSubtract :: TransformPrim optimizedSubtract _ [x, y] ot = case (x,y) of ((ConstExpr (IntConst 0 _ _) _), _) -> PrgDesc [] [] (Fnc (Op1 "-") [Exp y] ot) (_, _) -> PrgDesc [] [] (Fnc (Op2 "-") [Exp x, Exp y] ot) optimizedMultiply :: TransformPrim optimizedMultiply _ [x, y] ot = case (x,y) of (_, (ConstExpr (IntConst _ _ _) _)) -> optimizedMultiply' x y ((ConstExpr (IntConst _ _ _) _), _) -> optimizedMultiply' y x (_, _conjugate) -> PrgDesc [] [] (Fnc (Op2 "*") [Exp x, Exp y] ot) where optimizedMultiply' int con | (machTypes IntT $ typeof int) && (con' >= 0) && (2 ^ (numberOfTwoPrimeFactors con') == con') = PrgDesc [] [] (Fnc (Op2 "<<") [Exp int, Exp $ intToCe $ numberOfTwoPrimeFactors con'] ot) | (machTypes IntT $ typeof int) && (con' < 0) && (2 ^ (numberOfTwoPrimeFactors $ con' * (-1)) == con' * (-1)) = PrgDesc [] [] (Fnc (Op1 "-") [Fnc (Op2 "<<") [Exp int, Exp $ intToCe $ numberOfTwoPrimeFactors $ con' * (-1)] ot] ot) | otherwise = PrgDesc [] [] (Fnc (Op2 "*") [Exp x, Exp y] ot) where con' = ceToInt con -- optimizedDivide :: TransformPrim -- optimizedDivide _ [x, y] ot = case (x,y) of -- (_, (ConstExpr (IntConst _ _ _) _)) -> optimizedDivide' x y -- (_, _) -> PrgDesc [] [] (Fnc (Op2 "/") [Exp x, Exp y] ot) -- where -- optimizedDivide' int con -- | (machTypes IntT $ typeof int) -- && (con' >= 0) -- && (2 ^ (numberOfTwoPrimeFactors con') == con') -- = PrgDesc [] [] (Fnc (Op2 ">>") [Exp int, Exp $ intToCe $ numberOfTwoPrimeFactors con'] ot) -- | (machTypes IntT $ typeof int) -- && (con' < 0) -- && (2 ^ (numberOfTwoPrimeFactors $ con' * (-1)) == con' * (-1)) -- = PrgDesc [] [] (Fnc (Op1 "-") [Fnc (Op2 ">>") [Exp int, Exp $ intToCe $ numberOfTwoPrimeFactors $ con' * (-1)] ot] ot) -- | otherwise = PrgDesc [] [] (Fnc (Op2 "/") [Exp x, Exp y] ot) -- where -- con' = ceToInt con bitFunToShift _ [i] ot = PrgDesc [] [] (Fnc (Op2 "<<") [Exp $ intToCe 1, Exp i] ot) bitSizeFunToConst :: TransformPrim bitSizeFunToConst _ [i] _ = case (typeof i) of (NumType _ s) -> PrgDesc [] [] (Exp $ intToCe $ sizeToInt s) isSignedFunToConst :: TransformPrim isSignedFunToConst _ [i] _ = case (typeof i) of (NumType Signed _) -> PrgDesc [] [] (Exp $ boolToCe True) (NumType Unsigned _) -> PrgDesc [] [] (Exp $ boolToCe False) i2n :: TransformPrim i2n _ [i] ot@(ComplexType _) = PrgDesc [] [] (Fnc (Fun "complex" firstInFP) [Exp i, Exp $ intToCe 0] ot) i2n _ [i] ot = PrgDesc [] [] (Fnc Cas [Exp i] ot) optimizedBitCount :: TransformPrim optimizedBitCount _ [i] ot = PrgDesc [] [] (Fnc (Fun "_dotpu4" noneFP) [Fnc (Fun "_bitc4" noneFP) [Exp i] ot, Exp $ intToCe 0x01010101] ot) -- absIntTS :: TransformPrim -- absIntTS _ [i] ot@(NumType _ s) -- = PrgDesc -- [Crt ot (Var "mask") (Just $ Fnc (Op2 ">>") [Exp i, Exp $ intToCe $ sizeToInt s - 1] ot)] -- [] -- (Fnc (Op2 "^") [Fnc (Op2 "+") [Exp i, VarR (Var "mask")] ot, VarR (Var "mask")] ot) -- signumRealT :: TransformPrim -- signumRealT _ [i] ot@(NumType Signed s) = PrgDesc [] [] (Fnc (Op2 "|") [Fnc (Op2 "!=") [Exp i, Exp $ intToCe 0] ot, Fnc (Op2 ">>") [Exp i, Exp $ intToCe $ sizeToInt s - 1] ot] ot) -- signumRealT _ [i] ot@(NumType Unsigned s) = PrgDesc [] [] (Fnc (Op2 ">") [Exp i, Exp $ intToCe 0] ot) -- signumRealT _ [i] ot@(FloatType) = PrgDesc [] [] (Fnc (Op2 "-") [Fnc (Op2 ">") [Exp i, Exp $ intToCe 0] ot, Fnc (Op2 "<") [Exp i, Exp $ intToCe 0] ot] ot) numberOfTwoPrimeFactors 2 = 1 numberOfTwoPrimeFactors x | x `mod` 2 == 0 = (numberOfTwoPrimeFactors $ x `div` 2) + 1 | otherwise = 0 sizeToInt :: Size -> Integer sizeToInt S8 = 8 sizeToInt S16 = 16 sizeToInt S32 = 32 sizeToInt S40 = 40 sizeToInt S64 = 64 ceToInt (ConstExpr (IntConst x _ _) _) = x intToCe x = ConstExpr (IntConst x () ()) () boolToCe x = ConstExpr (BoolConst x () ()) () showRe = showConstant . realPartComplexValue showIm = showConstant . imagPartComplexValue showConstant (IntConst c _ _) = show c showConstant (FloatConst c _ _) = show c ++ "f"