abe5605 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Repaired java and c backends to work with improved integer primitives

abe5605Jan Bessai13 years ago

rts/idris_rts.c+4−4

compare with master

unifiedsplit

@@ -271,8 +271,8 @@ void dumpVal(VAL v) {

271

272}

273

274−void idris_memset(void* ptr, i_int offset, VAL c, i_int size) {

274+void idris_memset(void* ptr, i_int offset, uint8_t c, i_int size) {

275− memset(((uint8_t*)ptr) + offset, c->info.bits8, size);

275+ memset(((uint8_t*)ptr) + offset, c, size);

276}

277

278int idris_peek(void* ptr, i_int offset) {

@@ -280,8 +280,8 @@ int idris_peek(void* ptr, i_int offset) {

280 return (int)res;

281}

282

283−void idris_poke(void* ptr, i_int offset, VAL data) {

283+void idris_poke(void* ptr, i_int offset, uint8_t data) {

284− *(((uint8_t*)ptr) + offset) = data->info.bits8;

284+ *(((uint8_t*)ptr) + offset) = data;

285}

286

287void idris_memmove(void* dest, void* src, i_int dest_offset, i_int src_offset, i_int size) {

rts/idris_rts.h+2−2

@@ -208,9 +208,9 @@ VAL idris_castFloatStr(VM* vm, VAL i);

208VAL idris_castStrFloat(VM* vm, VAL i);

209

210// Raw memory manipulation

211−void idris_memset(void* ptr, i_int offset, VAL c, i_int size);

211+void idris_memset(void* ptr, i_int offset, uint8_t c, i_int size);

212int idris_peek(void* ptr, i_int offset);

213−void idris_poke(void* ptr, i_int offset, VAL data);

213+void idris_poke(void* ptr, i_int offset, uint8_t data);

214void idris_memmove(void* dest, void* src, i_int dest_offset, i_int src_offset, i_int size);

215

216// String primitives

src/IRTS/CodegenJava.hs+82−10

@@ -16,6 +16,7 @@ import Control.Monad.Trans.State

16import Data.Char

17import Data.Maybe (fromJust)

18import Data.List (isPrefixOf, isSuffixOf, intercalate, foldl')

19+import Data.Int

19import qualified Data.Text as T

20import qualified Data.Text as T

20import qualified Data.Text.IO as TIO

21import qualified Data.Text.IO as TIO

21import Language.Java.Parser

22import Language.Java.Parser

@@ -470,10 +471,19 @@ integerType = ClassType [(Ident "Integer", [])]

470longType :: ClassType

471longType :: ClassType

471longType = ClassType [(Ident "Long", [])]

472longType = ClassType [(Ident "Long", [])]

472

473

474+nextIntTy :: IntTy -> IntTy

475+nextIntTy IT8 = IT16

476+nextIntTy IT16 = IT32

477+nextIntTy IT32 = IT64

478+nextIntTy IT64 = IT64

479+nextIntTy ITNative = IT64

480+

481+intTyToIdent :: IntTy -> Ident

473intTyToIdent IT8 = Ident "Byte"

482intTyToIdent IT8 = Ident "Byte"

474intTyToIdent IT16 = Ident "Short"

483intTyToIdent IT16 = Ident "Short"

475−intTyToIdent IT32 = Ident "Int"

484+intTyToIdent IT32 = Ident "Integer"

476intTyToIdent IT64 = Ident "Long"

485intTyToIdent IT64 = Ident "Long"

486+intTyToIdent ITNative = Ident "Integer"

477

487

478intTyToClass :: IntTy -> ClassType

488intTyToClass :: IntTy -> ClassType

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

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

@@ -483,12 +493,14 @@ intTyToMethod IT8 = "byteValue"

483intTyToMethod IT16 = "shortValue"

493intTyToMethod IT16 = "shortValue"

484intTyToMethod IT32 = "intValue"

494intTyToMethod IT32 = "intValue"

485intTyToMethod IT64 = "longValue"

495intTyToMethod IT64 = "longValue"

496+intTyToMethod ITNative = "intValue"

486

497

487intTyToPrimTy :: IntTy -> PrimType

498intTyToPrimTy :: IntTy -> PrimType

488intTyToPrimTy IT8 = ByteT

499intTyToPrimTy IT8 = ByteT

489intTyToPrimTy IT16 = ShortT

500intTyToPrimTy IT16 = ShortT

490intTyToPrimTy IT32 = IntT

501intTyToPrimTy IT32 = IntT

491intTyToPrimTy IT64 = LongT

502intTyToPrimTy IT64 = LongT

503+intTyToPrimTy ITNative = IntT

492

504

493bigIntegerType :: ClassType

505bigIntegerType :: ClassType

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

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

@@ -997,7 +1009,7 @@ mkForeignVarAccess (FInt ty) var =

997 (Ident (intTyToMethod ty))

1009 (Ident (intTyToMethod ty))

998 []

1010 []

999 )

1011 )

1000− <$> mkVarAccess (Just integerType) var

1012+ <$> mkVarAccess (Just $ intTyToClass ty) var

1001mkForeignVarAccess FChar var = Cast (PrimType CharT) <$> mkForeignVarAccess (FInt IT32) var

1013mkForeignVarAccess FChar var = Cast (PrimType CharT) <$> mkForeignVarAccess (FInt IT32) var

1002mkForeignVarAccess FDouble var =

1014mkForeignVarAccess FDouble var =

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

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

@@ -1245,7 +1257,9 @@ mkExp (SCon conId name args) =

1245mkExp (SCase var alts) = mkCase False var alts

1257mkExp (SCase var alts) = mkCase False var alts

1246mkExp (SChkCase var alts) = mkCase True var alts

1258mkExp (SChkCase var alts) = mkCase True var alts

1247mkExp (SProj var i) = mkProjection var i

1259mkExp (SProj var i) = mkProjection var i

1260+mkExp (SConst (I x)) =

1261+ let x' :: Int32; x' = fromInteger (toInteger x) in

1248−mkExp (SConst (I x)) = return $ mkPrimitive "Integer" (Int (toInteger x))

1262+ return $ mkPrimitive "Integer" (Int (fromInteger (toInteger x')))

1249mkExp (SConst (BI x)) =

1263mkExp (SConst (BI x)) =

1250 return $ InstanceCreation []

1264 return $ InstanceCreation []

1251 (ClassType [(Ident "BigInteger", [])])

1265 (ClassType [(Ident "BigInteger", [])])

@@ -1309,28 +1323,28 @@ mkExp (SOp LBLt args) =

1309 . mkPartialOrder SLt

1323 . mkPartialOrder SLt

1310 )

1324 )

1311 bigIntegerType

1325 bigIntegerType

1312− "compare"

1326+ "compareTo"

1313 args

1327 args

1314mkExp (SOp LBLe args) =

1328mkExp (SOp LBLe args) =

1315 mkMethodOpChain1 ( mkBoolToNumber bigIntegerType

1329 mkMethodOpChain1 ( mkBoolToNumber bigIntegerType

1316 . mkPartialOrder SLe

1330 . mkPartialOrder SLe

1317 )

1331 )

1318 bigIntegerType

1332 bigIntegerType

1319− "compare"

1333+ "compareTo"

1320 args

1334 args

1321mkExp (SOp LBGt args) =

1335mkExp (SOp LBGt args) =

1322 mkMethodOpChain1 ( mkBoolToNumber bigIntegerType

1336 mkMethodOpChain1 ( mkBoolToNumber bigIntegerType

1323 . mkPartialOrder SGt

1337 . mkPartialOrder SGt

1324 )

1338 )

1325 bigIntegerType

1339 bigIntegerType

1326− "compare"

1340+ "compareTo"

1327 args

1341 args

1328mkExp (SOp LBGe args) =

1342mkExp (SOp LBGe args) =

1329 mkMethodOpChain1 ( mkBoolToNumber bigIntegerType

1343 mkMethodOpChain1 ( mkBoolToNumber bigIntegerType

1330 . mkPartialOrder SGe

1344 . mkPartialOrder SGe

1331 )

1345 )

1332 bigIntegerType

1346 bigIntegerType

1333− "compare"

1347+ "compareTo"

1334 args

1348 args

1335mkExp (SOp LStrConcat args) =

1349mkExp (SOp LStrConcat args) =

1336 mkMethodOpChain (\ exp -> InstanceCreation []

1350 mkMethodOpChain (\ exp -> InstanceCreation []

@@ -1347,7 +1361,7 @@ mkExp (SOp LStrLt args@[_, _]) =

1347 . mkPartialOrder SLt

1361 . mkPartialOrder SLt

1348 )

1362 )

1349 stringType

1363 stringType

1350− "compare"

1364+ "compareTo"

1351 args

1365 args

1352mkExp (SOp LStrEq args@[_, _]) =

1366mkExp (SOp LStrEq args@[_, _]) =

1353 mkMethodOpChain1 ( mkBoolToNumber integerType)

1367 mkMethodOpChain1 ( mkBoolToNumber integerType)

@@ -1396,9 +1410,67 @@ mkExp (SOp (LGe ty) args) = mkLogicalBinOpExp (intTyToClass ty) GThanE args

1396mkExp (SOp (LPlus ty) args) = mkBinOpExp (intTyToClass ty) Add args

1410mkExp (SOp (LPlus ty) args) = mkBinOpExp (intTyToClass ty) Add args

1397mkExp (SOp (LMinus ty) args) = mkBinOpExp (intTyToClass ty) Sub args

1411mkExp (SOp (LMinus ty) args) = mkBinOpExp (intTyToClass ty) Sub args

1398mkExp (SOp (LTimes ty) args) = mkBinOpExp (intTyToClass ty) Mult args

1412mkExp (SOp (LTimes ty) args) = mkBinOpExp (intTyToClass ty) Mult args

1413+mkExp (SOp (LUDiv IT64) (arg:args)) = do

1414+ (arg:args) <- mapM (mkVarAccess (Just longType)) (arg:args)

1415+ return $ foldl (\ exp arg ->

1416+ MethodInv $ PrimaryMethodCall

1417+ ( MethodInv $ PrimaryMethodCall

1418+ ( MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])

1419+ []

1420+ (Ident "valueOf")

1421+ [ exp ]

1422+ )

1423+ []

1424+ (Ident "divide")

1425+ [ MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])

1426+ []

1427+ (Ident "valueOf")

1428+ [ arg ]

1429+ ]

1430+ )

1431+ []

1432+ (Ident "longValue")

1433+ []

1434+ )

