on master help sign in
Removed FChar in favour of FArith (ATInt ITChar)
commita0130b92621ddf3172307d421948b37e7dbbea27 authorJan Bessai <Jan.Bessai@tu-dortmund.de> dateMon 8 Jul 2013, 20:24 (13 years ago) parent773e454
5 files changed+13−14
src/Core/Execute.hs−1 src/IRTS/CodegenC.hs−2 src/IRTS/CodegenJava.hs+9−6 src/IRTS/CodegenLLVM.hs+4−4 src/IRTS/Lang.hs−1
src/Core/Execute.hs−1
@@ -469,7 +469,6 @@ getFTy (EApp (EP _ (UN "FIntT") _) (EP _ (UN intTy) _)) =
469469getFTy (EP _ (UN t) _) =
470470 case t of
471471 "FFloat" -> Just (FArith ATFloat)
472− "FChar" -> Just FChar
473472 "FString" -> Just FString
474473 "FPtr" -> Just FPtr
475474 "FUnit" -> Just FUnit
src/IRTS/CodegenC.hs−2
@@ -233,7 +233,6 @@ c_irts (FArith (ATInt ITNative)) l x = l ++ "MKINT((i_int)(" ++ x ++ "))"
233233c_irts (FArith (ATInt ITChar)) l x = c_irts (FArith (ATInt ITNative)) l x
234234c_irts (FArith (ATInt (ITFixed ity))) l x
235235 = l ++ "idris_b" ++ show (nativeTyWidth ity) ++ "const(vm, " ++ x ++ ")"
236−c_irts FChar l x = l ++ "MKINT((i_int)(" ++ x ++ "))"
237236c_irts FString l x = l ++ "MKSTR(vm, " ++ x ++ ")"
238237c_irts FUnit l x = x
239238c_irts FPtr l x = l ++ "MKPTR(vm, " ++ x ++ ")"
@@ -244,7 +243,6 @@ irts_c (FArith (ATInt ITNative)) x = "GETINT(" ++ x ++ ")"
244243irts_c (FArith (ATInt ITChar)) x = irts_c (FArith (ATInt ITNative)) x
245244irts_c (FArith (ATInt (ITFixed ity))) x
246245 = "(" ++ x ++ "->info.bits" ++ show (nativeTyWidth ity) ++ ")"
247−irts_c FChar x = "GETINT(" ++ x ++ ")"
248246irts_c FString x = "GETSTR(" ++ x ++ ")"
249247irts_c FUnit x = x
250248irts_c FPtr x = "GETPTR(" ++ x ++ ")"
src/IRTS/CodegenJava.hs+9−6
@@ -477,6 +477,7 @@ nextIntTy (ITFixed IT16) = (ITFixed IT32)
477477nextIntTy (ITFixed IT32) = (ITFixed IT64)
478478nextIntTy (ITFixed IT64) = (ITFixed IT64)
479479nextIntTy ITNative = (ITFixed IT64)
480+nextIntTy ITChar = (ITFixed IT64)
480481
481482intTyToIdent :: IntTy -> Ident
482483intTyToIdent (ITFixed IT8) = Ident "Byte"
@@ -485,6 +486,7 @@ intTyToIdent (ITFixed IT32) = Ident "Integer"
485486intTyToIdent (ITFixed IT64) = Ident "Long"
486487intTyToIdent ITNative = Ident "Integer"
487488intTyToIdent ITBig = Ident "BigInteger"
489+intTyToIdent ITChar = Ident "Integer"
488490
489491intTyToClass :: IntTy -> ClassType
490492intTyToClass ty = ClassType [(intTyToIdent ty, [])]
@@ -495,6 +497,7 @@ intTyToMethod (ITFixed IT16) = "shortValue"
495497intTyToMethod (ITFixed IT32) = "intValue"
496498intTyToMethod (ITFixed IT64) = "longValue"
497499intTyToMethod ITNative = "intValue"
500+intTyToMethod ITChar = "intValue"
498501
499502intTyToPrimTy :: IntTy -> PrimType
500503intTyToPrimTy (ITFixed IT8) = ByteT
@@ -502,6 +505,7 @@ intTyToPrimTy (ITFixed IT16) = ShortT
502505intTyToPrimTy (ITFixed IT32) = IntT
503506intTyToPrimTy (ITFixed IT64) = LongT
504507intTyToPrimTy ITNative = IntT
508+intTyToPrimTy ITChar = IntT
505509
506510bigIntegerType :: ClassType
507511bigIntegerType = ClassType [(Ident "BigInteger", [])]
@@ -997,7 +1001,6 @@ mkStringAtIndex var indexExp =
9971001mkForeignType :: FType -> Maybe ClassType
9981002mkForeignType (FArith (ATInt ity)) = return (intTyToClass ity)
9991003mkForeignType (FArith ATFloat) = return doubleType
1000−mkForeignType FChar = return integerType
10011004mkForeignType FString = return stringType
10021005mkForeignType FPtr = return objectType
10031006mkForeignType FAny = return objectType
@@ -1011,7 +1014,7 @@ mkForeignVarAccess (FArith (ATInt ty)) var =
10111014 []
10121015 )
10131016 <$> 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
10151018mkForeignVarAccess (FArith ATFloat) var =
10161019 (\ var -> MethodInv $ PrimaryMethodCall (var)
10171020 []
@@ -1022,12 +1025,12 @@ mkForeignVarAccess (FArith ATFloat) var =
10221025mkForeignVarAccess otherType var = mkVarAccess (mkForeignType otherType) var
10231026
10241027mkFromForeignType :: FType -> Exp -> Exp
1025−mkFromForeignType (FArith (ATInt ty)) from =
1028+{-mkFromForeignType (FArith (ATInt ty)) from =
10261029 MethodInv $ TypeMethodCall (J.Name [intTyToIdent ty])
10271030 []
10281031 (Ident "valueOf")
1029− [from]
1030−mkFromForeignType FChar from = mkFromForeignType (FArith (ATInt (ITFixed IT32))) from
1032+ [from] -}
1033+mkFromForeignType (FArith (ATInt ITChar)) from = mkFromForeignType (FArith (ATInt (ITFixed IT32))) from
10311034mkFromForeignType (FArith ATFloat) from =
10321035 MethodInv $ TypeMethodCall (J.Name [Ident "Double"])
10331036 []
@@ -1272,7 +1275,7 @@ mkExp (SConst (Str x)) = return $ Lit $ String x
12721275mkExp (SConst (AType (ATInt ITNative))) = return $ mkClass integerType
12731276mkExp (SConst (AType (ATInt ITBig))) = return $ mkClass bigIntegerType
12741277mkExp (SConst (AType ATFloat)) = return $ mkClass doubleType
1275−mkExp (SConst ChType) = return $ mkClass charType
1278+mkExp (SConst (AType (ATInt ITChar))) = return $ mkClass charType
12761279mkExp (SConst StrType) = return $ mkClass stringType
12771280mkExp (SConst (B8 x)) = return $ mkPrimitive "Byte" (String (show x))
12781281mkExp (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
732732cgConst c@(TT.B32V v) = box (FArith (ATInt (ITVec IT32 (V.length v)))) (ConstantOperand $ cgConst' c)
733733cgConst c@(TT.B64V v) = box (FArith (ATInt (ITVec IT64 (V.length v)))) (ConstantOperand $ cgConst' c)
734734cgConst 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)
736736cgConst c@(TT.Str s) = do
737737 str <- addGlobal' (ArrayType (1 + fromIntegral (length s)) (IntegerType 8)) (cgConst' c)
738738 box FString (ConstantOperand $ C.GetElementPtr True str [C.Int 32 0, C.Int 32 0])
@@ -947,7 +947,7 @@ cgOp (LStrInt ity) [s] = do
947947cgOp LStrConcat [x,y] = cgStrCat x y
948948
949949cgOp LStrCons [c,s] = do
950− nc <- unbox FChar c
950+ nc <- unbox (FArith (ATInt ITChar)) c
951951 ns <- unbox FString s
952952 nc' <- inst $ Trunc nc (IntegerType 8) []
953953 r <- inst $ simpleCall "__idris_strCons" [nc', ns]
@@ -957,7 +957,7 @@ cgOp LStrHead [c] = do
957957 s <- unbox FString c
958958 c <- inst $ Load False s Nothing 0 []
959959 c' <- inst $ ZExt c (IntegerType 32) []
960− box FChar c'
960+ box (FArith (ATInt ITChar)) c'
961961
962962cgOp LStrIndex [s, i] = do
963963 ns <- unbox FString s
@@ -965,7 +965,7 @@ cgOp LStrIndex [s, i] = do
965965 p <- inst $ GetElementPtr True ns [ni] []
966966 c <- inst $ Load False p Nothing 0 []
967967 c' <- inst $ ZExt c (IntegerType 32) []
968− box FChar c'
968+ box (FArith (ATInt ITChar)) c'
969969
970970cgOp LStrTail [c] = do
971971 s <- unbox FString c
src/IRTS/Lang.hs−1
@@ -63,7 +63,6 @@ data FLang = LANG_C
6363data FType = FArith ArithTy
6464 | FFunction
6565 | FFunctionIO
66− | FChar
6766 | FString
6867 | FUnit
6968 | FPtr