68c5bb7 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Merge pull request #390 from Ralith/vector-ftypes

68c5bb7Edwin Brady13 years ago

lib/IO.idr+29−1

compare with master

unifiedsplit

@@ -21,7 +21,7 @@ io_return x = prim__IO x

21run__IO : IO () -> IO ()

22run__IO v = io_bind v (\v' => io_return v')

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

26 | FFunction FTy FTy

27 | FFloat

@@ -45,6 +45,30 @@ FShort = FIntT IT16

45FLong : FTy

46FLong = FIntT IT64

48+FBits8 : FTy

49+FBits8 = FIntT IT8

50+

51+FBits16 : FTy

52+FBits16 = FIntT IT16

53+

54+FBits32 : FTy

55+FBits32 = FIntT IT32

56+

57+FBits64 : FTy

58+FBits64 = FIntT IT64

59+

60+FBits8x16 : FTy

61+FBits8x16 = FIntT IT8x16

62+

63+FBits16x8 : FTy

64+FBits16x8 = FIntT IT16x8

65+

66+FBits32x4 : FTy

67+FBits32x4 = FIntT IT32x4

68+

69+FBits64x2 : FTy

70+FBits64x2 = FIntT IT64x2

71+

48interpFTy : FTy -> Type

72interpFTy : FTy -> Type

49interpFTy (FIntT ITNative) = Int

73interpFTy (FIntT ITNative) = Int

50interpFTy (FIntT ITChar) = Char

74interpFTy (FIntT ITChar) = Char

@@ -56,6 +80,10 @@ interpFTy (FAny t) = t

56interpFTy FFloat = Float

80interpFTy FFloat = Float

57interpFTy FString = String

81interpFTy FString = String

58interpFTy FPtr = Ptr

82interpFTy FPtr = Ptr

83+interpFTy (FIntT IT8x16) = Bits8x16

84+interpFTy (FIntT IT16x8) = Bits16x8

85+interpFTy (FIntT IT32x4) = Bits32x4

86+interpFTy (FIntT IT64x2) = Bits64x2

59interpFTy FUnit = ()

87interpFTy FUnit = ()

61interpFTy (FFunction a b) = interpFTy a -> interpFTy b

89interpFTy (FFunction a b) = interpFTy a -> interpFTy b

src/IRTS/CodegenLLVM.hs+5

@@ -921,6 +921,11 @@ cgOp (LUpdateVec ety c) [v,i,e] = do

921 nv' <- inst $ InsertElement nv ne ni []

922 box fty nv'

923

924+cgOp (LBitCast from to) [x] = do

925+ nx <- unbox (FArith from) x

926+ nx' <- inst $ BitCast nx (ftyToTy (FArith to)) []

927+ box (FArith to) nx'

928+

924cgOp LStrEq [x,y] = do

929cgOp LStrEq [x,y] = do

925 x' <- unbox FString x

930 x' <- unbox FString x

926 y' <- unbox FString y

931 y' <- unbox FString y

src/IRTS/Compiler.hs+8

@@ -309,11 +309,19 @@ mkIty "FChar" = mkIntIty "ITChar"

309mkIty "FByte" = mkIntIty "IT8"

310mkIty "FShort" = mkIntIty "IT16"

311mkIty "FLong" = mkIntIty "IT64"

312+mkIty "FBits8" = mkIntIty "IT8"

313+mkIty "FBits16" = mkIntIty "IT16"

314+mkIty "FBits32" = mkIntIty "IT32"

315+mkIty "FBits64" = mkIntIty "IT64"

312mkIty "FString" = FString

316mkIty "FString" = FString

313mkIty "FPtr" = FPtr

317mkIty "FPtr" = FPtr

314mkIty "FUnit" = FUnit

318mkIty "FUnit" = FUnit

315mkIty "FFunction" = FFunction

319mkIty "FFunction" = FFunction

316mkIty "FFunctionIO" = FFunctionIO

320mkIty "FFunctionIO" = FFunctionIO

321+mkIty "FBits8x16" = FArith (ATInt (ITVec IT8 16))

322+mkIty "FBits16x8" = FArith (ATInt (ITVec IT16 8))

323+mkIty "FBits32x4" = FArith (ATInt (ITVec IT32 4))

324+mkIty "FBits64x2" = FArith (ATInt (ITVec IT64 2))

317mkIty x = error $ "Unknown type " ++ x

325mkIty x = error $ "Unknown type " ++ x

318

326

319mkIntIty "ITNative" = FArith (ATInt ITNative)

