95eee3c · Idris-dev · git.iko.soy

libs/base/Language/Reflection/Utils.idr−5

compare with master

unifiedsplit

@@ -95,8 +95,6 @@ instance Show Const where

95 show (B64 b) = "(B64 ...)"

96 show (AType x) = "(AType ...)"

97 show StrType = "StrType"

98− show PtrType = "PtrType"

99− show ManagedPtrType = "ManagedPtrType"

100 show VoidType = "VoidType"

98 show VoidType = "VoidType"

101 show Forgot = "Forgot"

99 show Forgot = "Forgot"

102

100

@@ -112,7 +110,6 @@ instance Eq Reflection.IntTy where

112 ITNative == ITNative = True

110 ITNative == ITNative = True

113 ITBig == ITBig = True

111 ITBig == ITBig = True

114 ITChar == ITChar = True

112 ITChar == ITChar = True

115− (ITVec x i) == (ITVec y j) = x == y && i == j

116 _ == _ = False

113 _ == _ = False

117

114

118instance Eq ArithTy where

115instance Eq ArithTy where

@@ -132,8 +129,6 @@ instance Eq Const where

132 (B64 x) == (B64 y) = x == y

129 (B64 x) == (B64 y) = x == y

133 (AType x) == (AType y) = x == y

130 (AType x) == (AType y) = x == y

134 StrType == StrType = True

131 StrType == StrType = True

135− PtrType == PtrType = True

136− ManagedPtrType == ManagedPtrType = True

137 VoidType == VoidType = True

132 VoidType == VoidType = True

138 Forgot == Forgot = True

133 Forgot == Forgot = True

139 _ == _ = False

134 _ == _ = False

libs/prelude/Language/Reflection.idr+1−8

@@ -38,7 +38,6 @@ data TTUExp =

38data NativeTy = IT8 | IT16 | IT32 | IT64

39

40data IntTy = ITFixed NativeTy | ITNative | ITBig | ITChar

41− | ITVec NativeTy Int

42

41

43data ArithTy = ATInt Language.Reflection.IntTy | ATFloat

42data ArithTy = ATInt Language.Reflection.IntTy | ATFloat

44

43

@@ -46,7 +45,7 @@ data ArithTy = ATInt Language.Reflection.IntTy | ATFloat

46data Const = I Int | BI Integer | Fl Float | Ch Char | Str String

45data Const = I Int | BI Integer | Fl Float | Ch Char | Str String

47 | B8 Bits8 | B16 Bits16 | B32 Bits32 | B64 Bits64

46 | B8 Bits8 | B16 Bits16 | B32 Bits32 | B64 Bits64

48 | AType ArithTy | StrType

47 | AType ArithTy | StrType

49− | PtrType | ManagedPtrType | VoidType | Forgot

48+ | VoidType | Forgot

50 | WorldType | TheWorld

49 | WorldType | TheWorld

51%name Const c, c'

50%name Const c, c'

52

51

@@ -425,7 +424,6 @@ instance Quotable Reflection.IntTy TT where

425 quote ITNative = `(Reflection.ITNative)

424 quote ITNative = `(Reflection.ITNative)

426 quote ITBig = `(ITBig)

425 quote ITBig = `(ITBig)

427 quote ITChar = `(Reflection.ITChar)

426 quote ITChar = `(Reflection.ITChar)

428− quote (ITVec x y) = `(ITVec ~(quote x) ~(quote y))

429

427

430instance Quotable Reflection.IntTy Raw where

428instance Quotable Reflection.IntTy Raw where

431 quotedTy = `(Reflection.IntTy)

429 quotedTy = `(Reflection.IntTy)

@@ -433,7 +431,6 @@ instance Quotable Reflection.IntTy Raw where

433 quote ITNative = `(Reflection.ITNative)

431 quote ITNative = `(Reflection.ITNative)

434 quote ITBig = `(ITBig)

432 quote ITBig = `(ITBig)

435 quote ITChar = `(Reflection.ITChar)