1435+ arg

1436+ args

1437+mkExp (SOp (LUDiv ty) args) =

1399−mkExp (SOp (LUDiv ty) args) = mkBinOpExpConv (intTyToMethod ty) (intTyToPrimTy ty) (intTyToClass ty) Div args

1438+ mkBinOpExpConv (intTyToMethod $ nextIntTy ty)

1439+ (intTyToPrimTy $ nextIntTy ty)

1440+ (intTyToClass ty)

1441+ Div

1442+ args

1400mkExp (SOp (LSDiv ty) args) = mkBinOpExp (intTyToClass ty) Div args

1443mkExp (SOp (LSDiv ty) args) = mkBinOpExp (intTyToClass ty) Div args

1444+mkExp (SOp (LURem IT64) (arg:args)) = do

1445+ (arg:args) <- mapM (mkVarAccess (Just longType)) (arg:args)

1446+ return $ foldl (\ exp arg ->

1447+ MethodInv $ PrimaryMethodCall

1448+ ( MethodInv $ PrimaryMethodCall

1449+ ( MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])

1450+ []

1451+ (Ident "valueOf")

1452+ [ exp ]

1453+ )

1454+ []

1455+ (Ident "remainder")

1456+ [ MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])

1457+ []

1458+ (Ident "valueOf")

