@@ -12,6 +12,7 @@ import Data.Bits
1212import Data.Word
1313import Data.Int
1414import Data.Char
15+import Data.Vector.Unboxed (Vector)
1516import qualified Data.Vector.Unboxed as V
1617
1718data Prim = Prim { p_name :: Name,
@@ -169,7 +170,11 @@ primitives =
169170 Prim (UN "prim__stdin") (ty [] PtrType) 0 (p_cantreduce)
170171 (0, LStdIn) partial
171172 ] ++ concatMap intOps [ITFixed IT8, ITFixed IT16, ITFixed IT32, ITFixed IT64, ITBig, ITNative, ITChar]
172− ++ concatMap vecOps [ITVec IT8 16, ITVec IT16 8, ITVec IT32 4, ITVec IT64 2]
173+ ++ concatMap vecOps vecTypes
174+ ++ vecBitcasts vecTypes
175+
176+vecTypes :: [IntTy]
177+vecTypes = [ITVec IT8 16, ITVec IT16 8, ITVec IT32 4, ITVec IT64 2]
173178
174179intOps :: IntTy -> [Prim]
175180intOps ity = intCmps ity ++ intArith ity ++ intConv ity
@@ -236,6 +241,81 @@ vecOps ity@(ITVec elem count) =
236241 3 (mkVecUpdate elem count) (3, LUpdateVec elem count) partial -- TODO: Ensure this reduces
237242 ] ++ intArith ity ++ vecCmps ity
238243
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+
239319mkVecCon :: NativeTy -> Int -> [Const] -> Maybe Const
240320mkVecCon ity count args
241321 | length ints == count = Just (mkVec ity count ints)
@@ -265,6 +345,10 @@ mkVecUpdate ity count [vec, B32 i, newElem] = updateVec vec newElem
265345 updateVec (B32V v) (B32 e) = Just . B32V $ V.unsafeUpdate v (V.singleton (fromIntegral i, e))
266346 updateVec (B64V v) (B64 e) = Just . B64V $ V.unsafeUpdate v (V.singleton (fromIntegral i, e))
267347
348+aTyName :: ArithTy -> String
349+aTyName (ATInt t) = intTyName t
350+aTyName ATFloat = "Float"
351+
268352intTyName :: IntTy -> String
269353intTyName ITNative = "Int"
270354intTyName ITBig = "BigInt"
@@ -553,6 +637,3 @@ p_strRev _ = Nothing
553637
554638p_cantreduce :: a -> Maybe b
555639p_cantreduce _ = Nothing
556−
557−
558−