a0130b9 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Removed FChar in favour of FArith (ATInt ITChar)

a0130b9Jan Bessai13 years ago

src/Core/Execute.hs−1

compare with master

unifiedsplit

@@ -469,7 +469,6 @@ getFTy (EApp (EP _ (UN "FIntT") _) (EP _ (UN intTy) _)) =

469getFTy (EP _ (UN t) _) =

470 case t of

471 "FFloat" -> Just (FArith ATFloat)

472− "FChar" -> Just FChar

473 "FString" -> Just FString

472 "FString" -> Just FString

474 "FPtr" -> Just FPtr

473 "FPtr" -> Just FPtr

475 "FUnit" -> Just FUnit

474 "FUnit" -> Just FUnit

src/IRTS/CodegenC.hs−2

@@ -233,7 +233,6 @@ c_irts (FArith (ATInt ITNative)) l x = l ++ "MKINT((i_int)(" ++ x ++ "))"

233c_irts (FArith (ATInt ITChar)) l x = c_irts (FArith (ATInt ITNative)) l x

234c_irts (FArith (ATInt (ITFixed ity))) l x

235 = l ++ "idris_b" ++ show (nativeTyWidth ity) ++ "const(vm, " ++ x ++ ")"

236−c_irts FChar l x = l ++ "MKINT((i_int)(" ++ x ++ "))"

237c_irts FString l x = l ++ "MKSTR(vm, " ++ x ++ ")"

236c_irts FString l x = l ++ "MKSTR(vm, " ++ x ++ ")"

238c_irts FUnit l x = x

237c_irts FUnit l x = x

239c_irts FPtr l x = l ++ "MKPTR(vm, " ++ x ++ ")"

238c_irts FPtr l x = l ++ "MKPTR(vm, " ++ x ++ ")"

@@ -244,7 +243,6 @@ irts_c (FArith (ATInt ITNative)) x = "GETINT(" ++ x ++ ")"

244irts_c (FArith (ATInt ITChar)) x = irts_c (FArith (ATInt ITNative)) x

243irts_c (FArith (ATInt ITChar)) x = irts_c (FArith (ATInt ITNative)) x

245irts_c (FArith (ATInt (ITFixed ity))) x

244irts_c (FArith (ATInt (ITFixed ity))) x

246 = "(" ++ x ++ "->info.bits" ++ show (nativeTyWidth ity) ++ ")"

245 = "(" ++ x ++ "->info.bits" ++ show (nativeTyWidth ity) ++ ")"

247−irts_c FChar x = "GETINT(" ++ x ++ ")"

248irts_c FString x = "GETSTR(" ++ x ++ ")"

246irts_c FString x = "GETSTR(" ++ x ++ ")"

249irts_c FUnit x = x

247irts_c FUnit x = x

250irts_c FPtr x = "GETPTR(" ++ x ++ ")"

248irts_c FPtr x = "GETPTR(" ++ x ++ ")"

src/IRTS/CodegenJava.hs+9−6

@@ -477,6 +477,7 @@ nextIntTy (ITFixed IT16) = (ITFixed IT32)

477nextIntTy (ITFixed IT32) = (ITFixed IT64)

478nextIntTy (ITFixed IT64) = (ITFixed IT64)

479nextIntTy ITNative = (ITFixed IT64)

480+nextIntTy ITChar = (ITFixed IT64)

480

481

481intTyToIdent :: IntTy -> Ident

482intTyToIdent :: IntTy -> Ident

482intTyToIdent (ITFixed IT8) = Ident "Byte"

483intTyToIdent (ITFixed IT8) = Ident "Byte"

@@ -485,6 +486,7 @@ intTyToIdent (ITFixed IT32) = Ident "Integer"

485intTyToIdent (ITFixed IT64) = Ident "Long"

486intTyToIdent (ITFixed IT64) = Ident "Long"

486intTyToIdent ITNative = Ident "Integer"

487intTyToIdent ITNative = Ident "Integer"

487intTyToIdent ITBig = Ident "BigInteger"

488intTyToIdent ITBig = Ident "BigInteger"

489+intTyToIdent ITChar = Ident "Integer"

488

490

489intTyToClass :: IntTy -> ClassType

491intTyToClass :: IntTy -> ClassType

490intTyToClass ty = ClassType [(intTyToIdent ty, [])]

492intTyToClass ty = ClassType [(intTyToIdent ty, [])]

