b3ba46e · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Primitives for interconversion of Bits32 and Int

commitb3ba46ed0d6e20cd358362ec97b8c2f25d8987ad authorBenjamin Saunders <besaunde@sfu.ca> dateThu 20 Dec 2012, 14:06 (14 years ago) parent103d65e

4 files changed+23−14

compare with master

unifiedsplit

rts/idris_bitstring.c+4 src/IRTS/CodegenC.hs+6−4 src/IRTS/Lang.hs+1−2 src/Idris/Primitives.hs+12−8

rts/idris_bitstring.c+4

@@ -56,6 +56,10 @@ VAL idris_b64(VM *vm, VAL a) {

5656 return cl;

5757}

5858

59+VAL idris_castB32Int(VM *vm, VAL a) {

60+ return MKINT(a->info.bits32);

61+}

62+

5963VAL idris_b8Plus(VM *vm, VAL a, VAL b) {

6064 VAL cl = allocate(vm, sizeof(Closure), 0);

6165 SETTY(cl, BITS8);

src/IRTS/CodegenC.hs+6−4

@@ -297,10 +297,12 @@ doOp v LReadStr [x] = v ++ "idris_readStr(vm, GETPTR(" ++ creg x ++ "))"

297297doOp _ LPrintNum [x] = "printf(\"%ld\\n\", GETINT(" ++ creg x ++ "))"

298298doOp _ LPrintStr [x] = "fputs(GETSTR(" ++ creg x ++ "), stdout)"

299299

300−doOp v LB8 [x] = v ++ "idris_b8(" ++ creg x ++ ")"

301−doOp v LB16 [x] = v ++ "idris_b16(" ++ creg x ++ ")"

302−doOp v LB32 [x] = v ++ "idris_b32(" ++ creg x ++ ")"

303−doOp v LB64 [x] = v ++ "idris_b64(" ++ creg x ++ ")"

300+doOp v LIntB8 [x] = v ++ "idris_b8(" ++ creg x ++ ")"

301+doOp v LIntB16 [x] = v ++ "idris_b16(" ++ creg x ++ ")"

302+doOp v LIntB32 [x] = v ++ "idris_b32(" ++ creg x ++ ")"

303+doOp v LIntB64 [x] = v ++ "idris_b64(" ++ creg x ++ ")"

304+

305+doOp v LB32Int [x] = v ++ "idris_castB32Int(" ++ creg x ++ ")"

304306

305307doOp v LB8Plus [x, y] = v ++ "idris_b8Plus(" ++ creg x ++ "," ++ creg y ++ ")"

306308doOp v LB8Minus [x, y] = v ++ "idris_b8Minus(" ++ creg x ++ "," ++ creg y ++ ")"

src/IRTS/Lang.hs+1−2

@@ -40,8 +40,6 @@ data PrimFn = LPlus | LMinus | LTimes | LDiv | LMod

4040 | LIntBig | LBigInt | LStrBig | LBigStr

4141 | LPrintNum | LPrintStr | LReadStr

4242

43− | LB8 | LB16 | LB32 | LB64

44−

4644 | LB8Z16 | LB8Z32 | LB8Z64 | LB8S16 | LB8S32 | LB8S64 -- Zero/Sign extension

@@ -50,6 +48,7 @@ data PrimFn = LPlus | LMinus | LTimes | LDiv | LMod

5048 | LB32Z64 | LB32S64 | LB32T8 | LB32T16

5250 | LB64T8 | LB64T16 | LB64T32

5352

5554 | LFSqrt | LFFloor | LFCeil

src/Idris/Primitives.hs+12−8

@@ -157,14 +157,16 @@ primitives =

157157 Prim (UN "prim__truncB64_32") (ty [B64Type] B32Type) 1 trunc64_32

158158 (1, LB64T32) total,

159159

160− Prim (UN "prim__intToBits8") (ty [IType] B8Type) 1 intToBits8

161− (1, LB8) total,

162− Prim (UN "prim__intToBits16") (ty [IType] B16Type) 1 intToBits16

163− (1, LB16) total,

164− Prim (UN "prim__intToBits32") (ty [IType] B32Type) 1 intToBits32

165− (1, LB32) total,

166− Prim (UN "prim__intToBits64") (ty [IType] B64Type) 1 intToBits64

167− (1, LB64) total,

160+ Prim (UN "prim__intToB8") (ty [IType] B8Type) 1 intToBits8

161+ (1, LIntB8) total,

162+ Prim (UN "prim__intToB16") (ty [IType] B16Type) 1 intToBits16

163+ (1, LIntB16) total,

164+ Prim (UN "prim__intToB32") (ty [IType] B32Type) 1 intToBits32

165+ (1, LIntB32) total,

166+ Prim (UN "prim__intToB64") (ty [IType] B64Type) 1 intToBits64

167+ (1, LIntB64) total,

168+ Prim (UN "prim__B32ToInt") (ty [B32Type] IType) 1 bits32ToInt

169+ (1, LB32Int) total,

168170

169171 Prim (UN "prim__addBigInt") (ty [BIType, BIType] BIType) 2 (bBin (+))

170172 (2, LBPlus) total,

@@ -409,6 +411,8 @@ intToBits32 _ = Nothing

409411intToBits64 [VConstant (I x)] = Just $ toB64 x

410412intToBits64 _ = Nothing

411413

414+bits32ToInt [VConstant (B32 x)] = Just $ VConstant (I (fromIntegral x))

415+

412416c_intToStr [VConstant (I x)] = Just $ VConstant (Str (show x))

413417c_intToStr _ = Nothing

414418c_strToInt [VConstant (Str x)] = case reads x of