327mkIntIty "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

39 | LFloatStr | LStrFloat | LChInt IntTy | LIntCh IntTy

40 | LPrintNum | LPrintStr | LReadStr

41+ | LBitCast ArithTy ArithTy -- Only for values of equal width

43 | LFSqrt | LFFloor | LFCeil

44 | LFSqrt | LFFloor | LFCeil

src/Idris/Primitives.hs+98−11

@@ -12,6 +12,7 @@ import Data.Bits

12import Data.Word

13import Data.Int

14import Data.Char

15+import Data.Vector.Unboxed (Vector)

15import qualified Data.Vector.Unboxed as V

16import qualified Data.Vector.Unboxed as V

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)

@@ -264,6 +344,12 @@ mkVecUpdate ity count [vec, B32 i, newElem] = updateVec vec newElem

264 updateVec (B16V v) (B16 e) = Just . B16V $ V.unsafeUpdate v (V.singleton (fromIntegral i, e))

344 updateVec (B16V v) (B16 e) = Just . B16V $ V.unsafeUpdate v (V.singleton (fromIntegral i, e))

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

347+ updateVec _ _ = Nothing

348+mkVecUpdate _ _ _ = Nothing

349+

350+aTyName :: ArithTy -> String

351+aTyName (ATInt t) = intTyName t

352+aTyName ATFloat = "Float"

267

353

268intTyName :: IntTy -> String

354intTyName :: IntTy -> String

269intTyName ITNative = "Int"

355intTyName ITNative = "Int"

@@ -448,20 +534,22 @@ toInt ITNative x = I (fromIntegral x)

448toInt ITChar x = Ch (chr $ fromIntegral x)

534toInt ITChar x = Ch (chr $ fromIntegral x)

449

535

450intToInt :: IntTy -> IntTy -> [Const] -> Maybe Const

536intToInt :: 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

452intToInt (ITFixed IT16) out [B16 x] = Just $ toInt out x

538intToInt (ITFixed IT16) out [B16 x] = Just $ toInt out x

453intToInt (ITFixed IT32) out [B32 x] = Just $ toInt out x

539intToInt (ITFixed IT32) out [B32 x] = Just $ toInt out x

454intToInt (ITFixed IT64) out [B64 x] = Just $ toInt out x

540intToInt (ITFixed IT64) out [B64 x] = Just $ toInt out x

455−intToInt ITBig out [BI x] = Just $ toInt out x

541+intToInt ITBig out [BI x] = Just $ toInt out x

456−intToInt ITNative out [I x] = Just $ toInt out x

542+intToInt ITNative out [I x] = Just $ toInt out x

457−intToInt ITChar out [Ch x] = Just $ toInt out (ord x)

543+intToInt ITChar out [Ch x] = Just $ toInt out (ord x)

458intToInt _ _ _ = Nothing

544intToInt _ _ _ = Nothing

459

545

460zext :: IntTy -> IntTy -> [Const] -> Maybe Const

546zext :: IntTy -> IntTy -> [Const] -> Maybe Const

461zext from ITBig val = intToInt from ITBig val

547zext from ITBig val = intToInt from ITBig val

462zext ITBig _ _ = Nothing

548zext ITBig _ _ = Nothing

463−zext from to val

549+zext f@(ITFixed from) t@(ITFixed to) val

464− | intTyWidth from < intTyWidth to = intToInt from 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

465zext _ _ _ = Nothing

553zext _ _ _ = Nothing

466

554

467sext :: IntTy -> IntTy -> [Const] -> Maybe Const

555sext :: IntTy -> IntTy -> [Const] -> Maybe Const

@@ -475,7 +563,9 @@ sext from to val = intToInt from to val

475trunc :: IntTy -> IntTy -> [Const] -> Maybe Const

563trunc :: IntTy -> IntTy -> [Const] -> Maybe Const

476trunc ITBig to val = intToInt ITBig to val

564trunc ITBig to val = intToInt ITBig to val

477trunc _ ITBig _ = Nothing

565trunc _ 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

479trunc _ _ _ = Nothing

569trunc _ _ _ = Nothing

480

570

481intToStr :: [Const] -> Maybe Const

571intToStr :: [Const] -> Maybe Const

@@ -553,6 +643,3 @@ p_strRev _ = Nothing

553

643

554p_cantreduce :: a -> Maybe b

644p_cantreduce :: a -> Maybe b

555p_cantreduce _ = Nothing

645p_cantreduce _ = Nothing

556−

557−

558−