git.iko.soy/Idris-dev
on master help sign in
Added GMP interface for BigInts
0af107cEdwin Brady
iif/big.iifnew file+7
compare with master
unifiedsplit
@@ -0,0 +1,7 @@
1+fun fact(x) = case (x ==: 0:) of {
2+ 0 => x *: fact(x - 1)
3+ | _ => 1:
4+ }
5+
6+fun main() = let f = fact(200:) in
7+ %WriteString(%BigStr(f) ++ "\n")
rts/Makefile+2−2
@@ -1,5 +1,5 @@
1−OBJS = idris_rts.o idris_gc.o
1+OBJS = idris_rts.o idris_gc.o idris_gmp.o
2−HDRS = idris_rts.h idris_gc.h
2+HDRS = idris_rts.h idris_gc.h idris_gmp.h
3CFLAGS = -g
3CFLAGS = -g
4
4
5LIBTARGET = libidris_rts.a
5LIBTARGET = libidris_rts.a
rts/idris_gc.c+3
@@ -27,6 +27,9 @@ VAL copy(VM* vm, VAL x) {
27 case STRING:
27 case STRING:
28 cl = MKSTR(vm, x->info.str);
28 cl = MKSTR(vm, x->info.str);
29 break;
29 break;
30+ case BIGINT:
31+ cl = MKBIGM(vm, x->info.ptr);
32+ break;
30 case PTR:
33 case PTR:
31 cl = MKPTR(vm, x->info.ptr);
34 cl = MKPTR(vm, x->info.ptr);
32 break;
35 break;
rts/idris_gmp.cnew file+242
@@ -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+
rts/idris_gmp.hnew file+26
@@ -0,0 +1,26 @@
1+#ifndef _IDRISGMP_H
2+#define _IDRISGMP_H
3+
4+VAL MKBIGI(int val);
5+VAL MKBIGC(VM* vm, char* bigint);
6+VAL MKBIGM(VM* vm, void* bigint);
7+
8+VAL idris_bigPlus(VM*, VAL x, VAL y);
9+VAL idris_bigMinus(VM*, VAL x, VAL y);
10+VAL idris_bigTimes(VM*, VAL x, VAL y);
11+VAL idris_bigDivide(VM*, VAL x, VAL y);
12+
13+VAL idris_bigEq(VM*, VAL x, VAL y);
14+VAL idris_bigLt(VM*, VAL x, VAL y);
15+VAL idris_bigLe(VM*, VAL x, VAL y);
16+VAL idris_bigGt(VM*, VAL x, VAL y);
17+VAL idris_bigGe(VM*, VAL x, VAL y);
18+
19+VAL idris_castIntBig(VM* vm, VAL i);
20+VAL idris_castBigInt(VM* vm, VAL i);
21+VAL idris_castStrBig(VM* vm, VAL i);
22+VAL idris_castBigStr(VM* vm, VAL i);
23+
24+#define GETMPZ(x) *((mpz_t*)((x)->info.ptr))
25+
26+#endif
rts/idris_rts.h+4−1
@@ -10,7 +10,7 @@
10// Closures
10// Closures
11
11
12typedef enum {
12typedef enum {
13− CON, INT, FLOAT, STRING, UNIT, PTR, FWD
13+ CON, INT, BIGINT, FLOAT, STRING, UNIT, PTR, FWD
14} ClosureType;
14} ClosureType;
15
15
16typedef struct {
16typedef struct {
@@ -107,7 +107,9 @@ VAL MKCON(VM* vm, int tag, int arity, ...);
107void PROJECT(VM* vm, VAL r, int loc, int arity);
107void PROJECT(VM* vm, VAL r, int loc, int arity);
108void SLIDE(VM* vm, int args);
108void SLIDE(VM* vm, int args);
109
109
110+void* allocate(VM* vm, size_t size);
110void* allocCon(VM* vm, int arity);
111void* allocCon(VM* vm, int arity);
112+
111void dumpVal(VAL r);
113void dumpVal(VAL r);
112
114
113// Casts
115// Casts
@@ -133,5 +135,6 @@ VAL idris_readStr(VM* vm, FILE* h);
133
135
134void stackOverflow();
136void stackOverflow();
135
137
138+#include "idris_gmp.h"
136
139
137#endif
140#endif
src/IRTS/CodegenC.hs+18−3
@@ -43,7 +43,7 @@ codegenC defs out exec incs libs dbg
43 gccDbg dbg ++
43 gccDbg dbg ++
44 " " ++ tmpn ++
44 " " ++ tmpn ++
45 " `idris --link` `idris --include` " ++ libs ++
45 " `idris --link` `idris --include` " ++ libs ++
46− " -lidris_rts -o " ++ out
46+ " -lidris_rts -lgmp -o " ++ out
47-- putStrLn cout
47-- putStrLn cout
48 exit <- system gcc
48 exit <- system gcc
49 when (exit /= ExitSuccess) $
49 when (exit /= ExitSuccess) $
@@ -86,7 +86,8 @@ bcc i (ASSIGNCONST l c)
86 = indent i ++ creg l ++ " = " ++ mkConst c ++ ";\n"
86 = indent i ++ creg l ++ " = " ++ mkConst c ++ ";\n"
87 where
87 where
88 mkConst (I i) = "MKINT(" ++ show i ++ ")"
88 mkConst (I i) = "MKINT(" ++ show i ++ ")"
89− mkConst (BI i) = "MKINT(" ++ show i ++ ")" -- TODO
89+ mkConst (BI i) | i < (2^30) = "MKINT(" ++ show i ++ ")"
90+ | otherwise = "MKBIGC(vm,\"" ++ show i ++ "\")"
90 mkConst (Fl f) = "MKFLOAT(vm, " ++ show f ++ ")"
91 mkConst (Fl f) = "MKFLOAT(vm, " ++ show f ++ ")"
91 mkConst (Ch c) = "MKINT(" ++ show (fromEnum c) ++ ")"
92 mkConst (Ch c) = "MKINT(" ++ show (fromEnum c) ++ ")"
92 mkConst (Str s) = "MKSTR(vm, " ++ show s ++ ")"
93 mkConst (Str s) = "MKSTR(vm, " ++ show s ++ ")"
@@ -169,6 +170,16 @@ doOp LFLe [l, r] = "FLOATBOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"
169doOp LFGt [l, r] = "FLOATBOP(>," ++ creg l ++ ", " ++ creg r ++ ")"
170doOp LFGt [l, r] = "FLOATBOP(>," ++ creg l ++ ", " ++ creg r ++ ")"
170doOp LFGe [l, r] = "FLOATBOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"
171doOp LFGe [l, r] = "FLOATBOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"
171
172
173+doOp LBPlus [l, r] = "idris_bigPlus(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
174+doOp LBMinus [l, r] = "idris_bigMinus(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
175+doOp LBTimes [l, r] = "idris_bigTimes(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
176+doOp LBDiv [l, r] = "idris_bigDivide(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
177+doOp LBEq [l, r] = "idris_bigEq(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
178+doOp LBLt [l, r] = "idris_bigLt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
179+doOp LBLe [l, r] = "idris_bigLe(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
180+doOp LBGt [l, r] = "idris_bigGt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
181+doOp LBGe [l, r] = "idris_bigGe(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
182+
172doOp LStrConcat [l,r] = "idris_concat(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
183doOp LStrConcat [l,r] = "idris_concat(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
173doOp LStrLt [l,r] = "idris_strlt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
184doOp LStrLt [l,r] = "idris_strlt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
174doOp LStrEq [l,r] = "idris_streq(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
185doOp LStrEq [l,r] = "idris_streq(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
@@ -177,7 +188,11 @@ doOp LStrLen [x] = "idris_strlen(vm, " ++ creg x ++ ")"
177doOp LIntFloat [x] = "idris_castIntFloat(" ++ creg x ++ ")"
188doOp LIntFloat [x] = "idris_castIntFloat(" ++ creg x ++ ")"
178doOp LFloatInt [x] = "idris_castFloatInt(" ++ creg x ++ ")"
189doOp LFloatInt [x] = "idris_castFloatInt(" ++ creg x ++ ")"
179doOp LIntStr [x] = "idris_castIntStr(vm, " ++ creg x ++ ")"
190doOp LIntStr [x] = "idris_castIntStr(vm, " ++ creg x ++ ")"
180−doOp LStrInt [x] = "idris_castFloatStr(vm, " ++ creg x ++ ")"
191+doOp LStrInt [x] = "idris_castStrInt(vm, " ++ creg x ++ ")"
192+doOp LIntBig [x] = "idris_castIntBig(vm, " ++ creg x ++ ")"
193+doOp LBigInt [x] = "idris_castBigInt(vm, " ++ creg x ++ ")"
194+doOp LStrBig [x] = "idris_castStrBig(vm, " ++ creg x ++ ")"
195+doOp LBigStr [x] = "idris_castBigStr(vm, " ++ creg x ++ ")"
181doOp LFloatStr [x] = "idris_castFloatStr(vm, " ++ creg x ++ ")"
196doOp LFloatStr [x] = "idris_castFloatStr(vm, " ++ creg x ++ ")"
182doOp LStrFloat [x] = "idris_castStrFloat(vm, " ++ creg x ++ ")"
197doOp LStrFloat [x] = "idris_castStrFloat(vm, " ++ creg x ++ ")"
183
198
src/IRTS/LParser.hs+23−4
@@ -54,7 +54,7 @@ fovm f = do defs <- parseFOVM f
54 let checked = checkDefs defuns (toAlist defuns)
54 let checked = checkDefs defuns (toAlist defuns)
55-- print checked
55-- print checked
56 case checked of
56 case checked of
57− OK c -> codegenC c "a.out" True ["math.h"] "" TRACE
57+ OK c -> codegenC c "a.out" True ["math.h"] "" NONE
58 Error e -> fail $ show e
58 Error e -> fail $ show e
59
59
60parseFOVM :: FilePath -> IO [(Name, LDecl)]
60parseFOVM :: FilePath -> IO [(Name, LDecl)]
@@ -88,14 +88,18 @@ pLExp = buildExpressionParser optable pLExp'
88optable = [[binary "*" (\x y -> LOp LTimes [x,y]) AssocLeft,
88optable = [[binary "*" (\x y -> LOp LTimes [x,y]) AssocLeft,
89 binary "/" (\x y -> LOp LDiv [x,y]) AssocLeft,
89 binary "/" (\x y -> LOp LDiv [x,y]) AssocLeft,
90 binary "*." (\x y -> LOp LFTimes [x,y]) AssocLeft,
90 binary "*." (\x y -> LOp LFTimes [x,y]) AssocLeft,
91− binary "/." (\x y -> LOp LFTimes [x,y]) AssocLeft
91+ binary "/." (\x y -> LOp LFDiv [x,y]) AssocLeft,
92+ binary "*:" (\x y -> LOp LBTimes [x,y]) AssocLeft,
93+ binary "/:" (\x y -> LOp LBDiv [x,y]) AssocLeft
92 ],
94 ],
93 [
95 [
94 binary "+" (\x y -> LOp LPlus [x,y]) AssocLeft,
96 binary "+" (\x y -> LOp LPlus [x,y]) AssocLeft,
95 binary "-" (\x y -> LOp LMinus [x,y]) AssocLeft,
97 binary "-" (\x y -> LOp LMinus [x,y]) AssocLeft,
96 binary "++" (\x y -> LOp LStrConcat [x,y]) AssocLeft,
98 binary "++" (\x y -> LOp LStrConcat [x,y]) AssocLeft,
97 binary "+." (\x y -> LOp LFPlus [x,y]) AssocLeft,
99 binary "+." (\x y -> LOp LFPlus [x,y]) AssocLeft,
98− binary "-." (\x y -> LOp LFMinus [x,y]) AssocLeft
100+ binary "-." (\x y -> LOp LFMinus [x,y]) AssocLeft,
101+ binary "+:" (\x y -> LOp LBPlus [x,y]) AssocLeft,
102+ binary "-:" (\x y -> LOp LBMinus [x,y]) AssocLeft
99 ],
103 ],
100 [
104 [
101 binary "==" (\x y -> LOp LEq [x, y]) AssocNone,
105 binary "==" (\x y -> LOp LEq [x, y]) AssocNone,
@@ -107,7 +111,13 @@ optable = [[binary "*" (\x y -> LOp LTimes [x,y]) AssocLeft,
107 binary "<=" (\x y -> LOp LLe [x, y]) AssocNone,
111 binary "<=" (\x y -> LOp LLe [x, y]) AssocNone,
108 binary "<=." (\x y -> LOp LFLe [x, y]) AssocNone,
112 binary "<=." (\x y -> LOp LFLe [x, y]) AssocNone,
109 binary ">=" (\x y -> LOp LGe [x, y]) AssocNone,
113 binary ">=" (\x y -> LOp LGe [x, y]) AssocNone,
110− binary ">=." (\x y -> LOp LFGe [x, y]) AssocNone
114+ binary ">=." (\x y -> LOp LFGe [x, y]) AssocNone,
115+
116+ binary "==:" (\x y -> LOp LBEq [x, y]) AssocNone,
117+ binary "<:" (\x y -> LOp LBLt [x, y]) AssocNone,
118+ binary ">:" (\x y -> LOp LBGt [x, y]) AssocNone,
119+ binary "<=:" (\x y -> LOp LBLe [x, y]) AssocNone,
120+ binary ">=:" (\x y -> LOp LBGe [x, y]) AssocNone
111 ]]
121 ]]
112
122
113binary name f assoc = Infix (do reservedOp name; return f) assoc
123binary name f assoc = Infix (do reservedOp name; return f) assoc
@@ -174,6 +184,14 @@ pCast = do reserved "FloatString"; lchar '('; e <- pLExp; lchar ')'
174 return (LOp LStrInt [e])
184 return (LOp LStrInt [e])
175 <|> do reserved "IntString"; lchar '('; e <- pLExp; lchar ')'
185 <|> do reserved "IntString"; lchar '('; e <- pLExp; lchar ')'
176 return (LOp LIntStr [e])
186 return (LOp LIntStr [e])
187+ <|> do reserved "BigInt"; lchar '('; e <- pLExp; lchar ')'
188+ return (LOp LBigInt [e])
189+ <|> do reserved "IntBig"; lchar '('; e <- pLExp; lchar ')'
190+ return (LOp LIntBig [e])
191+ <|> do reserved "BigString"; lchar '('; e <- pLExp; lchar ')'
192+ return (LOp LBigStr [e])
193+ <|> do reserved "StringBig"; lchar '('; e <- pLExp; lchar ')'
194+ return (LOp LStrBig [e])
177
195
178pPrim :: LParser LExp
196pPrim :: LParser LExp
179pPrim = do reserved "StrEq"; lchar '(';
197pPrim = do reserved "StrEq"; lchar '(';
@@ -219,6 +237,7 @@ pAlt = try (do x <- iName []
219
237
220pLConst :: LParser LExp
238pLConst :: LParser LExp
221pLConst = try (do f <- float; return $ LConst (Fl f))
239pLConst = try (do f <- float; return $ LConst (Fl f))
240+ <|> try (do i <- natural; lchar ':'; return $ LConst (BI i))
222 <|> try (do i <- natural; return $ LConst (I (fromInteger i)))
241 <|> try (do i <- natural; return $ LConst (I (fromInteger i)))
223 <|> try (do s <- strlit; return $ LConst (Str s))
242 <|> try (do s <- strlit; return $ LConst (Str s))
224 <|> try (do c <- chlit; return $ LConst (Ch c))
243 <|> try (do c <- chlit; return $ LConst (Ch c))
src/IRTS/Lang.hs+2
@@ -21,8 +21,10 @@ data LExp = LV LVar
21
21
22data PrimFn = LPlus | LMinus | LTimes | LDiv | LEq | LLt | LLe | LGt | LGe
22data PrimFn = LPlus | LMinus | LTimes | LDiv | LEq | LLt | LLe | LGt | LGe
23 | LFPlus | LFMinus | LFTimes | LFDiv | LFEq | LFLt | LFLe | LFGt | LFGe
23 | LFPlus | LFMinus | LFTimes | LFDiv | LFEq | LFLt | LFLe | LFGt | LFGe
24+ | LBPlus | LBMinus | LBTimes | LBDiv | LBEq | LBLt | LBLe | LBGt | LBGe
24 | LStrConcat | LStrLt | LStrEq | LStrLen
25 | LStrConcat | LStrLt | LStrEq | LStrLen
25 | LIntFloat | LFloatInt | LIntStr | LStrInt | LFloatStr | LStrFloat
26 | LIntFloat | LFloatInt | LIntStr | LStrInt | LFloatStr | LStrFloat
27+ | LIntBig | LBigInt | LStrBig | LBigStr
26 | LPrintNum | LPrintStr | LReadStr
28 | LPrintNum | LPrintStr | LReadStr
27 deriving Show
29 deriving Show
28
30