1459+ [ arg ]

1460+ ]

1461+ )

1462+ []

1463+ (Ident "longValue")

1464+ []

1465+ )

1466+ arg

1467+ args

1468+mkExp (SOp (LURem ty) args) =

1401−mkExp (SOp (LURem ty) args) = mkBinOpExpConv (intTyToMethod ty) (intTyToPrimTy ty) (intTyToClass ty) Rem args

1469+ mkBinOpExpConv (intTyToMethod $ nextIntTy ty)

1470+ (intTyToPrimTy $ nextIntTy ty)

1471+ (intTyToClass ty)

1472+ Rem

1473+ args

1402mkExp (SOp (LSRem ty) args) = mkBinOpExp (intTyToClass ty) Rem args

1474mkExp (SOp (LSRem ty) args) = mkBinOpExp (intTyToClass ty) Rem args

1403mkExp (SOp (LSHL ty) args) = mkBinOpExp (intTyToClass ty) LShift args

1475mkExp (SOp (LSHL ty) args) = mkBinOpExp (intTyToClass ty) LShift args

1404mkExp (SOp (LLSHR ty) args) = mkBinOpExp (intTyToClass ty) RRShift args

1476mkExp (SOp (LLSHR ty) args) = mkBinOpExp (intTyToClass ty) RRShift args