abe5605 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Repaired java and c backends to work with improved integer primitives

commitabe56055b450104b66a8d917c32d67d4a2816176 authorJan Bessai <Jan.Bessai@tu-dortmund.de> dateThu 9 May 2013, 22:05 (13 years ago) parentc05479e

3 files changed+88−16

compare with master

unifiedsplit

rts/idris_rts.c+4−4 rts/idris_rts.h+2−2 src/IRTS/CodegenJava.hs+82−10

rts/idris_rts.c+4−4

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

271271

272272}

273273

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

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

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

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

276276}

277277

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

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

280280 return (int)res;

281281}

282282

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

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

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

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

285285}

286286

287287void 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);

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

209209

210210// 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);

212212int 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);

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

215215

216216// String primitives

src/IRTS/CodegenJava.hs+82−10

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

1616import Data.Char

1717import Data.Maybe (fromJust)

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

19+import Data.Int

1920import qualified Data.Text as T

2021import qualified Data.Text.IO as TIO

2122import Language.Java.Parser

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

470471longType :: ClassType

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

472473

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

473482intTyToIdent IT8 = Ident "Byte"

474483intTyToIdent IT16 = Ident "Short"

475−intTyToIdent IT32 = Ident "Int"

484+intTyToIdent IT32 = Ident "Integer"

476485intTyToIdent IT64 = Ident "Long"

486+intTyToIdent ITNative = Ident "Integer"

477487

478488intTyToClass :: IntTy -> ClassType

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

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

483493intTyToMethod IT16 = "shortValue"

484494intTyToMethod IT32 = "intValue"

485495intTyToMethod IT64 = "longValue"

496+intTyToMethod ITNative = "intValue"

486497

487498intTyToPrimTy :: IntTy -> PrimType

488499intTyToPrimTy IT8 = ByteT

489500intTyToPrimTy IT16 = ShortT

490501intTyToPrimTy IT32 = IntT

491502intTyToPrimTy IT64 = LongT

503+intTyToPrimTy ITNative = IntT

492504

493505bigIntegerType :: ClassType

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

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

9971009 (Ident (intTyToMethod ty))

9981010 []

9991011 )

1000− <$> mkVarAccess (Just integerType) var

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

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

10021014mkForeignVarAccess FDouble var =

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

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

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

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

12471259mkExp (SProj var i) = mkProjection var i

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

1260+mkExp (SConst (I x)) =

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

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

12491263mkExp (SConst (BI x)) =

12501264 return $ InstanceCreation []

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

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

13091323 . mkPartialOrder SLt

13101324 )

13111325 bigIntegerType

1312− "compare"

1326+ "compareTo"

13131327 args

13141328mkExp (SOp LBLe args) =

13151329 mkMethodOpChain1 ( mkBoolToNumber bigIntegerType

13161330 . mkPartialOrder SLe

13171331 )

13181332 bigIntegerType

1319− "compare"

1333+ "compareTo"

13201334 args

13211335mkExp (SOp LBGt args) =

13221336 mkMethodOpChain1 ( mkBoolToNumber bigIntegerType

13231337 . mkPartialOrder SGt

13241338 )

13251339 bigIntegerType

1326− "compare"

1340+ "compareTo"

13271341 args

13281342mkExp (SOp LBGe args) =

13291343 mkMethodOpChain1 ( mkBoolToNumber bigIntegerType

13301344 . mkPartialOrder SGe

13311345 )

13321346 bigIntegerType

1333− "compare"

1347+ "compareTo"

13341348 args

13351349mkExp (SOp LStrConcat args) =

13361350 mkMethodOpChain (\ exp -> InstanceCreation []

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

13471361 . mkPartialOrder SLt

13481362 )

13491363 stringType

1350− "compare"

1364+ "compareTo"

13511365 args

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

13531367 mkMethodOpChain1 ( mkBoolToNumber integerType)

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

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

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

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

1399−mkExp (SOp (LUDiv ty) args) = mkBinOpExpConv (intTyToMethod ty) (intTyToPrimTy ty) (intTyToClass ty) Div 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) =

1438+ mkBinOpExpConv (intTyToMethod $ nextIntTy ty)

1439+ (intTyToPrimTy $ nextIntTy ty)

1440+ (intTyToClass ty)

1441+ Div

1442+ args

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

1401−mkExp (SOp (LURem ty) args) = mkBinOpExpConv (intTyToMethod ty) (intTyToPrimTy ty) (intTyToClass ty) Rem 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) =

1469+ mkBinOpExpConv (intTyToMethod $ nextIntTy ty)

1470+ (intTyToPrimTy $ nextIntTy ty)

1471+ (intTyToClass ty)

1472+ Rem

1473+ args

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

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

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