433 quote ITChar = `(Reflection.ITChar)

436− quote (ITVec x y) = `(ITVec ~(quote {t=Raw} x) ~(quote {t=Raw} y))

437

434

438instance Quotable ArithTy TT where

435instance Quotable ArithTy TT where

439 quotedTy = `(ArithTy)

436 quotedTy = `(ArithTy)

@@ -458,8 +455,6 @@ instance Quotable Const TT where

458 quote (B64 x) = `(B64 ~(quote x))

455 quote (B64 x) = `(B64 ~(quote x))

459 quote (AType x) = `(AType ~(quote x))

456 quote (AType x) = `(AType ~(quote x))

460 quote StrType = `(StrType)

457 quote StrType = `(StrType)

461− quote PtrType = `(PtrType)

462− quote ManagedPtrType = `(ManagedPtrType)

463 quote VoidType = `(VoidType)

458 quote VoidType = `(VoidType)

464 quote Forgot = `(Forgot)

459 quote Forgot = `(Forgot)

465 quote WorldType = `(WorldType)

460 quote WorldType = `(WorldType)

@@ -478,8 +473,6 @@ instance Quotable Const Raw where

478 quote (B64 x) = `(B64 ~(quote {t=Raw} x))

473 quote (B64 x) = `(B64 ~(quote {t=Raw} x))

479 quote (AType x) = `(AType ~(quote {t=Raw} x))

474 quote (AType x) = `(AType ~(quote {t=Raw} x))

480 quote StrType = `(StrType)

475 quote StrType = `(StrType)

481− quote PtrType = `(PtrType)

482− quote ManagedPtrType = `(ManagedPtrType)

483 quote VoidType = `(VoidType)

476 quote VoidType = `(VoidType)

484 quote Forgot = `(Forgot)

477 quote Forgot = `(Forgot)

485 quote WorldType = `(WorldType)

478 quote WorldType = `(WorldType)

src/IRTS/CodegenC.hs−5

@@ -14,7 +14,6 @@ import Numeric

14import Data.Char

15import Data.Bits

16import Data.List (intercalate)

17−import qualified Data.Vector.Unboxed as V

18import System.Process

17import System.Process

19import System.Exit

18import System.Exit

20import System.IO

19import System.IO

@@ -320,10 +319,6 @@ toAType (FCon i)

320 | i == sUN "C_IntBits16" = ATInt (ITFixed IT16)

319 | i == sUN "C_IntBits16" = ATInt (ITFixed IT16)

321 | i == sUN "C_IntBits32" = ATInt (ITFixed IT32)

320 | i == sUN "C_IntBits32" = ATInt (ITFixed IT32)

322 | i == sUN "C_IntBits64" = ATInt (ITFixed IT64)

321 | i == sUN "C_IntBits64" = ATInt (ITFixed IT64)

323− | i == sUN "C_IntB8x16" = ATInt (ITVec IT8 16)

324− | i == sUN "C_IntB16x8" = ATInt (ITVec IT16 8)

325− | i == sUN "C_IntB32x4" = ATInt (ITVec IT32 4)

326− | i == sUN "C_IntB64x2" = ATInt (ITVec IT64 2)

327toAType t = error (show t ++ " not defined in toAType")

322toAType t = error (show t ++ " not defined in toAType")

328

323

329toFType (FCon c)

324toFType (FCon c)

src/IRTS/CodegenJavaScript.hs−1

@@ -473,7 +473,6 @@ translateConstant StrType = JSType JSStringTy

473translateConstant (AType (ATInt ITBig)) = JSType JSIntegerTy

474translateConstant (AType ATFloat) = JSType JSFloatTy

475translateConstant (AType (ATInt ITChar)) = JSType JSCharTy

476−translateConstant PtrType = JSType JSPtrTy

477translateConstant Forgot = JSType JSForgotTy

476translateConstant Forgot = JSType JSForgotTy

478translateConstant (BI 0) = JSNum (JSInteger JSBigZero)

