@@ -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)
@@ -264,6 +344,12 @@ mkVecUpdate ity count [vec, B32 i, newElem] = updateVec vec newElem
264344 updateVec (B16V v) (B16 e) = Just . B16V $ V.unsafeUpdate v (V.singleton (fromIntegral i, e))
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))
347+ updateVec _ _ = Nothing
348+mkVecUpdate _ _ _ = Nothing
349+
350+aTyName :: ArithTy -> String
351+aTyName (ATInt t) = intTyName t
352+aTyName ATFloat = "Float"
267353
268354intTyName :: IntTy -> String
269355intTyName ITNative = "Int"
@@ -448,20 +534,22 @@ toInt ITNative x = I (fromIntegral x)
448534toInt ITChar x = Ch (chr $ fromIntegral x)
449535
450536intToInt :: IntTy -> IntTy -> [Const] -> Maybe Const
451−intToInt (ITFixed IT8) out [B8 x] = Just $ toInt out x
537+intToInt (ITFixed IT8) out [B8 x] = Just $ toInt out x
452538intToInt (ITFixed IT16) out [B16 x] = Just $ toInt out x
453539intToInt (ITFixed IT32) out [B32 x] = Just $ toInt out x
454540intToInt (ITFixed IT64) out [B64 x] = Just $ toInt out x
455−intToInt ITBig out [BI x] = Just $ toInt out x
456−intToInt ITNative out [I x] = Just $ toInt out x
457−intToInt ITChar out [Ch x] = Just $ toInt out (ord x)
541+intToInt ITBig out [BI x] = Just $ toInt out x
542+intToInt ITNative out [I x] = Just $ toInt out x
543+intToInt ITChar out [Ch x] = Just $ toInt out (ord x)
458544intToInt _ _ _ = Nothing
459545
460546zext :: IntTy -> IntTy -> [Const] -> Maybe Const
461547zext from ITBig val = intToInt from ITBig val
462548zext ITBig _ _ = Nothing
463−zext from to val
464− | intTyWidth from < intTyWidth to = intToInt from to val
549+zext f@(ITFixed from) t@(ITFixed to) val
550+ | nativeTyWidth from < nativeTyWidth to = intToInt f t val
551+zext ITNative to [I x] = Just $ toInt to (fromIntegral x :: Word)
552+zext from ITNative val = intToInt from ITNative val
465553zext _ _ _ = Nothing
466554
467555sext :: IntTy -> IntTy -> [Const] -> Maybe Const
@@ -475,7 +563,9 @@ sext from to val = intToInt from to val
475563trunc :: IntTy -> IntTy -> [Const] -> Maybe Const
476564trunc ITBig to val = intToInt ITBig to val
477565trunc _ ITBig _ = Nothing
478−trunc from to val | intTyWidth from > intTyWidth to = intToInt from to val
566+trunc f@(ITFixed from) t@(ITFixed to) val | nativeTyWidth from > nativeTyWidth to = intToInt f t val
567+trunc ITNative to [I x] = Just $ toInt to x
568+trunc from ITNative val = intToInt from ITNative val
479569trunc _ _ _ = Nothing
480570
481571intToStr :: [Const] -> Maybe Const
@@ -553,6 +643,3 @@ p_strRev _ = Nothing
553643
554644p_cantreduce :: a -> Maybe b
555645p_cantreduce _ = Nothing
556−
557−
558−