git.iko.soy/Idris-dev
on master help sign in
Remove no longer used primitives from TT
commit95eee3cfaef4a2323d4ea84547dfb79852fdec08 authorEdwin Brady <ecb10@st-andrews.ac.uk> dateSat 28 Mar 2015, 22:44 (12 years ago) parentfc02362
12 files changed+3−93
compare with master
unifiedsplit
libs/base/Language/Reflection/Utils.idr−5 libs/prelude/Language/Reflection.idr+1−8 src/IRTS/CodegenC.hs−5 src/IRTS/CodegenJavaScript.hs−1 src/Idris/Core/Binary.hs−14 src/Idris/Core/DeepSeq.hs−3 src/Idris/Core/Evaluate.hs−3 src/Idris/Core/TT.hs+1−17 src/Idris/Elab/Type.hs−1 src/Idris/ElabTerm.hs−12 src/Idris/IBC.hs+1−1 src/Idris/Primitives.hs−23
libs/base/Language/Reflection/Utils.idr−5
@@ -95,8 +95,6 @@ instance Show Const where
9595 show (B64 b) = "(B64 ...)"
9696 show (AType x) = "(AType ...)"
9797 show StrType = "StrType"
98− show PtrType = "PtrType"
99− show ManagedPtrType = "ManagedPtrType"
10098 show VoidType = "VoidType"
10199 show Forgot = "Forgot"
102100
@@ -112,7 +110,6 @@ instance Eq Reflection.IntTy where
112110 ITNative == ITNative = True
113111 ITBig == ITBig = True
114112 ITChar == ITChar = True
115− (ITVec x i) == (ITVec y j) = x == y && i == j
116113 _ == _ = False
117114
118115instance Eq ArithTy where
@@ -132,8 +129,6 @@ instance Eq Const where
132129 (B64 x) == (B64 y) = x == y
133130 (AType x) == (AType y) = x == y
134131 StrType == StrType = True
135− PtrType == PtrType = True
136− ManagedPtrType == ManagedPtrType = True
137132 VoidType == VoidType = True
138133 Forgot == Forgot = True
139134 _ == _ = False
libs/prelude/Language/Reflection.idr+1−8
@@ -38,7 +38,6 @@ data TTUExp =
3838data NativeTy = IT8 | IT16 | IT32 | IT64
3939
4040data IntTy = ITFixed NativeTy | ITNative | ITBig | ITChar
41− | ITVec NativeTy Int
4241
4342data ArithTy = ATInt Language.Reflection.IntTy | ATFloat
4443
@@ -46,7 +45,7 @@ data ArithTy = ATInt Language.Reflection.IntTy | ATFloat
4645data Const = I Int | BI Integer | Fl Float | Ch Char | Str String
4746 | B8 Bits8 | B16 Bits16 | B32 Bits32 | B64 Bits64
4847 | AType ArithTy | StrType
49− | PtrType | ManagedPtrType | VoidType | Forgot
48+ | VoidType | Forgot
5049 | WorldType | TheWorld
5150%name Const c, c'
5251
@@ -425,7 +424,6 @@ instance Quotable Reflection.IntTy TT where
425424 quote ITNative = `(Reflection.ITNative)
426425 quote ITBig = `(ITBig)
427426 quote ITChar = `(Reflection.ITChar)
428− quote (ITVec x y) = `(ITVec ~(quote x) ~(quote y))
429427
430428instance Quotable Reflection.IntTy Raw where
431429 quotedTy = `(Reflection.IntTy)
@@ -433,7 +431,6 @@ instance Quotable Reflection.IntTy Raw where
433431 quote ITNative = `(Reflection.ITNative)
434432 quote ITBig = `(ITBig)
435433 quote ITChar = `(Reflection.ITChar)
436− quote (ITVec x y) = `(ITVec ~(quote {t=Raw} x) ~(quote {t=Raw} y))
437434
438435instance Quotable ArithTy TT where
439436 quotedTy = `(ArithTy)
@@ -458,8 +455,6 @@ instance Quotable Const TT where
458455 quote (B64 x) = `(B64 ~(quote x))
459456 quote (AType x) = `(AType ~(quote x))
460457 quote StrType = `(StrType)
461− quote PtrType = `(PtrType)
462− quote ManagedPtrType = `(ManagedPtrType)
463458 quote VoidType = `(VoidType)
464459 quote Forgot = `(Forgot)
465460 quote WorldType = `(WorldType)
@@ -478,8 +473,6 @@ instance Quotable Const Raw where
478473 quote (B64 x) = `(B64 ~(quote {t=Raw} x))
479474 quote (AType x) = `(AType ~(quote {t=Raw} x))
480475 quote StrType = `(StrType)
481− quote PtrType = `(PtrType)
482− quote ManagedPtrType = `(ManagedPtrType)
483476 quote VoidType = `(VoidType)
484477 quote Forgot = `(Forgot)
485478 quote WorldType = `(WorldType)
src/IRTS/CodegenC.hs−5
@@ -14,7 +14,6 @@ import Numeric
1414import Data.Char
1515import Data.Bits
1616import Data.List (intercalate)
17−import qualified Data.Vector.Unboxed as V
1817import System.Process
1918import System.Exit
2019import System.IO
@@ -320,10 +319,6 @@ toAType (FCon i)
320319 | i == sUN "C_IntBits16" = ATInt (ITFixed IT16)
321320 | i == sUN "C_IntBits32" = ATInt (ITFixed IT32)
322321 | 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)
327322toAType t = error (show t ++ " not defined in toAType")
328323
329324toFType (FCon c)
src/IRTS/CodegenJavaScript.hs−1
@@ -473,7 +473,6 @@ translateConstant StrType = JSType JSStringTy
473473translateConstant (AType (ATInt ITBig)) = JSType JSIntegerTy
474474translateConstant (AType ATFloat) = JSType JSFloatTy
475475translateConstant (AType (ATInt ITChar)) = JSType JSCharTy
476−translateConstant PtrType = JSType JSPtrTy
477476translateConstant Forgot = JSType JSForgotTy
478477translateConstant (BI 0) = JSNum (JSInteger JSBigZero)
479478translateConstant (BI 1) = JSNum (JSInteger JSBigOne)
src/Idris/Core/Binary.hs−14
@@ -342,15 +342,8 @@ instance Binary Const where
342342 (AType ATFloat) -> putWord8 11
343343 (AType (ATInt ITChar)) -> putWord8 12
344344 StrType -> putWord8 13
345− PtrType -> putWord8 14
346345 Forgot -> putWord8 15
347346 (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
354347 VoidType -> putWord8 27
355348 WorldType -> putWord8 28
356349 TheWorld -> putWord8 29
@@ -377,7 +370,6 @@ instance Binary Const where
377370 11 -> return (AType ATFloat)
378371 12 -> return (AType (ATInt ITChar))
379372 13 -> return StrType
380− 14 -> return PtrType
381373 15 -> return Forgot
382374
383375 16 -> return (AType (ATInt (ITFixed IT8)))
@@ -385,12 +377,6 @@ instance Binary Const where
385377 18 -> return (AType (ATInt (ITFixed IT32)))
386378 19 -> return (AType (ATInt (ITFixed IT64)))
387379
388− 20 -> do
389− e <- getWord8
390− c <- getWord8
391− return (AType (ATInt (ITVec (toEnum . fromIntegral $ e) (fromIntegral c))))
392−
393− 26 -> return ManagedPtrType
394380 27 -> return VoidType
395381 28 -> return WorldType
396382 29 -> return TheWorld
src/Idris/Core/DeepSeq.hs−3
@@ -134,7 +134,6 @@ instance NFData IntTy where
134134 rnf ITNative = ()
135135 rnf ITBig = ()
136136 rnf ITChar = ()
137− rnf (ITVec x1 x2) = rnf x1 `seq` rnf x2 `seq` ()
138137
139138instance NFData ArithTy where
140139 rnf (ATInt x1) = rnf x1 `seq` ()
@@ -154,8 +153,6 @@ instance NFData Const where
154153 rnf WorldType = ()
155154 rnf TheWorld = ()
156155 rnf StrType = ()
157− rnf PtrType = ()
158− rnf ManagedPtrType = ()
159156 rnf VoidType = ()
160157 rnf Forgot = ()
161158
src/Idris/Core/Evaluate.hs−3
@@ -502,12 +502,9 @@ eval traceon ctxt ntimes genv tm opts = ev ntimes [] True [] tm where
502502 findConst (AType ATFloat) (ConCase n 2 [] v : xs) = Just v
503503 findConst (AType (ATInt ITChar)) (ConCase n 3 [] v : xs) = Just v
504504 findConst StrType (ConCase n 4 [] v : xs) = Just v
505− findConst PtrType (ConCase n 5 [] v : xs) = Just v
506505 findConst (AType (ATInt ITBig)) (ConCase n 6 [] v : xs) = Just v
507506 findConst (AType (ATInt (ITFixed ity))) (ConCase n tag [] v : xs)
508507 | 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
511508 findConst c (_ : xs) = findConst c xs
512509
513510 getValArgs tm = getValArgs' tm []
src/Idris/Core/TT.hs+1−17
@@ -524,7 +524,6 @@ instance Pretty NativeTy OutputAnnotation where
524524 pretty IT64 = text "Bits64"
525525
526526data IntTy = ITFixed NativeTy | ITNative | ITBig | ITChar
527− | ITVec NativeTy Int
528527 deriving (Show, Eq, Ord, Data, Typeable)
529528
530529intTyName :: IntTy -> String
@@ -532,7 +531,6 @@ intTyName ITNative = "Int"
532531intTyName ITBig = "BigInt"
533532intTyName (ITFixed sized) = "B" ++ show (nativeTyWidth sized)
534533intTyName (ITChar) = "Char"
535−intTyName (ITVec ity count) = "B" ++ show (nativeTyWidth ity) ++ "x" ++ show count
536534
537535data ArithTy = ATInt IntTy | ATFloat -- TODO: Float vectors https://github.com/idris-lang/Idris-dev/issues/1723
538536 deriving (Show, Eq, Ord, Data, Typeable)
@@ -547,7 +545,6 @@ instance Pretty ArithTy OutputAnnotation where
547545 pretty (ATInt ITBig) = text "BigInt"
548546 pretty (ATInt ITChar) = text "Char"
549547 pretty (ATInt (ITFixed n)) = pretty n
550− pretty (ATInt (ITVec e c)) = pretty e <> text "x" <> (text . show $ c)
551548 pretty ATFloat = text "Float"
552549
553550nativeTyWidth :: NativeTy -> Int
@@ -567,7 +564,7 @@ data Const = I Int | BI Integer | Fl Double | Ch Char | Str String
567564 | B8 Word8 | B16 Word16 | B32 Word32 | B64 Word64
568565 | AType ArithTy | StrType
569566 | WorldType | TheWorld
570− | PtrType | ManagedPtrType | VoidType | Forgot
567+ | VoidType | Forgot
571568 deriving (Eq, Ord, Data, Typeable)
572569{-!
573570deriving instance Binary Const
@@ -577,9 +574,7 @@ deriving instance NFData Const
577574isTypeConst :: Const -> Bool
578575isTypeConst (AType _) = True
579576isTypeConst StrType = True
580−isTypeConst ManagedPtrType = True
581577isTypeConst WorldType = True
582−isTypeConst PtrType = True
583578isTypeConst VoidType = True
584579isTypeConst _ = False
585580
@@ -596,8 +591,6 @@ instance Pretty Const OutputAnnotation where
596591 pretty StrType = text "String"
597592 pretty TheWorld = text "%theWorld"
598593 pretty WorldType = text "prim__World"
599− pretty PtrType = text "Ptr"
600− pretty ManagedPtrType = text "Ptr"
601594 pretty VoidType = text "Void"
602595 pretty Forgot = text "Forgot"
603596 pretty (B8 w) = text . show $ w
@@ -625,16 +618,10 @@ constDocs c@(AType (ATInt ITNative)) = "Fixed-precision integers of undefi
625618constDocs c@(AType (ATInt ITChar)) = "Characters in some unspecified encoding"
626619constDocs c@(AType ATFloat) = "Double-precision floating-point numbers"
627620constDocs StrType = "Strings in some unspecified encoding"
628−constDocs PtrType = "Foreign pointers"
629−constDocs ManagedPtrType = "Managed pointers"
630621constDocs c@(AType (ATInt (ITFixed IT8))) = "Eight bits (unsigned)"
631622constDocs c@(AType (ATInt (ITFixed IT16))) = "Sixteen bits (unsigned)"
632623constDocs c@(AType (ATInt (ITFixed IT32))) = "Thirty-two bits (unsigned)"
633624constDocs 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"
638625constDocs (Fl f) = "A float"
639626constDocs (I i) = "A fixed-precision integer"
640627constDocs (BI i) = "An arbitrary-precision integer"
@@ -1295,12 +1282,9 @@ instance Show Const where
12951282 show (AType (ATInt ITNative)) = "Int"
12961283 show (AType (ATInt ITChar)) = "Char"
12971284 show (AType (ATInt (ITFixed it))) = itBitsName it
1298− show (AType (ATInt (ITVec it c))) = itBitsName it ++ "x" ++ show c
12991285 show TheWorld = "prim__TheWorld"
13001286 show WorldType = "prim__WorldType"
13011287 show StrType = "String"
1302− show PtrType = "Ptr"
1303− show ManagedPtrType = "ManagedPtr"
13041288 show VoidType = "Void"
13051289
13061290showEnv :: (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
238238 let arity = length (getArgTys (normalise (tt_ctxt ist) [] cty))
239239
240240 putIState . (\ist -> ist{ idris_externs = S.insert (n, arity) (idris_externs ist) }) =<< getIState
241− updateContext (addOperator n cty arity (\x -> Nothing))
242241 addIBC (IBCExtern (n, arity))
243242
244243 -- remove it from the deferred definitions list
src/Idris/ElabTerm.hs−12
@@ -29,8 +29,6 @@ import qualified Data.Map as M
2929import Data.Maybe (mapMaybe, fromMaybe)
3030import qualified Data.Set as S
3131import qualified Data.Text as T
32−import Data.Vector.Unboxed (Vector)
33−import qualified Data.Vector.Unboxed as V
3432
3533import Debug.Trace
3634
@@ -319,7 +317,6 @@ elab ist info emode opts fn tm
319317 constType :: Const -> Bool
320318 constType (AType _) = True
321319 constType StrType = True
322− constType PtrType = True
323320 constType VoidType = True
324321 constType _ = False
325322
@@ -2170,7 +2167,6 @@ reifyTTBinderApp _ f args = fail ("Unknown reflection binder: " ++ show (f, args
21702167
21712168reifyTTConst :: Term -> ElabD Const
21722169reifyTTConst (P _ n _) | n == reflm "StrType" = return $ StrType
2173−reifyTTConst (P _ n _) | n == reflm "PtrType" = return $ PtrType
21742170reifyTTConst (P _ n _) | n == reflm "VoidType" = return $ VoidType
21752171reifyTTConst (P _ n _) | n == reflm "Forgot" = return $ Forgot
21762172reifyTTConst t@(App _ _)
@@ -2217,8 +2213,6 @@ reifyIntTy (App (P _ n _) nt) | n == reflm "ITFixed" = fmap ITFixed (reifyNative
22172213reifyIntTy (P _ n _) | n == reflm "ITNative" = return ITNative
22182214reifyIntTy (P _ n _) | n == reflm "ITBig" = return ITBig
22192215reifyIntTy (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)
22222216reifyIntTy tm = fail $ "The term " ++ show tm ++ " is not a reflected IntTy"
22232217
22242218reifyTTUExp :: Term -> ElabD UExp
@@ -2595,12 +2589,6 @@ reflectConstant (AType (ATInt (ITFixed IT8))) = reflCall "AType" [reflCall "ATI
25952589reflectConstant (AType (ATInt (ITFixed IT16))) = reflCall "AType" [reflCall "ATInt" [reflCall "ITFixed" [Var (reflm "IT16")]]]
25962590reflectConstant (AType (ATInt (ITFixed IT32))) = reflCall "AType" [reflCall "ATInt" [reflCall "ITFixed" [Var (reflm "IT32")]]]
25972591reflectConstant (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")
26042592reflectConstant VoidType = Var (reflm "VoidType")
26052593reflectConstant Forgot = Var (reflm "Forgot")
26062594reflectConstant WorldType = Var (reflm "WorldType")
src/Idris/IBC.hs+1−1
@@ -37,7 +37,7 @@ import Codec.Compression.Zlib (compress)
3737import Util.Zlib (decompressEither)
3838
3939ibcVersion :: Word8
40−ibcVersion = 102
40+ibcVersion = 103
4141
4242data IBCFile = IBCFile { ver :: Word8,
4343 sourcefile :: FilePath,
src/Idris/Primitives.hs−23
@@ -13,7 +13,6 @@ import Data.Word
1313import Data.Int
1414import Data.Char
1515import Data.Function (on)
16−import Data.Vector.Unboxed (Vector)
1716import qualified Data.Vector.Unboxed as V
1817
1918data Prim = Prim { p_name :: Name,
@@ -194,9 +193,6 @@ primitives =
194193 (1, LSystemInfo) total
195194 ] ++ concatMap intOps [ITFixed IT8, ITFixed IT16, ITFixed IT32, ITFixed IT64, ITBig, ITNative, ITChar]
196195
197−vecTypes :: [IntTy]
198−vecTypes = [ITVec IT8 16, ITVec IT16 8, ITVec IT32 4, ITVec IT64 2]
199−
200196intOps :: IntTy -> [Prim]
201197intOps ity = intCmps ity ++ intArith ity ++ intConv ity
202198
@@ -249,30 +245,11 @@ intConv ity =
249245 (1, LFloatInt ity) total
250246 ]
251247
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−
265248bitcastPrim :: ArithTy -> ArithTy -> (ArithTy -> [Const] -> Maybe Const) -> PrimFn -> Prim
266249bitcastPrim from to impl prim =
267250 Prim (sUN $ "prim__bitcast" ++ aTyName from ++ "_" ++ aTyName to) (ty [AType from] (AType to)) 1 (impl to)
268251 (1, prim) total
269252
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−
276253concatWord8 :: (Word8, Word8) -> Word16
277254concatWord8 (high, low) = fromIntegral high .|. (fromIntegral low `shiftL` 8)
278255