477translateConstant (BI 0) = JSNum (JSInteger JSBigZero)

479translateConstant (BI 1) = JSNum (JSInteger JSBigOne)

478translateConstant (BI 1) = JSNum (JSInteger JSBigOne)

src/Idris/Core/Binary.hs−14

@@ -342,15 +342,8 @@ instance Binary Const where

342 (AType ATFloat) -> putWord8 11

343 (AType (ATInt ITChar)) -> putWord8 12

344 StrType -> putWord8 13

345− PtrType -> putWord8 14

346 Forgot -> putWord8 15

345 Forgot -> putWord8 15

347 (AType (ATInt (ITFixed ity))) -> putWord8 (fromIntegral (16 + fromEnum ity)) -- 16-19 inclusive

346 (AType (ATInt (ITFixed ity))) -> putWord8 (fromIntegral (16 + fromEnum ity)) -- 16-19 inclusive

348− (AType (ATInt (ITVec ity count))) -> do

349− putWord8 20

350− putWord8 (fromIntegral . fromEnum $ ity)

351− putWord8 (fromIntegral count)

352−

353− ManagedPtrType -> putWord8 26

354 VoidType -> putWord8 27

347 VoidType -> putWord8 27

355 WorldType -> putWord8 28

348 WorldType -> putWord8 28

356 TheWorld -> putWord8 29

349 TheWorld -> putWord8 29

@@ -377,7 +370,6 @@ instance Binary Const where

377 11 -> return (AType ATFloat)

370 11 -> return (AType ATFloat)

378 12 -> return (AType (ATInt ITChar))

371 12 -> return (AType (ATInt ITChar))

379 13 -> return StrType

372 13 -> return StrType

380− 14 -> return PtrType

381 15 -> return Forgot

373 15 -> return Forgot

382

374

383 16 -> return (AType (ATInt (ITFixed IT8)))

375 16 -> return (AType (ATInt (ITFixed IT8)))

@@ -385,12 +377,6 @@ instance Binary Const where

385 18 -> return (AType (ATInt (ITFixed IT32)))

377 18 -> return (AType (ATInt (ITFixed IT32)))

386 19 -> return (AType (ATInt (ITFixed IT64)))

378 19 -> return (AType (ATInt (ITFixed IT64)))

387

379

388− 20 -> do

389− e <- getWord8

390− c <- getWord8

391− return (AType (ATInt (ITVec (toEnum . fromIntegral $ e) (fromIntegral c))))

392−

393− 26 -> return ManagedPtrType

394 27 -> return VoidType

380 27 -> return VoidType

395 28 -> return WorldType

381 28 -> return WorldType

396 29 -> return TheWorld

382 29 -> return TheWorld

src/Idris/Core/DeepSeq.hs−3

@@ -134,7 +134,6 @@ instance NFData IntTy where

134 rnf ITNative = ()

135 rnf ITBig = ()

136 rnf ITChar = ()

137− rnf (ITVec x1 x2) = rnf x1 `seq` rnf x2 `seq` ()

138

137

139instance NFData ArithTy where

138instance NFData ArithTy where

140 rnf (ATInt x1) = rnf x1 `seq` ()

139 rnf (ATInt x1) = rnf x1 `seq` ()

@@ -154,8 +153,6 @@ instance NFData Const where

154 rnf WorldType = ()

153 rnf WorldType = ()

155 rnf TheWorld = ()

154 rnf TheWorld = ()

156 rnf StrType = ()

155 rnf StrType = ()

157− rnf PtrType = ()

158− rnf ManagedPtrType = ()

159 rnf VoidType = ()

156 rnf VoidType = ()

160 rnf Forgot = ()

157 rnf Forgot = ()

161

158

src/Idris/Core/Evaluate.hs−3

@@ -502,12 +502,9 @@ eval traceon ctxt ntimes genv tm opts = ev ntimes [] True [] tm where

502 findConst (AType ATFloat) (ConCase n 2 [] v : xs) = Just v

