@@ -0,0 +1,242 @@
1+#include "idris_rts.h"
2+#include <gmp.h>
3+#include <stdlib.h>
4+#include <string.h>
5+
6+VAL MKBIGI(int val) {
7+ return MKINT((i_int)val);
8+}
9+
10+VAL MKBIGC(VM* vm, char* val) {
11+ mpz_t* bigint;
12+ VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));
13+ bigint = allocate(vm, sizeof(mpz_t));
14+
15+ mpz_init(*bigint);
16+ mpz_set_str(*bigint, val, 10);
17+
18+ cl -> ty = BIGINT;
19+ cl -> info.ptr = (void*)bigint;
20+
21+ return cl;
22+}
23+
24+VAL MKBIGM(VM* vm, void* big) {
25+ mpz_t* bigint;
26+ VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));
27+ bigint = allocate(vm, sizeof(mpz_t));
28+
29+ mpz_init(*bigint);
30+ mpz_set(*bigint, *((mpz_t*)big));
31+
32+ cl -> ty = BIGINT;
33+ cl -> info.ptr = (void*)bigint;
34+
35+ return cl;
36+}
37+
38+VAL GETBIG(VM * vm, VAL x) {
39+ if (ISINT(x)) {
40+ mpz_t* bigint;
41+ VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));
42+ bigint = allocate(vm, sizeof(mpz_t));
43+
44+ mpz_init(*bigint);
45+ mpz_set_si(*bigint, GETINT(x));
46+
47+ cl -> ty = BIGINT;
48+ cl -> info.ptr = (void*)bigint;
49+
50+ return cl;
51+ } else {
52+ return x;
53+ }
54+}
55+
56+VAL bigAdd(VM* vm, VAL x, VAL y) {
57+ mpz_t* bigint;
58+ VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));
59+ bigint = allocate(vm, sizeof(mpz_t));
60+ mpz_add(*bigint, GETMPZ(x), GETMPZ(y));
61+ cl -> ty = BIGINT;
62+ cl -> info.ptr = (void*)bigint;
63+ return cl;
64+}
65+
66+VAL bigSub(VM* vm, VAL x, VAL y) {
67+ mpz_t* bigint;
68+ VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));
69+ bigint = allocate(vm, sizeof(mpz_t));
70+ mpz_sub(*bigint, GETMPZ(x), GETMPZ(y));
71+ cl -> ty = BIGINT;
72+ cl -> info.ptr = (void*)bigint;
73+ return cl;
74+}
75+
76+VAL bigMul(VM* vm, VAL x, VAL y) {
77+ mpz_t* bigint;
78+ VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));
79+ bigint = allocate(vm, sizeof(mpz_t));
80+ mpz_mul(*bigint, GETMPZ(x), GETMPZ(y));
81+ cl -> ty = BIGINT;
82+ cl -> info.ptr = (void*)bigint;
83+ return cl;
84+}
85+
86+VAL bigDiv(VM* vm, VAL x, VAL y) {
87+ mpz_t* bigint;
88+ VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));
89+ bigint = allocate(vm, sizeof(mpz_t));
90+ mpz_div(*bigint, GETMPZ(x), GETMPZ(y));
91+ cl -> ty = BIGINT;
92+ cl -> info.ptr = (void*)bigint;
93+ return cl;
94+}
95+
96+VAL idris_bigPlus(VM* vm, VAL x, VAL y) {
97+ if (ISINT(x) && ISINT(y)) {
98+ i_int vx = GETINT(x);
99+ i_int vy = GETINT(y);
100+ if ((vx <= 0 && vy >=0) || (vx >=0 && vy <=0)) {
101+ return ADD(x, y);
102+ }
103+ i_int res = vx + vy;
104+ if (res >= 1<<30 || res <= -(1 << 30)) {
105+ return bigAdd(vm, GETBIG(vm, x), GETBIG(vm, y));
106+ } else {
107+ return MKINT(res);
108+ }
109+ } else {
110+ return bigAdd(vm, GETBIG(vm, x), GETBIG(vm, y));
111+ }
112+}
113+
114+VAL idris_bigMinus(VM* vm, VAL x, VAL y) {
115+ if (ISINT(x) && ISINT(y)) {
116+ i_int vx = GETINT(x);
117+ i_int vy = GETINT(y);
118+ if ((vx <= 0 && vy <=0) || (vx >=0 && vy <=0)) {
119+ return INTOP(-, x, y);
120+ }
121+ i_int res = vx - vy;
122+ if (res >= 1<<30 || res <= -(1 << 30)) {
123+ return bigSub(vm, GETBIG(vm, x), GETBIG(vm, y));
124+ } else {
125+ return MKINT(res);
126+ }
127+ } else {
128+ return bigSub(vm, GETBIG(vm, x), GETBIG(vm, y));
129+ }
130+}
131+
132+VAL idris_bigTimes(VM* vm, VAL x, VAL y) {
133+ if (ISINT(x) && ISINT(y)) {
134+ i_int vx = GETINT(x);
135+ i_int vy = GETINT(y);
136+ // we could work out likelihood of overflow by checking the number
137+ // of necessary bits. Here's a quick conservative hack instead.
138+ if ((vx < (1<<15) && vy < (1<16)) ||
139+ (vx < (1<<16) && vy < (1<15)) ||
140+ (vx < (1<<20) && vy < (1<11)) ||
141+ (vx < (1<<11) && vy < (1<20)) ||
142+ (vx < (1<<23) && vy < (1<<8)) ||
143+ (vx < (1<<8) && vy < (1<<23))) { // ultra-conservative!
144+ return INTOP(*,x,y);
145+ } else {
146+ return bigMul(vm, GETBIG(vm, x), GETBIG(vm, y));
147+ }
148+ } else {
149+ return bigMul(vm, GETBIG(vm, x), GETBIG(vm, y));
150+ }
151+}
152+
153+VAL idris_bigDivide(VM* vm, VAL x, VAL y) {
154+ if (ISINT(x) && ISINT(y)) {
155+ return INTOP(/, x, y);
156+ } else {
157+ return bigDiv(vm, GETBIG(vm, x), GETBIG(vm, y));
158+ }
159+}
160+
161+VAL bigEq(VM* vm, VAL x, VAL y) {
162+ return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) == 0));
163+}
164+
165+VAL bigLt(VM* vm, VAL x, VAL y) {
166+ return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) < 0));
167+}
168+
169+VAL bigGt(VM* vm, VAL x, VAL y) {
170+ return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) > 0));
171+}
172+
173+VAL bigLe(VM* vm, VAL x, VAL y) {
174+ return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) <= 0));
175+}
176+
177+VAL bigGe(VM* vm, VAL x, VAL y) {
178+ return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) >= 0));
179+}
180+
181+VAL idris_bigEq(VM* vm, VAL x, VAL y) {
182+ if (ISINT(x) && ISINT(y)) {
183+ return MKINT((i_int)(GETINT(x) == GETINT(y)));
184+ } else {
185+ return bigEq(vm, x, y);
186+ }
187+}
188+
189+VAL idris_bigLt(VM* vm, VAL x, VAL y) {
190+ if (ISINT(x) && ISINT(y)) {
191+ return MKINT((i_int)(GETINT(x) < GETINT(y)));
192+ } else {
193+ return bigLt(vm, x, y);
194+ }
195+}
196+
197+VAL idris_bigLe(VM* vm, VAL x, VAL y) {
198+ if (ISINT(x) && ISINT(y)) {
199+ return MKINT((i_int)GETINT(x) <= GETINT(y));
200+ } else {
201+ return bigLe(vm, x, y);
202+ }
203+}
204+
205+VAL idris_bigGt(VM* vm, VAL x, VAL y) {
206+ if (ISINT(x) && ISINT(y)) {
207+ return MKINT((i_int)(GETINT(x) > GETINT(y)));
208+ } else {
209+ return bigGt(vm, x, y);
210+ }
211+}
212+
213+VAL idris_bigGe(VM* vm, VAL x, VAL y) {
214+ if (ISINT(x) && ISINT(y)) {
215+ return MKINT((i_int)(GETINT(x) >= GETINT(y)));
216+ } else {
217+ return bigGe(vm, x, y);
218+ }
219+}
220+
221+
222+VAL idris_castIntBig(VM* vm, VAL i) {
223+ return i;
224+}
225+
226+VAL idris_castBigInt(VM* vm, VAL i) {
227+ if (ISINT(i)) {
228+ return i;
229+ } else {
230+ return MKINT((i_int)(mpz_get_ui(GETMPZ(i))));
231+ }
232+}
233+
234+VAL idris_castStrBig(VM* vm, VAL i) {
235+ return MKBIGC(vm, GETSTR(i));
236+}
237+
238+VAL idris_castBigStr(VM* vm, VAL i) {
239+ char* str = mpz_get_str(NULL, 10, GETMPZ(GETBIG(vm, i)));
240+ return MKSTR(vm, str);
241+}
242+