d3beccc · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Add support for logical and, or, shl, shr for big ints

commitd3beccc302010a48386759c69befea487a7328f3 authorJurriën Stutterheim <j.stutterheim@me.com> dateThu 3 Dec 2015, 10:12 (11 years ago) parentfe3b1a3

3 files changed+116

compare with master

unifiedsplit

rts/idris_gmp.c+106 rts/idris_gmp.h+5 src/IRTS/CodegenC.hs+5

rts/idris_gmp.c+106

@@ -196,6 +196,88 @@ VAL bigMod(VM* vm, VAL x, VAL y) {

196196 return cl;

197197}

198198

199+VAL bigAnd(VM* vm, VAL x, VAL y) {

200+ idris_requireAlloc(IDRIS_MAXGMP);

201+

202+ mpz_t* bigint;

203+ VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

204+ idris_doneAlloc();

205+ bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

206+ mpz_and(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

207+ SETTY(cl, BIGINT);

208+ cl -> info.ptr = (void*)bigint;

209+ return cl;

210+}

211+

212+VAL bigOr(VM* vm, VAL x, VAL y) {

213+ idris_requireAlloc(IDRIS_MAXGMP);

214+

215+ mpz_t* bigint;

216+ VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

217+ idris_doneAlloc();

218+ bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

219+ mpz_ior(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

220+ SETTY(cl, BIGINT);

221+ cl -> info.ptr = (void*)bigint;

222+ return cl;

223+}

224+

225+VAL bigShiftLeft(VM* vm, VAL x, VAL y) {

226+ idris_requireAlloc(IDRIS_MAXGMP);

227+

228+ mpz_t* bigint;

229+ VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

230+ idris_doneAlloc();

231+ bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

232+ mpz_mul_2exp(*bigint, GETMPZ(GETBIG(vm,x)), GETINT(y));

233+ SETTY(cl, BIGINT);

234+ cl -> info.ptr = (void*)bigint;

235+ return cl;

236+}

237+

238+

239+VAL bigLShiftRight(VM* vm, VAL x, VAL y) {

240+ idris_requireAlloc(IDRIS_MAXGMP);

241+

242+ mpz_t* bigint;

243+ VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

244+ idris_doneAlloc();

245+ bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

246+ mpz_fdiv_q_2exp(*bigint, GETMPZ(GETBIG(vm,x)), GETINT(y));

247+ SETTY(cl, BIGINT);

248+ cl -> info.ptr = (void*)bigint;

249+ return cl;

250+}

251+

252+VAL bigAShiftRight(VM* vm, VAL x, VAL y) {

253+ idris_requireAlloc(IDRIS_MAXGMP);

254+

255+ mpz_t* bigint;

256+ VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

257+ idris_doneAlloc();

258+ bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

259+ mpz_fdiv_q_2exp(*bigint, GETMPZ(GETBIG(vm,x)), GETINT(y));

260+ SETTY(cl, BIGINT);

261+ cl -> info.ptr = (void*)bigint;

262+ return cl;

263+}

264+

265+VAL idris_bigAnd(VM* vm, VAL x, VAL y) {

266+ if (ISINT(x) && ISINT(y)) {

267+ return INTOP(&, x, y);

268+ } else {

269+ return bigAnd(vm, GETBIG(vm, x), GETBIG(vm, y));

270+ }

271+}

272+

273+VAL idris_bigOr(VM* vm, VAL x, VAL y) {

274+ if (ISINT(x) && ISINT(y)) {

275+ return INTOP(|, x, y);

276+ } else {

277+ return bigOr(vm, GETBIG(vm, x), GETBIG(vm, y));

278+ }

279+}

280+

199281VAL idris_bigPlus(VM* vm, VAL x, VAL y) {

200282 if (ISINT(x) && ISINT(y)) {

201283 i_int vx = GETINT(x);

@@ -253,6 +335,30 @@ VAL idris_bigTimes(VM* vm, VAL x, VAL y) {

253335 }

254336}

255337

338+VAL idris_bigShiftLeft(VM* vm, VAL x, VAL y) {

339+ if (ISINT(x) && ISINT(y)) {

340+ return INTOP(<<, x, y);

341+ } else {

342+ return bigShiftLeft(vm, GETBIG(vm, x), GETBIG(vm, y));

343+ }

344+}

345+

346+VAL idris_bigAShiftRight(VM* vm, VAL x, VAL y) {

347+ if (ISINT(x) && ISINT(y)) {

348+ return INTOP(>>, x, y);

349+ } else {

350+ return bigAShiftRight(vm, GETBIG(vm, x), GETBIG(vm, y));

351+ }

352+}

353+

354+VAL idris_bigLShiftRight(VM* vm, VAL x, VAL y) {

355+ if (ISINT(x) && ISINT(y)) {

356+ return INTOP(>>, x, y);

357+ } else {

358+ return bigLShiftRight(vm, GETBIG(vm, x), GETBIG(vm, y));

359+ }

360+}

361+

256362VAL idris_bigDivide(VM* vm, VAL x, VAL y) {

257363 if (ISINT(x) && ISINT(y)) {

258364 return INTOP(/, x, y);

rts/idris_gmp.h+5

@@ -38,6 +38,11 @@ VAL idris_castBigFloat(VM* vm, VAL i);

3838VAL idris_castStrBig(VM* vm, VAL i);

3939VAL idris_castBigStr(VM* vm, VAL i);

4040

41+VAL idris_bigAnd(VM* vm, VAL x, VAL y);

42+VAL idris_bigOr(VM* vm, VAL x, VAL y);

43+VAL idris_bigShiftLeft(VM* vm, VAL x, VAL y);

44+VAL idris_bigShiftRight(VM* vm, VAL x, VAL y);

45+

4146#define GETMPZ(x) *((mpz_t*)((x)->info.ptr))

4247

4348#endif

src/IRTS/CodegenC.hs+5

@@ -444,6 +444,11 @@ doOp v (LMinus (ATInt ITBig)) [l, r] = v ++ "idris_bigMinus(vm, " ++ creg l ++ "

444444doOp v (LTimes (ATInt ITBig)) [l, r] = v ++ "idris_bigTimes(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

445445doOp v (LSDiv (ATInt ITBig)) [l, r] = v ++ "idris_bigDivide(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

446446doOp v (LSRem (ATInt ITBig)) [l, r] = v ++ "idris_bigMod(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

447+doOp v (LAnd ITBig) [l, r] = v ++ "idris_bigAnd(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

448+doOp v (LOr ITBig) [l, r] = v ++ "idris_bigOr(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

449+doOp v (LSHL ITBig) [l, r] = v ++ "idris_bigShiftLeft(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

450+doOp v (LLSHR ITBig) [l, r] = v ++ "idris_bigLShiftRight(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

451+doOp v (LASHR ITBig) [l, r] = v ++ "idris_bigAShiftRight(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

447452doOp v (LEq (ATInt ITBig)) [l, r] = v ++ "idris_bigEq(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

448453doOp v (LSLt (ATInt ITBig)) [l, r] = v ++ "idris_bigLt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

449454doOp v (LSLe (ATInt ITBig)) [l, r] = v ++ "idris_bigLe(vm, " ++ creg l ++ ", " ++ creg r ++ ")"