@@ -495,6 +497,7 @@ intTyToMethod (ITFixed IT16) = "shortValue"

495intTyToMethod (ITFixed IT32) = "intValue"

497intTyToMethod (ITFixed IT32) = "intValue"

496intTyToMethod (ITFixed IT64) = "longValue"

498intTyToMethod (ITFixed IT64) = "longValue"

497intTyToMethod ITNative = "intValue"

499intTyToMethod ITNative = "intValue"

500+intTyToMethod ITChar = "intValue"

498

501

499intTyToPrimTy :: IntTy -> PrimType

502intTyToPrimTy :: IntTy -> PrimType

500intTyToPrimTy (ITFixed IT8) = ByteT

503intTyToPrimTy (ITFixed IT8) = ByteT

@@ -502,6 +505,7 @@ intTyToPrimTy (ITFixed IT16) = ShortT

502intTyToPrimTy (ITFixed IT32) = IntT

505intTyToPrimTy (ITFixed IT32) = IntT

503intTyToPrimTy (ITFixed IT64) = LongT

506intTyToPrimTy (ITFixed IT64) = LongT

504intTyToPrimTy ITNative = IntT

507intTyToPrimTy ITNative = IntT

508+intTyToPrimTy ITChar = IntT

505

509

506bigIntegerType :: ClassType

510bigIntegerType :: ClassType

507bigIntegerType = ClassType [(Ident "BigInteger", [])]

511bigIntegerType = ClassType [(Ident "BigInteger", [])]

@@ -997,7 +1001,6 @@ mkStringAtIndex var indexExp =

997mkForeignType :: FType -> Maybe ClassType

1001mkForeignType :: FType -> Maybe ClassType

998mkForeignType (FArith (ATInt ity)) = return (intTyToClass ity)

1002mkForeignType (FArith (ATInt ity)) = return (intTyToClass ity)

999mkForeignType (FArith ATFloat) = return doubleType

1003mkForeignType (FArith ATFloat) = return doubleType

1000−mkForeignType FChar = return integerType

1001mkForeignType FString = return stringType

1004mkForeignType FString = return stringType

1002mkForeignType FPtr = return objectType

1005mkForeignType FPtr = return objectType

1003mkForeignType FAny = return objectType

1006mkForeignType FAny = return objectType

@@ -1011,7 +1014,7 @@ mkForeignVarAccess (FArith (ATInt ty)) var =

1011 []

1014 []

1012 )

1015 )

1013 <$> mkVarAccess (Just $ intTyToClass ty) var

1016 <$> mkVarAccess (Just $ intTyToClass ty) var

1014−mkForeignVarAccess FChar var = Cast (PrimType CharT) <$> mkForeignVarAccess (FArith (ATInt (ITFixed IT32))) var

1017+-- mkForeignVarAccess (FArith (ATInt ITChar)) var = Cast (PrimType CharT) <$> mkForeignVarAccess (FArith (ATInt (ITFixed IT32))) var

1015mkForeignVarAccess (FArith ATFloat) var =

1018mkForeignVarAccess (FArith ATFloat) var =

