git.iko.soy/Idris-dev
on master help sign in
Vector FFI and bitcasts
f0c1e19Benjamin Saunders
lib/IO.idr+17−1
compare with master
unifiedsplit
@@ -21,7 +21,7 @@ io_return x = prim__IO x
21run__IO : IO () -> IO ()
21run__IO : IO () -> IO ()
22run__IO v = io_bind v (\v' => io_return v')
22run__IO v = io_bind v (\v' => io_return v')
23
23
24−data IntTy = ITChar | ITNative | IT8 | IT16 | IT32 | IT64
24+data IntTy = ITChar | ITNative | IT8 | IT16 | IT32 | IT64 | IT8x16 | IT16x8 | IT32x4 | IT64x2
25data FTy = FIntT IntTy
25data FTy = FIntT IntTy
26 | FFunction FTy FTy
26 | FFunction FTy FTy
27 | FFloat
27 | FFloat
@@ -45,6 +45,18 @@ FShort = FIntT IT16
45FLong : FTy
45FLong : FTy
46FLong = FIntT IT64
46FLong = FIntT IT64
47
47
48+FBits8x16 : FTy
49+FBits8x16 = FIntT IT8x16
50+
51+FBits16x8 : FTy
52+FBits16x8 = FIntT IT16x8
53+
54+FBits32x4 : FTy
55+FBits32x4 = FIntT IT32x4
56+
57+FBits64x2 : FTy
58+FBits64x2 = FIntT IT64x2
59+
48interpFTy : FTy -> Type
60interpFTy : FTy -> Type
49interpFTy (FIntT ITNative) = Int
61interpFTy (FIntT ITNative) = Int
50interpFTy (FIntT ITChar) = Char
62interpFTy (FIntT ITChar) = Char
@@ -56,6 +68,10 @@ interpFTy (FAny t) = t
56interpFTy FFloat = Float
68interpFTy FFloat = Float
57interpFTy FString = String
69interpFTy FString = String
58interpFTy FPtr = Ptr
70interpFTy FPtr = Ptr
71+interpFTy (FIntT IT8x16) = Bits8x16
72+interpFTy (FIntT IT16x8) = Bits16x8
73+interpFTy (FIntT IT32x4) = Bits32x4
74+interpFTy (FIntT IT64x2) = Bits64x2
59interpFTy FUnit = ()
75interpFTy FUnit = ()
60
76
61interpFTy (FFunction a b) = interpFTy a -> interpFTy b
77interpFTy (FFunction a b) = interpFTy a -> interpFTy b
src/IRTS/Compiler.hs+4
@@ -310,6 +310,10 @@ mkIty "FPtr" = FPtr
310mkIty "FUnit" = FUnit
310mkIty "FUnit" = FUnit
311mkIty "FFunction" = FFunction
311mkIty "FFunction" = FFunction
312mkIty "FFunctionIO" = FFunctionIO
312mkIty "FFunctionIO" = FFunctionIO
313+mkIty "FBits8x16" = FArith (ATInt (ITVec IT8 16))
314+mkIty "FBits16x8" = FArith (ATInt (ITVec IT16 8))
315+mkIty "FBits32x4" = FArith (ATInt (ITVec IT32 4))
316+mkIty "FBits64x2" = FArith (ATInt (ITVec IT64 2))
313mkIty x = error $ "Unknown type " ++ x
317mkIty x = error $ "Unknown type " ++ x
314
318
315mkIntIty "ITNative" = FArith (ATInt ITNative)
319mkIntIty "ITNative" = FArith (ATInt ITNative)
src/IRTS/Lang.hs+1
@@ -38,6 +38,7 @@ data PrimFn = LPlus ArithTy | LMinus ArithTy | LTimes ArithTy
38 | LIntFloat IntTy | LFloatInt IntTy | LIntStr IntTy | LStrInt IntTy
38 | LIntFloat IntTy | LFloatInt IntTy | LIntStr IntTy | LStrInt IntTy
39 | LFloatStr | LStrFloat | LChInt IntTy | LIntCh IntTy
39 | LFloatStr | LStrFloat | LChInt IntTy | LIntCh IntTy
40 | LPrintNum | LPrintStr | LReadStr
40 | LPrintNum | LPrintStr | LReadStr
41+ | LBitCast ArithTy ArithTy -- Only for values of equal width
41
42
42 | LFExp | LFLog | LFSin | LFCos | LFTan | LFASin | LFACos | LFATan
43 | LFExp | LFLog | LFSin | LFCos | LFTan | LFASin | LFACos | LFATan
43 | LFSqrt | LFFloor | LFCeil
44 | LFSqrt | LFFloor | LFCeil
src/Idris/Primitives.hs+85−4
@@ -12,6 +12,7 @@ import Data.Bits
12import Data.Word
12import Data.Word
13import Data.Int
13import Data.Int
14import Data.Char
14import Data.Char
15+import Data.Vector.Unboxed (Vector)
15import qualified Data.Vector.Unboxed as V
16import qualified Data.Vector.Unboxed as V
16
17
17data Prim = Prim { p_name :: Name,
18data Prim = Prim { p_name :: Name,
@@ -169,7 +170,11 @@ primitives =
169 Prim (UN "prim__stdin") (ty [] PtrType) 0 (p_cantreduce)
170 Prim (UN "prim__stdin") (ty [] PtrType) 0 (p_cantreduce)
170 (0, LStdIn) partial
171 (0, LStdIn) partial
171 ] ++ concatMap intOps [ITFixed IT8, ITFixed IT16, ITFixed IT32, ITFixed IT64, ITBig, ITNative, ITChar]
172 ] ++ concatMap intOps [ITFixed IT8, ITFixed IT16, ITFixed IT32, ITFixed IT64, ITBig, ITNative, ITChar]
173+ ++ concatMap vecOps vecTypes
174+ ++ vecBitcasts vecTypes
175+
176+vecTypes :: [IntTy]
172− ++ concatMap vecOps [ITVec IT8 16, ITVec IT16 8, ITVec IT32 4, ITVec IT64 2]
177+vecTypes = [ITVec IT8 16, ITVec IT16 8, ITVec IT32 4, ITVec IT64 2]
173
178
174intOps :: IntTy -> [Prim]
179intOps :: IntTy -> [Prim]
175intOps ity = intCmps ity ++ intArith ity ++ intConv ity
180intOps ity = intCmps ity ++ intArith ity ++ intConv ity
@@ -236,6 +241,81 @@ vecOps ity@(ITVec elem count) =
236 3 (mkVecUpdate elem count) (3, LUpdateVec elem count) partial -- TODO: Ensure this reduces
241 3 (mkVecUpdate elem count) (3, LUpdateVec elem count) partial -- TODO: Ensure this reduces
237 ] ++ intArith ity ++ vecCmps ity
242 ] ++ intArith ity ++ vecCmps ity
238
243
244+bitcastPrim :: ArithTy -> ArithTy -> (ArithTy -> [Const] -> Maybe Const) -> PrimFn -> Prim
245+bitcastPrim from to impl prim =
246+ Prim (UN $ "prim__bitcast" ++ aTyName from ++ "_" ++ aTyName to) (ty [AType from] (AType to)) 1 (impl to)
247+ (1, prim) total
248+
249+vecBitcasts :: [IntTy] -> [Prim]
250+vecBitcasts tys = [bitcastPrim from to bitcastVec (LBitCast from to)
251+ | from <- map ATInt vecTypes, to <- map ATInt vecTypes, from /= to]
252+
253+mapHalf :: (V.Unbox a, V.Unbox b) => ((a, a) -> b) -> Vector a -> Vector b
254+mapHalf f xs = V.generate (V.length xs `div` 2) (\i -> f (xs V.! (i*2), xs V.! (i*2+1)))
255+
256+mapDouble :: (V.Unbox a, V.Unbox b) => (Bool -> a -> b) -> Vector a -> Vector b
257+mapDouble f xs = V.generate (V.length xs * 2) (\i -> f (i `rem` 2 == 0) (xs V.! (i `div` 2)))
258+
259+concatWord8 :: (Word8, Word8) -> Word16
260+concatWord8 (high, low) = fromIntegral high .|. (fromIntegral low `shiftL` 8)
261+
262+concatWord16 :: (Word16, Word16) -> Word32
263+concatWord16 (high, low) = fromIntegral high .|. (fromIntegral low `shiftL` 16)
264+
265+concatWord32 :: (Word32, Word32) -> Word64
266+concatWord32 (high, low) = fromIntegral high .|. (fromIntegral low `shiftL` 32)
267+
268+truncWord16 :: Bool -> Word16 -> Word8
269+truncWord16 True x = fromIntegral (x `shiftR` 8)
270+truncWord16 False x = fromIntegral x
271+
272+truncWord32 :: Bool -> Word32 -> Word16
273+truncWord32 True x = fromIntegral (x `shiftR` 16)
274+truncWord32 False x = fromIntegral x
275+
276+truncWord64 :: Bool -> Word64 -> Word32
277+truncWord64 True x = fromIntegral (x `shiftR` 32)
278+truncWord64 False x = fromIntegral x
279+
280+bitcastVec :: ArithTy -> [Const] -> Maybe Const
281+bitcastVec (ATInt (ITVec IT8 n)) [x@(B8V v)]
282+ | V.length v == n = Just x
283+bitcastVec (ATInt (ITVec IT16 n)) [B8V v]
284+ | V.length v == n*2 = Just . B16V . mapHalf concatWord8 $ v
285+bitcastVec (ATInt (ITVec IT32 n)) [B8V v]
286+ | V.length v == n*4 = Just . B32V . mapHalf concatWord16 . mapHalf concatWord8 $ v
287+bitcastVec (ATInt (ITVec IT64 n)) [B8V v]
288+ | V.length v == n*8 = Just . B64V . mapHalf concatWord32 . mapHalf concatWord16 . mapHalf concatWord8 $ v
289+
290+bitcastVec (ATInt (ITVec IT8 n)) [B16V v]
291+ | V.length v * 2 == n = Just . B8V . mapDouble truncWord16 $ v
292+bitcastVec (ATInt (ITVec IT16 n)) [x@(B16V v)]
293+ | V.length v == n = Just x
294+bitcastVec (ATInt (ITVec IT32 n)) [B16V v]
295+ | V.length v == n*2 = Just . B32V . mapHalf concatWord16 $ v
296+bitcastVec (ATInt (ITVec IT64 n)) [B16V v]
297+ | V.length v == n*4 = Just . B64V . mapHalf concatWord32 . mapHalf concatWord16 $ v
298+
299+bitcastVec (ATInt (ITVec IT8 n)) [B32V v]
300+ | V.length v * 4 == n = Just . B8V . mapDouble truncWord16 . mapDouble truncWord32 $ v
301+bitcastVec (ATInt (ITVec IT16 n)) [B32V v]
302+ | V.length v * 2 == n = Just . B16V . mapDouble truncWord32 $ v
303+bitcastVec (ATInt (ITVec IT32 n)) [x@(B32V v)]
304+ | V.length v == n = Just x
305+bitcastVec (ATInt (ITVec IT64 n)) [B32V v]
306+ | V.length v == n*2 = Just . B64V . mapHalf concatWord32 $ v
307+
308+bitcastVec (ATInt (ITVec IT8 n)) [B64V v]
309+ | V.length v * 8 == n = Just . B8V . mapDouble truncWord16 . mapDouble truncWord32 . mapDouble truncWord64 $ v
310+bitcastVec (ATInt (ITVec IT16 n)) [B64V v]
311+ | V.length v * 4 == n = Just . B16V . mapDouble truncWord32 . mapDouble truncWord64 $ v
312+bitcastVec (ATInt (ITVec IT32 n)) [B64V v]
313+ | V.length v == n*2 = Just . B32V . mapDouble truncWord64 $ v
314+bitcastVec (ATInt (ITVec IT64 n)) [x@(B64V v)]
315+ | V.length v == n = Just x
316+
317+bitcastVec _ _ = Nothing
318+
239mkVecCon :: NativeTy -> Int -> [Const] -> Maybe Const
319mkVecCon :: NativeTy -> Int -> [Const] -> Maybe Const
240mkVecCon ity count args
320mkVecCon ity count args
241 | length ints == count = Just (mkVec ity count ints)
321 | length ints == count = Just (mkVec ity count ints)
@@ -265,6 +345,10 @@ mkVecUpdate ity count [vec, B32 i, newElem] = updateVec vec newElem
265 updateVec (B32V v) (B32 e) = Just . B32V $ V.unsafeUpdate v (V.singleton (fromIntegral i, e))
345 updateVec (B32V v) (B32 e) = Just . B32V $ V.unsafeUpdate v (V.singleton (fromIntegral i, e))
266 updateVec (B64V v) (B64 e) = Just . B64V $ V.unsafeUpdate v (V.singleton (fromIntegral i, e))
346 updateVec (B64V v) (B64 e) = Just . B64V $ V.unsafeUpdate v (V.singleton (fromIntegral i, e))
267
347
348+aTyName :: ArithTy -> String
349+aTyName (ATInt t) = intTyName t
350+aTyName ATFloat = "Float"
351+
268intTyName :: IntTy -> String
352intTyName :: IntTy -> String
269intTyName ITNative = "Int"
353intTyName ITNative = "Int"
270intTyName ITBig = "BigInt"
354intTyName ITBig = "BigInt"
@@ -553,6 +637,3 @@ p_strRev _ = Nothing
553
637
554p_cantreduce :: a -> Maybe b
638p_cantreduce :: a -> Maybe b
555p_cantreduce _ = Nothing
639p_cantreduce _ = Nothing
556−
557−
558−