503 findConst (AType (ATInt ITChar)) (ConCase n 3 [] v : xs) = Just v

504 findConst StrType (ConCase n 4 [] v : xs) = Just v

505− findConst PtrType (ConCase n 5 [] v : xs) = Just v

506 findConst (AType (ATInt ITBig)) (ConCase n 6 [] v : xs) = Just v

505 findConst (AType (ATInt ITBig)) (ConCase n 6 [] v : xs) = Just v

507 findConst (AType (ATInt (ITFixed ity))) (ConCase n tag [] v : xs)

506 findConst (AType (ATInt (ITFixed ity))) (ConCase n tag [] v : xs)

508 | tag == 7 + fromEnum ity = Just v

507 | tag == 7 + fromEnum ity = Just v

509− findConst (AType (ATInt (ITVec ity count))) (ConCase n tag [] v : xs)

510− | tag == (fromEnum ity + 1) * 1000 + count = Just v

511 findConst c (_ : xs) = findConst c xs

508 findConst c (_ : xs) = findConst c xs

512

509

513 getValArgs tm = getValArgs' tm []

510 getValArgs tm = getValArgs' tm []

src/Idris/Core/TT.hs+1−17

@@ -524,7 +524,6 @@ instance Pretty NativeTy OutputAnnotation where

524 pretty IT64 = text "Bits64"

525

526data IntTy = ITFixed NativeTy | ITNative | ITBig | ITChar

527− | ITVec NativeTy Int

528 deriving (Show, Eq, Ord, Data, Typeable)

527 deriving (Show, Eq, Ord, Data, Typeable)

529

528

530intTyName :: IntTy -> String

529intTyName :: IntTy -> String

@@ -532,7 +531,6 @@ intTyName ITNative = "Int"

532intTyName ITBig = "BigInt"

531intTyName ITBig = "BigInt"

533intTyName (ITFixed sized) = "B" ++ show (nativeTyWidth sized)

532intTyName (ITFixed sized) = "B" ++ show (nativeTyWidth sized)

534intTyName (ITChar) = "Char"

533intTyName (ITChar) = "Char"

535−intTyName (ITVec ity count) = "B" ++ show (nativeTyWidth ity) ++ "x" ++ show count

536

534

537data ArithTy = ATInt IntTy | ATFloat -- TODO: Float vectors https://github.com/idris-lang/Idris-dev/issues/1723

535data ArithTy = ATInt IntTy | ATFloat -- TODO: Float vectors https://github.com/idris-lang/Idris-dev/issues/1723

538 deriving (Show, Eq, Ord, Data, Typeable)

536 deriving (Show, Eq, Ord, Data, Typeable)

@@ -547,7 +545,6 @@ instance Pretty ArithTy OutputAnnotation where

547 pretty (ATInt ITBig) = text "BigInt"

545 pretty (ATInt ITBig) = text "BigInt"

548 pretty (ATInt ITChar) = text "Char"

546 pretty (ATInt ITChar) = text "Char"

549 pretty (ATInt (ITFixed n)) = pretty n

547 pretty (ATInt (ITFixed n)) = pretty n

550− pretty (ATInt (ITVec e c)) = pretty e <> text "x" <> (text . show $ c)

551 pretty ATFloat = text "Float"

548 pretty ATFloat = text "Float"

552

549

553nativeTyWidth :: NativeTy -> Int

550nativeTyWidth :: NativeTy -> Int

@@ -567,7 +564,7 @@ data Const = I Int | BI Integer | Fl Double | Ch Char | Str String

567 | B8 Word8 | B16 Word16 | B32 Word32 | B64 Word64

564 | B8 Word8 | B16 Word16 | B32 Word32 | B64 Word64

568 | AType ArithTy | StrType

565 | AType ArithTy | StrType

569 | WorldType | TheWorld

566 | WorldType | TheWorld

570− | PtrType | ManagedPtrType | VoidType | Forgot

567+ | VoidType | Forgot