1016 (\ var -> MethodInv $ PrimaryMethodCall (var)

1019 (\ var -> MethodInv $ PrimaryMethodCall (var)

1017 []

1020 []

@@ -1022,12 +1025,12 @@ mkForeignVarAccess (FArith ATFloat) var =

1022mkForeignVarAccess otherType var = mkVarAccess (mkForeignType otherType) var

1025mkForeignVarAccess otherType var = mkVarAccess (mkForeignType otherType) var

1023

1026

1024mkFromForeignType :: FType -> Exp -> Exp

1027mkFromForeignType :: FType -> Exp -> Exp

1025−mkFromForeignType (FArith (ATInt ty)) from =

1028+{-mkFromForeignType (FArith (ATInt ty)) from =

1026 MethodInv $ TypeMethodCall (J.Name [intTyToIdent ty])

1029 MethodInv $ TypeMethodCall (J.Name [intTyToIdent ty])

1027 []

1030 []

1028 (Ident "valueOf")

1031 (Ident "valueOf")

1029− [from]

1032+ [from] -}

1030−mkFromForeignType FChar from = mkFromForeignType (FArith (ATInt (ITFixed IT32))) from

1033+mkFromForeignType (FArith (ATInt ITChar)) from = mkFromForeignType (FArith (ATInt (ITFixed IT32))) from

1031mkFromForeignType (FArith ATFloat) from =

1034mkFromForeignType (FArith ATFloat) from =

1032 MethodInv $ TypeMethodCall (J.Name [Ident "Double"])

1035 MethodInv $ TypeMethodCall (J.Name [Ident "Double"])

1033 []

1036 []

@@ -1272,7 +1275,7 @@ mkExp (SConst (Str x)) = return $ Lit $ String x

1272mkExp (SConst (AType (ATInt ITNative))) = return $ mkClass integerType

1275mkExp (SConst (AType (ATInt ITNative))) = return $ mkClass integerType

1273mkExp (SConst (AType (ATInt ITBig))) = return $ mkClass bigIntegerType

1276mkExp (SConst (AType (ATInt ITBig))) = return $ mkClass bigIntegerType

1274mkExp (SConst (AType ATFloat)) = return $ mkClass doubleType

1277mkExp (SConst (AType ATFloat)) = return $ mkClass doubleType

1275−mkExp (SConst ChType) = return $ mkClass charType

1278+mkExp (SConst (AType (ATInt ITChar))) = return $ mkClass charType

1276mkExp (SConst StrType) = return $ mkClass stringType

1279mkExp (SConst StrType) = return $ mkClass stringType

1277mkExp (SConst (B8 x)) = return $ mkPrimitive "Byte" (String (show x))

1280mkExp (SConst (B8 x)) = return $ mkPrimitive "Byte" (String (show x))

1278mkExp (SConst (B16 x)) = return $ mkPrimitive "Short" (String (show x))

1281mkExp (SConst (B16 x)) = return $ mkPrimitive "Short" (String (show x))

src/IRTS/CodegenLLVM.hs+4−4

@@ -732,7 +732,7 @@ cgConst c@(TT.B16V v) = box (FArith (ATInt (ITVec IT16 (V.length v)))) (Constant

732cgConst c@(TT.B32V v) = box (FArith (ATInt (ITVec IT32 (V.length v)))) (ConstantOperand $ cgConst' c)

733cgConst c@(TT.B64V v) = box (FArith (ATInt (ITVec IT64 (V.length v)))) (ConstantOperand $ cgConst' c)

734cgConst c@(TT.Fl _) = box (FArith ATFloat) (ConstantOperand $ cgConst' c)

735−cgConst c@(TT.Ch _) = box FChar (ConstantOperand $ cgConst' c)

735+cgConst c@(TT.Ch _) = box (FArith (ATInt ITChar)) (ConstantOperand $ cgConst' c)

736cgConst c@(TT.Str s) = do

737 str <- addGlobal' (ArrayType (1 + fromIntegral (length s)) (IntegerType 8)) (cgConst' c)

738 box FString (ConstantOperand $ C.GetElementPtr True str [C.Int 32 0, C.Int 32 0])

@@ -947,7 +947,7 @@ cgOp (LStrInt ity) [s] = do

947cgOp LStrConcat [x,y] = cgStrCat x y

948

949cgOp LStrCons [c,s] = do

950− nc <- unbox FChar c

950+ nc <- unbox (FArith (ATInt ITChar)) c

951 ns <- unbox FString s

952 nc' <- inst $ Trunc nc (IntegerType 8) []

953 r <- inst $ simpleCall "__idris_strCons" [nc', ns]

@@ -957,7 +957,7 @@ cgOp LStrHead [c] = do

957 s <- unbox FString c

958 c <- inst $ Load False s Nothing 0 []

959 c' <- inst $ ZExt c (IntegerType 32) []

960− box FChar c'

960+ box (FArith (ATInt ITChar)) c'

961

962cgOp LStrIndex [s, i] = do

963 ns <- unbox FString s

@@ -965,7 +965,7 @@ cgOp LStrIndex [s, i] = do

965 p <- inst $ GetElementPtr True ns [ni] []

966 c <- inst $ Load False p Nothing 0 []

967 c' <- inst $ ZExt c (IntegerType 32) []

968− box FChar c'

968+ box (FArith (ATInt ITChar)) c'

969

970cgOp LStrTail [c] = do

971 s <- unbox FString c

src/IRTS/Lang.hs−1

@@ -63,7 +63,6 @@ data FLang = LANG_C

63data FType = FArith ArithTy

64 | FFunction

65 | FFunctionIO

66− | FChar

67 | FString

66 | FString

68 | FUnit

67 | FUnit

69 | FPtr

68 | FPtr