571 deriving (Eq, Ord, Data, Typeable)

568 deriving (Eq, Ord, Data, Typeable)

572{-!

569{-!

573deriving instance Binary Const

570deriving instance Binary Const

@@ -577,9 +574,7 @@ deriving instance NFData Const

577isTypeConst :: Const -> Bool

574isTypeConst :: Const -> Bool

578isTypeConst (AType _) = True

575isTypeConst (AType _) = True

579isTypeConst StrType = True

576isTypeConst StrType = True

580−isTypeConst ManagedPtrType = True

581isTypeConst WorldType = True

577isTypeConst WorldType = True

582−isTypeConst PtrType = True

583isTypeConst VoidType = True

578isTypeConst VoidType = True

584isTypeConst _ = False

579isTypeConst _ = False

585

580

@@ -596,8 +591,6 @@ instance Pretty Const OutputAnnotation where

596 pretty StrType = text "String"

591 pretty StrType = text "String"

597 pretty TheWorld = text "%theWorld"

592 pretty TheWorld = text "%theWorld"

598 pretty WorldType = text "prim__World"

593 pretty WorldType = text "prim__World"

599− pretty PtrType = text "Ptr"

600− pretty ManagedPtrType = text "Ptr"

601 pretty VoidType = text "Void"

594 pretty VoidType = text "Void"

602 pretty Forgot = text "Forgot"

595 pretty Forgot = text "Forgot"

603 pretty (B8 w) = text . show $ w

596 pretty (B8 w) = text . show $ w

@@ -625,16 +618,10 @@ constDocs c@(AType (ATInt ITNative)) = "Fixed-precision integers of undefi

625constDocs c@(AType (ATInt ITChar)) = "Characters in some unspecified encoding"

618constDocs c@(AType (ATInt ITChar)) = "Characters in some unspecified encoding"

626constDocs c@(AType ATFloat) = "Double-precision floating-point numbers"

619constDocs c@(AType ATFloat) = "Double-precision floating-point numbers"

627constDocs StrType = "Strings in some unspecified encoding"

620constDocs StrType = "Strings in some unspecified encoding"

628−constDocs PtrType = "Foreign pointers"

629−constDocs ManagedPtrType = "Managed pointers"

630constDocs c@(AType (ATInt (ITFixed IT8))) = "Eight bits (unsigned)"

621constDocs c@(AType (ATInt (ITFixed IT8))) = "Eight bits (unsigned)"

631constDocs c@(AType (ATInt (ITFixed IT16))) = "Sixteen bits (unsigned)"

622constDocs c@(AType (ATInt (ITFixed IT16))) = "Sixteen bits (unsigned)"

632constDocs c@(AType (ATInt (ITFixed IT32))) = "Thirty-two bits (unsigned)"

623constDocs c@(AType (ATInt (ITFixed IT32))) = "Thirty-two bits (unsigned)"

633constDocs c@(AType (ATInt (ITFixed IT64))) = "Sixty-four bits (unsigned)"

624constDocs c@(AType (ATInt (ITFixed IT64))) = "Sixty-four bits (unsigned)"

634−constDocs c@(AType (ATInt (ITVec IT8 16))) = "Vectors of sixteen eight-bit values"

635−constDocs c@(AType (ATInt (ITVec IT16 8))) = "Vectors of eight sixteen-bit values"

636−constDocs c@(AType (ATInt (ITVec IT32 4))) = "Vectors of four thirty-two-bit values"

637−constDocs c@(AType (ATInt (ITVec IT64 2))) = "Vectors of two sixty-four-bit values"

638constDocs (Fl f) = "A float"

625constDocs (Fl f) = "A float"

639constDocs (I i) = "A fixed-precision integer"

626constDocs (I i) = "A fixed-precision integer"

640constDocs (BI i) = "An arbitrary-precision integer"

627constDocs (BI i) = "An arbitrary-precision integer"

@@ -1295,12 +1282,9 @@ instance Show Const where

1295 show (AType (ATInt ITNative)) = "Int"

1282 show (AType (ATInt ITNative)) = "Int"

1296 show (AType (ATInt ITChar)) = "Char"

1283 show (AType (ATInt ITChar)) = "Char"

1297 show (AType (ATInt (ITFixed it))) = itBitsName it

1284 show (AType (ATInt (ITFixed it))) = itBitsName it

1298− show (AType (ATInt (ITVec it c))) = itBitsName it ++ "x" ++ show c

1299 show TheWorld = "prim__TheWorld"

1285 show TheWorld = "prim__TheWorld"

1300 show WorldType = "prim__WorldType"

1286 show WorldType = "prim__WorldType"

1301 show StrType = "String"

1287 show StrType = "String"

1302− show PtrType = "Ptr"

1303− show ManagedPtrType = "ManagedPtr"

1304 show VoidType = "Void"

1288 show VoidType = "Void"

1305

1289

1306showEnv :: (Eq n, Show n) => EnvTT n -> TT n -> String

1290showEnv :: (Eq n, Show n) => EnvTT n -> TT n -> String

src/Idris/Elab/Type.hs−1

@@ -238,7 +238,6 @@ elabExtern info syn doc fc opts n ty = do

238 let arity = length (getArgTys (normalise (tt_ctxt ist) [] cty))

239

240 putIState . (\ist -> ist{ idris_externs = S.insert (n, arity) (idris_externs ist) }) =<< getIState

241− updateContext (addOperator n cty arity (\x -> Nothing))

242 addIBC (IBCExtern (n, arity))

241 addIBC (IBCExtern (n, arity))

243

242

244 -- remove it from the deferred definitions list

243 -- remove it from the deferred definitions list

src/Idris/ElabTerm.hs−12

@@ -29,8 +29,6 @@ import qualified Data.Map as M

29import Data.Maybe (mapMaybe, fromMaybe)

30import qualified Data.Set as S

31import qualified Data.Text as T

32−import Data.Vector.Unboxed (Vector)

33−import qualified Data.Vector.Unboxed as V

34

32

35import Debug.Trace

33import Debug.Trace

36

34

@@ -319,7 +317,6 @@ elab ist info emode opts fn tm

319 constType :: Const -> Bool

317 constType :: Const -> Bool

320 constType (AType _) = True

318 constType (AType _) = True

321 constType StrType = True

319 constType StrType = True

322− constType PtrType = True

323 constType VoidType = True

320 constType VoidType = True

324 constType _ = False

321 constType _ = False

325

322

@@ -2170,7 +2167,6 @@ reifyTTBinderApp _ f args = fail ("Unknown reflection binder: " ++ show (f, args

2170

2167

2171reifyTTConst :: Term -> ElabD Const

2168reifyTTConst :: Term -> ElabD Const

2172reifyTTConst (P _ n _) | n == reflm "StrType" = return $ StrType

2169reifyTTConst (P _ n _) | n == reflm "StrType" = return $ StrType

2173−reifyTTConst (P _ n _) | n == reflm "PtrType" = return $ PtrType

2174reifyTTConst (P _ n _) | n == reflm "VoidType" = return $ VoidType

2170reifyTTConst (P _ n _) | n == reflm "VoidType" = return $ VoidType

2175reifyTTConst (P _ n _) | n == reflm "Forgot" = return $ Forgot

2171reifyTTConst (P _ n _) | n == reflm "Forgot" = return $ Forgot

2176reifyTTConst t@(App _ _)

2172reifyTTConst t@(App _ _)

@@ -2217,8 +2213,6 @@ reifyIntTy (App (P _ n _) nt) | n == reflm "ITFixed" = fmap ITFixed (reifyNative

2217reifyIntTy (P _ n _) | n == reflm "ITNative" = return ITNative

2213reifyIntTy (P _ n _) | n == reflm "ITNative" = return ITNative

2218reifyIntTy (P _ n _) | n == reflm "ITBig" = return ITBig

2214reifyIntTy (P _ n _) | n == reflm "ITBig" = return ITBig

2219reifyIntTy (P _ n _) | n == reflm "ITChar" = return ITChar

2215reifyIntTy (P _ n _) | n == reflm "ITChar" = return ITChar

2220−reifyIntTy (App (App (P _ n _) nt) (Constant (I i))) | n == reflm "ITVec" = fmap (flip ITVec i)

2221− (reifyNativeTy nt)

2222reifyIntTy tm = fail $ "The term " ++ show tm ++ " is not a reflected IntTy"

2216reifyIntTy tm = fail $ "The term " ++ show tm ++ " is not a reflected IntTy"

2223

2217

2224reifyTTUExp :: Term -> ElabD UExp

2218reifyTTUExp :: Term -> ElabD UExp

@@ -2595,12 +2589,6 @@ reflectConstant (AType (ATInt (ITFixed IT8))) = reflCall "AType" [reflCall "ATI

2595reflectConstant (AType (ATInt (ITFixed IT16))) = reflCall "AType" [reflCall "ATInt" [reflCall "ITFixed" [Var (reflm "IT16")]]]

2589reflectConstant (AType (ATInt (ITFixed IT16))) = reflCall "AType" [reflCall "ATInt" [reflCall "ITFixed" [Var (reflm "IT16")]]]

2596reflectConstant (AType (ATInt (ITFixed IT32))) = reflCall "AType" [reflCall "ATInt" [reflCall "ITFixed" [Var (reflm "IT32")]]]

2590reflectConstant (AType (ATInt (ITFixed IT32))) = reflCall "AType" [reflCall "ATInt" [reflCall "ITFixed" [Var (reflm "IT32")]]]

2597reflectConstant (AType (ATInt (ITFixed IT64))) = reflCall "AType" [reflCall "ATInt" [reflCall "ITFixed" [Var (reflm "IT64")]]]

2591reflectConstant (AType (ATInt (ITFixed IT64))) = reflCall "AType" [reflCall "ATInt" [reflCall "ITFixed" [Var (reflm "IT64")]]]

2598−reflectConstant (AType (ATInt (ITVec IT8 c))) = reflCall "AType" [reflCall "ATInt" [reflCall "ITVec" [Var (reflm "IT8"), RConstant (I c)]]]

2599−reflectConstant (AType (ATInt (ITVec IT16 c))) = reflCall "AType" [reflCall "ATInt" [reflCall "ITVec" [Var (reflm "IT16"), RConstant (I c)]]]

2600−reflectConstant (AType (ATInt (ITVec IT32 c))) = reflCall "AType" [reflCall "ATInt" [reflCall "ITVec" [Var (reflm "IT32"), RConstant (I c)]]]

2601−reflectConstant (AType (ATInt (ITVec IT64 c))) = reflCall "AType" [reflCall "ATInt" [reflCall "ITVec" [Var (reflm "IT64"), RConstant (I c)]]]

2602−reflectConstant PtrType = Var (reflm "PtrType")

2603−reflectConstant ManagedPtrType = Var (reflm "ManagedPtrType")

2604reflectConstant VoidType = Var (reflm "VoidType")

2592reflectConstant VoidType = Var (reflm "VoidType")

2605reflectConstant Forgot = Var (reflm "Forgot")

2593reflectConstant Forgot = Var (reflm "Forgot")

2606reflectConstant WorldType = Var (reflm "WorldType")

2594reflectConstant WorldType = Var (reflm "WorldType")

src/Idris/IBC.hs+1−1

@@ -37,7 +37,7 @@ import Codec.Compression.Zlib (compress)

37import Util.Zlib (decompressEither)

38

39ibcVersion :: Word8

40−ibcVersion = 102

40+ibcVersion = 103

41

42data IBCFile = IBCFile { ver :: Word8,

43 sourcefile :: FilePath,

src/Idris/Primitives.hs−23

@@ -13,7 +13,6 @@ import Data.Word

13import Data.Int

14import Data.Char

15import Data.Function (on)

16−import Data.Vector.Unboxed (Vector)

17import qualified Data.Vector.Unboxed as V

16import qualified Data.Vector.Unboxed as V

18

17

19data Prim = Prim { p_name :: Name,

18data Prim = Prim { p_name :: Name,

@@ -194,9 +193,6 @@ primitives =

194 (1, LSystemInfo) total

193 (1, LSystemInfo) total

195 ] ++ concatMap intOps [ITFixed IT8, ITFixed IT16, ITFixed IT32, ITFixed IT64, ITBig, ITNative, ITChar]

194 ] ++ concatMap intOps [ITFixed IT8, ITFixed IT16, ITFixed IT32, ITFixed IT64, ITBig, ITNative, ITChar]

196

195

197−vecTypes :: [IntTy]

198−vecTypes = [ITVec IT8 16, ITVec IT16 8, ITVec IT32 4, ITVec IT64 2]

199−

200intOps :: IntTy -> [Prim]

196intOps :: IntTy -> [Prim]

201intOps ity = intCmps ity ++ intArith ity ++ intConv ity

197intOps ity = intCmps ity ++ intArith ity ++ intConv ity

202

198

@@ -249,30 +245,11 @@ intConv ity =

249 (1, LFloatInt ity) total

245 (1, LFloatInt ity) total

250 ]

246 ]

251

247

252−vecCmps :: IntTy -> [Prim]

253−vecCmps ity =

254− [ iCmp ity "slt" True (bCmp ity (<)) (LSLt . ATInt) total

255− , iCmp ity "slte" True (bCmp ity (<=)) (LSLe . ATInt) total

256− , iCmp ity "eq" True (bCmp ity (==)) (LEq . ATInt) total

257− , iCmp ity "sgte" True (bCmp ity (>=)) (LSGe . ATInt) total

258− , iCmp ity "sgt" True (bCmp ity (>)) (LSGt . ATInt) total

259− , iCmp ity "lt" True (bCmp ity (<)) LLt total

260− , iCmp ity "lte" True (bCmp ity (<=)) LLe total

261− , iCmp ity "gte" True (bCmp ity (>=)) LGe total

262− , iCmp ity "gt" True (bCmp ity (>)) LGt total

263− ]

264−

265bitcastPrim :: ArithTy -> ArithTy -> (ArithTy -> [Const] -> Maybe Const) -> PrimFn -> Prim

248bitcastPrim :: ArithTy -> ArithTy -> (ArithTy -> [Const] -> Maybe Const) -> PrimFn -> Prim

266bitcastPrim from to impl prim =

249bitcastPrim from to impl prim =

267 Prim (sUN $ "prim__bitcast" ++ aTyName from ++ "_" ++ aTyName to) (ty [AType from] (AType to)) 1 (impl to)

250 Prim (sUN $ "prim__bitcast" ++ aTyName from ++ "_" ++ aTyName to) (ty [AType from] (AType to)) 1 (impl to)

268 (1, prim) total

251 (1, prim) total

269

252

270−mapHalf :: (V.Unbox a, V.Unbox b) => ((a, a) -> b) -> Vector a -> Vector b

271−mapHalf f xs = V.generate (V.length xs `div` 2) (\i -> f (xs V.! (i*2), xs V.! (i*2+1)))

272−

273−mapDouble :: (V.Unbox a, V.Unbox b) => (Bool -> a -> b) -> Vector a -> Vector b

274−mapDouble f xs = V.generate (V.length xs * 2) (\i -> f (i `rem` 2 == 0) (xs V.! (i `div` 2)))

275−

276concatWord8 :: (Word8, Word8) -> Word16

253concatWord8 :: (Word8, Word8) -> Word16

277concatWord8 (high, low) = fromIntegral high .|. (fromIntegral low `shiftL` 8)

254concatWord8 (high, low) = fromIntegral high .|. (fromIntegral low `shiftL` 8)

278

255