git.iko.soy/Idris-dev
on master help sign in
Reduce redundancy across integer operations
commit321b8fdc88765aa3e61e916b2c3eb4f77bb4837a authorBenjamin Saunders <besaunde@sfu.ca> dateSat 27 Apr 2013, 23:35 (14 years ago) parentd1cb783
7 files changed+333−746
compare with master
unifiedsplit
rts/idris_rts.h+1 src/IRTS/CodegenC.hs+53−146 src/IRTS/CodegenJava.hs+72−211 src/IRTS/CodegenJavaScript.hs+16−16 src/IRTS/LParser.hs+9−9 src/IRTS/Lang.hs+23−19 src/Idris/Primitives.hs+159−345
rts/idris_rts.h+1
@@ -125,6 +125,7 @@ typedef intptr_t i_int;
125125#define ISINT(x) ((((i_int)x)&1) == 1)
126126
127127#define INTOP(op,x,y) MKINT((i_int)((((i_int)x)>>1) op (((i_int)y)>>1)))
128+#define UINTOP(op,x,y) MKINT((i_int)((((uintptr_t)x)>>1) op (((uintptr_t)y)>>1)))
128129#define FLOATOP(op,x,y) MKFLOAT(vm, ((GETFLOAT(x)) op (GETFLOAT(y))))
129130#define FLOATBOP(op,x,y) MKINT((i_int)(((GETFLOAT(x)) op (GETFLOAT(y)))))
130131#define ADD(x,y) (void*)(((i_int)x)+(((i_int)y)-1))
src/IRTS/CodegenC.hs+53−146
@@ -10,6 +10,7 @@ import Paths_idris
1010import Util.System
1111
1212import Data.Char
13+import Data.List (intercalate)
1314import System.Process
1415import System.Exit
1516import System.IO
@@ -238,22 +239,30 @@ irts_c FPtr x = "GETPTR(" ++ x ++ ")"
238239irts_c FDouble x = "GETFLOAT(" ++ x ++ ")"
239240irts_c FAny x = x
240241
241−doOp v LPlus [l, r] = v ++ "ADD(" ++ creg l ++ ", " ++ creg r ++ ")"
242−doOp v LMinus [l, r] = v ++ "INTOP(-," ++ creg l ++ ", " ++ creg r ++ ")"
243−doOp v LTimes [l, r] = v ++ "MULT(" ++ creg l ++ ", " ++ creg r ++ ")"
244−doOp v LDiv [l, r] = v ++ "INTOP(/," ++ creg l ++ ", " ++ creg r ++ ")"
245−doOp v LMod [l, r] = v ++ "INTOP(%," ++ creg l ++ ", " ++ creg r ++ ")"
246−doOp v LAnd [l, r] = v ++ "INTOP(&," ++ creg l ++ ", " ++ creg r ++ ")"
247−doOp v LOr [l, r] = v ++ "INTOP(|," ++ creg l ++ ", " ++ creg r ++ ")"
248−doOp v LXOr [l, r] = v ++ "INTOP(^," ++ creg l ++ ", " ++ creg r ++ ")"
249−doOp v LSHL [l, r] = v ++ "INTOP(<<," ++ creg l ++ ", " ++ creg r ++ ")"
250−doOp v LSHR [l, r] = v ++ "INTOP(>>," ++ creg l ++ ", " ++ creg r ++ ")"
251−doOp v LCompl [x] = v ++ "INTOP(~," ++ creg x ++ ")"
252−doOp v LEq [l, r] = v ++ "INTOP(==," ++ creg l ++ ", " ++ creg r ++ ")"
253−doOp v LLt [l, r] = v ++ "INTOP(<," ++ creg l ++ ", " ++ creg r ++ ")"
254−doOp v LLe [l, r] = v ++ "INTOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"
255−doOp v LGt [l, r] = v ++ "INTOP(>," ++ creg l ++ ", " ++ creg r ++ ")"
256−doOp v LGe [l, r] = v ++ "INTOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"
242+bitOp v op ty args = v ++ "idris_b" ++ show (intTyWidth ty) ++ op ++ "(vm, " ++ intercalate ", " (map creg args) ++ ")"
243+
244+bitCoerce v op input output arg
245+ = v ++ "idris_b" ++ show (intTyWidth input) ++ op ++ show (intTyWidth output) ++ "(vm, " ++ creg arg ++ ")"
246+
247+doOp v (LPlus ITNative) [l, r] = v ++ "ADD(" ++ creg l ++ ", " ++ creg r ++ ")"
248+doOp v (LMinus ITNative) [l, r] = v ++ "INTOP(-," ++ creg l ++ ", " ++ creg r ++ ")"
249+doOp v (LTimes ITNative) [l, r] = v ++ "MULT(" ++ creg l ++ ", " ++ creg r ++ ")"
250+doOp v (LUDiv ITNative) [l, r] = v ++ "UINTOP(/," ++ creg l ++ ", " ++ creg r ++ ")"
251+doOp v (LSDiv ITNative) [l, r] = v ++ "INTOP(/," ++ creg l ++ ", " ++ creg r ++ ")"
252+doOp v (LURem ITNative) [l, r] = v ++ "UINTOP(%," ++ creg l ++ ", " ++ creg r ++ ")"
253+doOp v (LSRem ITNative) [l, r] = v ++ "INTOP(%," ++ creg l ++ ", " ++ creg r ++ ")"
254+doOp v (LAnd ITNative) [l, r] = v ++ "INTOP(&," ++ creg l ++ ", " ++ creg r ++ ")"
255+doOp v (LOr ITNative) [l, r] = v ++ "INTOP(|," ++ creg l ++ ", " ++ creg r ++ ")"
256+doOp v (LXOr ITNative) [l, r] = v ++ "INTOP(^," ++ creg l ++ ", " ++ creg r ++ ")"
257+doOp v (LSHL ITNative) [l, r] = v ++ "INTOP(<<," ++ creg l ++ ", " ++ creg r ++ ")"
258+doOp v (LLSHR ITNative) [l, r] = v ++ "UINTOP(>>," ++ creg l ++ ", " ++ creg r ++ ")"
259+doOp v (LASHR ITNative) [l, r] = v ++ "INTOP(>>," ++ creg l ++ ", " ++ creg r ++ ")"
260+doOp v (LCompl ITNative) [x] = v ++ "INTOP(~," ++ creg x ++ ")"
261+doOp v (LEq ITNative) [l, r] = v ++ "INTOP(==," ++ creg l ++ ", " ++ creg r ++ ")"
262+doOp v (LLt ITNative) [l, r] = v ++ "INTOP(<," ++ creg l ++ ", " ++ creg r ++ ")"
263+doOp v (LLe ITNative) [l, r] = v ++ "INTOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"
264+doOp v (LGt ITNative) [l, r] = v ++ "INTOP(>," ++ creg l ++ ", " ++ creg r ++ ")"
265+doOp v (LGe ITNative) [l, r] = v ++ "INTOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"
257266
258267doOp v LFPlus [l, r] = v ++ "FLOATOP(+," ++ creg l ++ ", " ++ creg r ++ ")"
259268doOp v LFMinus [l, r] = v ++ "FLOATOP(-," ++ creg l ++ ", " ++ creg r ++ ")"
@@ -304,136 +313,34 @@ doOp v LIntB64 [x] = v ++ "idris_b64(vm, " ++ creg x ++ ")"
304313
305314doOp v LB32Int [x] = v ++ "idris_castB32Int(vm, " ++ creg x ++ ")"
306315
307−doOp v LB8Lt [x, y] = v ++ "idris_b8Lt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
308−doOp v LB8Lte [x, y] = v ++ "idris_b8Lte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
309−doOp v LB8Eq [x, y] = v ++ "idris_b8Eq(vm, " ++ creg x ++ "," ++ creg y ++ ")"
310−doOp v LB8Gte [x, y] = v ++ "idris_b8Gte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
311−doOp v LB8Gt [x, y] = v ++ "idris_b8Gt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
312−
313−doOp v LB8Shl [x, y] = v ++ "idris_b8Shl(vm, " ++ creg x ++ "," ++ creg y ++ ")"
314−doOp v LB8LShr [x, y] = v ++ "idris_b8Shr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
315−doOp v LB8AShr [x, y] = v ++ "idris_b8AShr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
316−doOp v LB8And [x, y] = v ++ "idris_b8And(vm, " ++ creg x ++ "," ++ creg y ++ ")"
317−doOp v LB8Or [x, y] = v ++ "idris_b8Or(vm, " ++ creg x ++ "," ++ creg y ++ ")"
318−doOp v LB8Xor [x, y] = v ++ "idris_b8Xor(vm, " ++ creg x ++ "," ++ creg y ++ ")"
319−doOp v LB8Compl [x] = v ++ "idris_b8Compl(vm, " ++ creg x ++ ")"
320−
321−doOp v LB8Plus [x, y] = v ++ "idris_b8Plus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
322−doOp v LB8Minus [x, y] = v ++ "idris_b8Minus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
323−doOp v LB8Times [x, y] = v ++ "idris_b8Times(vm, " ++ creg x ++ "," ++ creg y ++ ")"
324−doOp v LB8UDiv [x, y] = v ++ "idris_b8UDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
325−doOp v LB8SDiv [x, y] = v ++ "idris_b8SDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
326−doOp v LB8URem [x, y] = v ++ "idris_b8URem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
327−doOp v LB8SRem [x, y] = v ++ "idris_b8SRem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
328−
329−doOp v LB8Z16 [x] = v ++ "idris_b8Z16(vm, " ++ creg x ++ ")"
330−doOp v LB8Z32 [x] = v ++ "idris_b8Z32(vm, " ++ creg x ++ ")"
331−doOp v LB8Z64 [x] = v ++ "idris_b8Z64(vm, " ++ creg x ++ ")"
332−doOp v LB8S16 [x] = v ++ "idris_b8S16(vm, " ++ creg x ++ ")"
333−doOp v LB8S32 [x] = v ++ "idris_b8S32(vm, " ++ creg x ++ ")"
334−doOp v LB8S64 [x] = v ++ "idris_b8S64(vm, " ++ creg x ++ ")"
335−
336−doOp v LB16Lt [x, y] = v ++ "idris_b16Lt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
337−doOp v LB16Lte [x, y] = v ++ "idris_b16Lte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
338−doOp v LB16Eq [x, y] = v ++ "idris_b16Eq(vm, " ++ creg x ++ "," ++ creg y ++ ")"
339−doOp v LB16Gte [x, y] = v ++ "idris_b16Gte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
340−doOp v LB16Gt [x, y] = v ++ "idris_b16Gt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
341−
342−doOp v LB16Shl [x, y] = v ++ "idris_b16Shl(vm, " ++ creg x ++ "," ++ creg y ++ ")"
343−doOp v LB16LShr [x, y] = v ++ "idris_b16Shr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
344−doOp v LB16AShr [x, y] = v ++ "idris_b16AShr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
345−doOp v LB16And [x, y] = v ++ "idris_b16And(vm, " ++ creg x ++ "," ++ creg y ++ ")"
346−doOp v LB16Or [x, y] = v ++ "idris_b16Or(vm, " ++ creg x ++ "," ++ creg y ++ ")"
347−doOp v LB16Xor [x, y] = v ++ "idris_b16Xor(vm, " ++ creg x ++ "," ++ creg y ++ ")"
348−doOp v LB16Compl [x] = v ++ "idris_b16Compl(vm, " ++ creg x ++ ")"
349−
350−doOp v LB16Plus [x, y] =
351− v ++ "idris_b16Plus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
352−doOp v LB16Minus [x, y] =
353− v ++ "idris_b16Minus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
354−doOp v LB16Times [x, y] =
355− v ++ "idris_b16Times(vm, " ++ creg x ++ "," ++ creg y ++ ")"
356−doOp v LB16UDiv [x, y] =
357− v ++ "idris_b16UDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
358−doOp v LB16SDiv [x, y] =
359− v ++ "idris_b16SDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
360−doOp v LB16URem [x, y] =
361− v ++ "idris_b16URem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
362−doOp v LB16SRem [x, y] =
363− v ++ "idris_b16SRem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
364−
365−doOp v LB16Z32 [x] = v ++ "idris_b16Z32(vm, " ++ creg x ++ ")"
366−doOp v LB16Z64 [x] = v ++ "idris_b16Z64(vm, " ++ creg x ++ ")"
367−doOp v LB16S32 [x] = v ++ "idris_b16S32(vm, " ++ creg x ++ ")"
368−doOp v LB16S64 [x] = v ++ "idris_b16S64(vm, " ++ creg x ++ ")"
369−doOp v LB16T8 [x] = v ++ "idris_b16T8(vm, " ++ creg x ++ ")"
370−
371−doOp v LB32Lt [x, y] = v ++ "idris_b32Lt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
372−doOp v LB32Lte [x, y] = v ++ "idris_b32Lte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
373−doOp v LB32Eq [x, y] = v ++ "idris_b32Eq(vm, " ++ creg x ++ "," ++ creg y ++ ")"
374−doOp v LB32Gte [x, y] = v ++ "idris_b32Gte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
375−doOp v LB32Gt [x, y] = v ++ "idris_b32Gt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
376−
377−doOp v LB32Shl [x, y] = v ++ "idris_b32Shl(vm, " ++ creg x ++ "," ++ creg y ++ ")"
378−doOp v LB32LShr [x, y] = v ++ "idris_b32Shr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
379−doOp v LB32AShr [x, y] = v ++ "idris_b32AShr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
380−doOp v LB32And [x, y] = v ++ "idris_b32And(vm, " ++ creg x ++ "," ++ creg y ++ ")"
381−doOp v LB32Or [x, y] = v ++ "idris_b32Or(vm, " ++ creg x ++ "," ++ creg y ++ ")"
382−doOp v LB32Xor [x, y] = v ++ "idris_b32Xor(vm, " ++ creg x ++ "," ++ creg y ++ ")"
383−doOp v LB32Compl [x] = v ++ "idris_b32Compl(vm, " ++ creg x ++ ")"
384−
385−doOp v LB32Plus [x, y] =
386− v ++ "idris_b32Plus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
387−doOp v LB32Minus [x, y] =
388− v ++ "idris_b32Minus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
389−doOp v LB32Times [x, y] =
390− v ++ "idris_b32Times(vm, " ++ creg x ++ "," ++ creg y ++ ")"
391−doOp v LB32UDiv [x, y] =
392− v ++ "idris_b32UDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
393−doOp v LB32SDiv [x, y] =
394− v ++ "idris_b32SDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
395−doOp v LB32URem [x, y] =
396− v ++ "idris_b32URem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
397−doOp v LB32SRem [x, y] =
398− v ++ "idris_b32SRem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
399−
400−doOp v LB32Z64 [x] = v ++ "idris_b32Z64(vm, " ++ creg x ++ ")"
401−doOp v LB32S64 [x] = v ++ "idris_b32S64(vm, " ++ creg x ++ ")"
402−doOp v LB32T8 [x] = v ++ "idris_b32T8(vm, " ++ creg x ++ ")"
403−doOp v LB32T16 [x] = v ++ "idris_b32T16(vm, " ++ creg x ++ ")"
404−
405−doOp v LB64Lt [x, y] = v ++ "idris_b64Lt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
406−doOp v LB64Lte [x, y] = v ++ "idris_b64Lte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
407−doOp v LB64Eq [x, y] = v ++ "idris_b64Eq(vm, " ++ creg x ++ "," ++ creg y ++ ")"
408−doOp v LB64Gte [x, y] = v ++ "idris_b64Gte(vm, " ++ creg x ++ "," ++ creg y ++ ")"
409−doOp v LB64Gt [x, y] = v ++ "idris_b64Gt(vm, " ++ creg x ++ "," ++ creg y ++ ")"
410−
411−doOp v LB64Shl [x, y] = v ++ "idris_b64Shl(vm, " ++ creg x ++ "," ++ creg y ++ ")"
412−doOp v LB64LShr [x, y] = v ++ "idris_b64Shr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
413−doOp v LB64AShr [x, y] = v ++ "idris_b64AShr(vm, " ++ creg x ++ "," ++ creg y ++ ")"
414−doOp v LB64And [x, y] = v ++ "idris_b64And(vm, " ++ creg x ++ "," ++ creg y ++ ")"
415−doOp v LB64Or [x, y] = v ++ "idris_b64Or(vm, " ++ creg x ++ "," ++ creg y ++ ")"
416−doOp v LB64Xor [x, y] = v ++ "idris_b64Xor(vm, " ++ creg x ++ "," ++ creg y ++ ")"
417−doOp v LB64Compl [x] = v ++ "idris_b64Compl(vm, " ++ creg x ++ ")"
418−
419−doOp v LB64Plus [x, y] =
420− v ++ "idris_b64Plus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
421−doOp v LB64Minus [x, y] =
422− v ++ "idris_b64Minus(vm, " ++ creg x ++ "," ++ creg y ++ ")"
423−doOp v LB64Times [x, y] =
424− v ++ "idris_b64Times(vm, " ++ creg x ++ "," ++ creg y ++ ")"
425−doOp v LB64UDiv [x, y] =
426− v ++ "idris_b64UDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
427−doOp v LB64SDiv [x, y] =
428− v ++ "idris_b64SDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"
429−doOp v LB64URem [x, y] =
430− v ++ "idris_b64URem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
431−doOp v LB64SRem [x, y] =
432− v ++ "idris_b64SRem(vm, " ++ creg x ++ "," ++ creg y ++ ")"
433−
434−doOp v LB64T8 [x] = v ++ "idris_b64T8(vm, " ++ creg x ++ ")"
435−doOp v LB64T16 [x] = v ++ "idris_b64T16(vm, " ++ creg x ++ ")"
436−doOp v LB64T32 [x] = v ++ "idris_b64T32(vm, " ++ creg x ++ ")"
316+doOp v (LLt ty) [x, y] = bitOp v "Lt" ty [x, y]
317+doOp v (LLe ty) [x, y] = bitOp v "Lte" ty [x, y]
318+doOp v (LEq ty) [x, y] = bitOp v "Eq" ty [x, y]
319+doOp v (LGe ty) [x, y] = bitOp v "Gte" ty [x, y]
320+doOp v (LGt ty) [x, y] = bitOp v "Gt" ty [x, y]
321+
322+doOp v (LSHL ty) [x, y] = bitOp v "Shl" ty [x, y]
323+doOp v (LLSHR ty) [x, y] = bitOp v "Shr" ty [x, y]
324+doOp v (LASHR ty) [x, y] = bitOp v "AShr" ty [x, y]
325+doOp v (LAnd ty) [x, y] = bitOp v "And" ty [x, y]
326+doOp v (LOr ty) [x, y] = bitOp v "Or" ty [x, y]
327+doOp v (LXOr ty) [x, y] = bitOp v "Xor" ty [x, y]
328+doOp v (LCompl ty) [x] = bitOp v "Compl" ty [x]
329+
330+doOp v (LPlus ty) [x, y] = bitOp v "Plus" ty [x, y]
331+doOp v (LMinus ty) [x, y] = bitOp v "Minus" ty [x, y]
332+doOp v (LTimes ty) [x, y] = bitOp v "Times" ty [x, y]
333+doOp v (LUDiv ty) [x, y] = bitOp v "UDiv" ty [x, y]
334+doOp v (LSDiv ty) [x, y] = bitOp v "SDiv" ty [x, y]
335+doOp v (LURem ty) [x, y] = bitOp v "URem" ty [x, y]
336+doOp v (LSRem ty) [x, y] = bitOp v "SRem" ty [x, y]
337+
338+doOp v (LSExt from to) [x]
339+ | intTyWidth from < intTyWidth to = bitCoerce v "S" from to x
340+doOp v (LZExt from to) [x]
341+ | intTyWidth from < intTyWidth to = bitCoerce v "Z" from to x
342+doOp v (LTrunc from to) [x]
343+ | intTyWidth from > intTyWidth to = bitCoerce v "T" from to x
437344
438345doOp v LFExp [x] = v ++ "MKFLOAT(exp(GETFLOAT(" ++ creg x ++ ")))"
439346doOp v LFLog [x] = v ++ "MKFLOAT(log(GETFLOAT(" ++ creg x ++ ")))"
src/IRTS/CodegenJava.hs+72−211
@@ -462,7 +462,27 @@ integerType :: ClassType
462462integerType = ClassType [(Ident "Integer", [])]
463463
464464longType :: ClassType
465−longType = ClassType [(Ident "Integer", [])]
465+longType = ClassType [(Ident "Long", [])]
466+
467+intTyToIdent IT8 = Ident "Byte"
468+intTyToIdent IT16 = Ident "Short"
469+intTyToIdent IT32 = Ident "Int"
470+intTyToIdent IT64 = Ident "Long"
471+
472+intTyToClass :: IntTy -> ClassType
473+intTyToClass ty = ClassType [(intTyToIdent ty, [])]
474+
475+intTyToMethod :: IntTy -> String
476+intTyToMethod IT8 = "byteValue"
477+intTyToMethod IT16 = "shortValue"
478+intTyToMethod IT32 = "intValue"
479+intTyToMethod IT64 = "longValue"
480+
481+intTyToPrimTy :: IntTy -> PrimType
482+intTyToPrimTy IT8 = ByteT
483+intTyToPrimTy IT16 = ShortT
484+intTyToPrimTy IT32 = IntT
485+intTyToPrimTy IT64 = LongT
466486
467487bigIntegerType :: ClassType
468488bigIntegerType = ClassType [(Ident "BigInteger", [])]
@@ -1245,24 +1265,22 @@ mkExp (SConst (PtrType)) = return $ mkClass objectType
12451265mkExp (SConst (VoidType)) = return $ mkClass voidType
12461266mkExp (SConst (Forgot)) = return $ mkClass objectType
12471267mkExp (SForeign _ fType meth args) = mkForeignInvoke fType meth args
1248−mkExp (SOp LPlus args) = mkBinOpExp integerType Add args
1249−mkExp (SOp LMinus args) = mkBinOpExp integerType Sub args
1250−mkExp (SOp LTimes args) = mkBinOpExp integerType Mult args
1251−mkExp (SOp LDiv args) = mkBinOpExp integerType Div args
1252−mkExp (SOp LMod args) = mkBinOpExp integerType Rem args
1253−mkExp (SOp LAnd args) = mkBinOpExp integerType And args
1254−mkExp (SOp LOr args) = mkBinOpExp integerType Or args
1255−mkExp (SOp LXOr args) = mkBinOpExp integerType Xor args
1256−mkExp (SOp LCompl [var]) =
1257− PreBitCompl <$> mkVarAccess (Just $ integerType) var
1258−mkExp (SOp LSHL args) = mkBinOpExp integerType LShift args
1259−mkExp (SOp LSHR args) = mkBinOpExp integerType RShift args
1260−mkExp (SOp LEq args) =
1261− mkMethodOpChain1 (mkBoolToNumber integerType) objectType "equals" args
1262−mkExp (SOp LLt args) = mkLogicalBinOpExp integerType LThan args
1263−mkExp (SOp LLe args) = mkLogicalBinOpExp integerType LThanE args
1264−mkExp (SOp LGt args) = mkLogicalBinOpExp integerType GThan args
1265−mkExp (SOp LGe args) = mkLogicalBinOpExp integerType GThanE args
1268+mkExp (SOp (LPlus ITNative) args) = mkExp (SOp (LPlus IT32) args)
1269+mkExp (SOp (LMinus ITNative) args) = mkExp (SOp (LMinus IT32) args)
1270+mkExp (SOp (LTimes ITNative) args) = mkExp (SOp (LTimes IT32) args)
1271+mkExp (SOp (LSDiv ITNative) args) = mkExp (SOp (LSDiv IT32) args)
1272+mkExp (SOp (LSRem ITNative) args) = mkExp (SOp (LSRem IT32) args)
1273+mkExp (SOp (LAnd ITNative) args) = mkExp (SOp (LAnd IT32) args)
1274+mkExp (SOp (LOr ITNative) args) = mkExp (SOp (LOr IT32) args)
1275+mkExp (SOp (LXOr ITNative) args) = mkExp (SOp (LXOr IT32) args)
1276+mkExp (SOp (LCompl ITNative) args) = mkExp (SOp (LCompl IT32) args)
1277+mkExp (SOp (LSHL ITNative) args) = mkExp (SOp (LSHL IT32) args)
1278+mkExp (SOp (LASHR ITNative) args) = mkExp (SOp (LASHR IT32) args)
1279+mkExp (SOp (LEq ITNative) args) = mkExp (SOp (LEq IT32) args)
1280+mkExp (SOp (LLt ITNative) args) = mkExp (SOp (LLt IT32) args)
1281+mkExp (SOp (LLe ITNative) args) = mkExp (SOp (LLe IT32) args)
1282+mkExp (SOp (LGt ITNative) args) = mkExp (SOp (LGt IT32) args)
1283+mkExp (SOp (LGe ITNative) args) = mkExp (SOp (LGe IT32) args)
12661284mkExp (SOp LFPlus args) = mkBinOpExp doubleType Add args
12671285mkExp (SOp LFMinus args) = mkBinOpExp doubleType Sub args
12681286mkExp (SOp LFTimes args) = mkBinOpExp doubleType Mult args
@@ -1363,203 +1381,46 @@ mkExp (SOp LPrintNum [arg]) =
13631381mkExp (SOp LPrintStr [arg]) =
13641382 mkSystemOutPrint <$> (mkVarAccess (Just stringType) arg)
13651383mkExp (SOp LReadStr [arg]) = mkExp (SForeign LANG_C FString "idris_readStr" [(FPtr, arg)])
1366−mkExp (SOp LB8Lt args) = mkLogicalBinOpExp byteType LThan args
1367−mkExp (SOp LB8Lte args) = mkLogicalBinOpExp byteType LThanE args
1368−mkExp (SOp LB8Eq args) =
1369− mkMethodOpChain1 (mkBoolToNumber byteType) byteType "equals" args
1370−mkExp (SOp LB8Gt args) = mkLogicalBinOpExp byteType GThan args
1371−mkExp (SOp LB8Gte args) = mkLogicalBinOpExp byteType GThanE args
1372−mkExp (SOp LB8Plus args) = mkBinOpExp byteType Add args
1373−mkExp (SOp LB8Minus args) = mkBinOpExp byteType Sub args
1374−mkExp (SOp LB8Times args) = mkBinOpExp byteType Mult args
1375−mkExp (SOp LB8UDiv args) = mkBinOpExpConv "shortValue" ShortT byteType Div args
1376−mkExp (SOp LB8SDiv args) = mkBinOpExp byteType Div args
1377−mkExp (SOp LB8URem args) = mkBinOpExpConv "shortValue" ShortT byteType Rem args
1378−mkExp (SOp LB8SRem args) = mkBinOpExp byteType Rem args
1379−mkExp (SOp LB8Shl args) = mkBinOpExp byteType LShift args
1380−mkExp (SOp LB8LShr args) = mkBinOpExp byteType RRShift args
1381−mkExp (SOp LB8AShr args) = mkBinOpExp byteType RShift args
1382−mkExp (SOp LB8And args) = mkBinOpExp byteType And args
1383−mkExp (SOp LB8Or args) = mkBinOpExp byteType Or args
1384−mkExp (SOp LB8Xor args) = mkBinOpExp byteType Xor args
1385−mkExp (SOp LB8Compl [var]) =
1386− PreBitCompl <$> mkVarAccess (Just $ byteType) var
1387−mkExp (SOp LB8Z16 [var]) = mkZeroExt "shortValue" 8 byteType shortType var
1388−mkExp (SOp LB8Z32 [var]) = mkZeroExt "intValue" 8 byteType integerType var
1389−mkExp (SOp LB8Z64 [var]) = mkZeroExt "longValue" 8 byteType longType var
1390−mkExp (SOp LB8S16 [var]) = mkSignedExt "shortValue" byteType shortType var
1391−mkExp (SOp LB8S32 [var]) = mkSignedExt "intValue" byteType integerType var
1392−mkExp (SOp LB8S64 [var]) = mkSignedExt "longValue" byteType longType var
1393−mkExp (SOp LB16Lt args) = mkLogicalBinOpExp shortType LThan args
1394−mkExp (SOp LB16Lte args) = mkLogicalBinOpExp shortType LThanE args
1395−mkExp (SOp LB16Eq args) =
1396− mkMethodOpChain1 (mkBoolToNumber shortType) shortType "equals" args
1397−mkExp (SOp LB16Gt args) = mkLogicalBinOpExp shortType GThan args
1398−mkExp (SOp LB16Gte args) = mkLogicalBinOpExp shortType GThanE args
1399−mkExp (SOp LB16Plus args) = mkBinOpExp shortType Add args
1400−mkExp (SOp LB16Minus args) = mkBinOpExp shortType Sub args
1401−mkExp (SOp LB16Times args) = mkBinOpExp shortType Mult args
1402−mkExp (SOp LB16UDiv args) = mkBinOpExpConv "intValue" IntT shortType Div args
1403−mkExp (SOp LB16SDiv args) = mkBinOpExp shortType Div args
1404−mkExp (SOp LB16URem args) = mkBinOpExpConv "intValue" IntT shortType Rem args
1405−mkExp (SOp LB16SRem args) = mkBinOpExp shortType Rem args
1406−mkExp (SOp LB16Shl args) = mkBinOpExp shortType LShift args
1407−mkExp (SOp LB16LShr args) = mkBinOpExp shortType RRShift args
1408−mkExp (SOp LB16AShr args) = mkBinOpExp shortType RShift args
1409−mkExp (SOp LB16And args) = mkBinOpExp shortType And args
1410−mkExp (SOp LB16Or args) = mkBinOpExp shortType Or args
1411−mkExp (SOp LB16Xor args) = mkBinOpExp shortType Xor args
1412−mkExp (SOp LB16Compl [var]) =
1413− PreBitCompl <$> mkVarAccess (Just $ shortType) var
1414−mkExp (SOp LB16Z32 [var]) = mkZeroExt "intValue" 16 shortType integerType var
1415−mkExp (SOp LB16Z64 [var]) = mkZeroExt "longValue" 16 shortType longType var
1416−mkExp (SOp LB16S32 [var]) = mkSignedExt "intValue" shortType integerType var
1417−mkExp (SOp LB16S64 [var]) = mkSignedExt "longValue" shortType longType var
1418−mkExp (SOp LB16T8 [var]) =
1419− (\ var -> MethodInv $
1420− TypeMethodCall (J.Name [Ident "Byte"])
1384+mkExp (SOp (LLt ty) args) = mkLogicalBinOpExp (intTyToClass ty) LThan args
1385+mkExp (SOp (LLe ty) args) = mkLogicalBinOpExp (intTyToClass ty) LThanE args
1386+mkExp (SOp (LEq ty) args) =
1387+ mkMethodOpChain1 (mkBoolToNumber (intTyToClass ty)) (intTyToClass ty) "equals" args
1388+mkExp (SOp (LGt ty) args) = mkLogicalBinOpExp (intTyToClass ty) GThan args
1389+mkExp (SOp (LGe ty) args) = mkLogicalBinOpExp (intTyToClass ty) GThanE args
1390+mkExp (SOp (LPlus ty) args) = mkBinOpExp (intTyToClass ty) Add args
1391+mkExp (SOp (LMinus ty) args) = mkBinOpExp (intTyToClass ty) Sub args
1392+mkExp (SOp (LTimes ty) args) = mkBinOpExp (intTyToClass ty) Mult args
1393+mkExp (SOp (LUDiv ty) args) = mkBinOpExpConv (intTyToMethod ty) (intTyToPrimTy ty) (intTyToClass ty) Div args
1394+mkExp (SOp (LSDiv ty) args) = mkBinOpExp (intTyToClass ty) Div args
1395+mkExp (SOp (LURem ty) args) = mkBinOpExpConv (intTyToMethod ty) (intTyToPrimTy ty) (intTyToClass ty) Rem args
1396+mkExp (SOp (LSRem ty) args) = mkBinOpExp (intTyToClass ty) Rem args
1397+mkExp (SOp (LSHL ty) args) = mkBinOpExp (intTyToClass ty) LShift args
1398+mkExp (SOp (LLSHR ty) args) = mkBinOpExp (intTyToClass ty) RRShift args
1399+mkExp (SOp (LASHR ty) args) = mkBinOpExp (intTyToClass ty) RShift args
1400+mkExp (SOp (LAnd ty) args) = mkBinOpExp (intTyToClass ty) And args
1401+mkExp (SOp (LOr ty) args) = mkBinOpExp (intTyToClass ty) Or args
1402+mkExp (SOp (LXOr ty) args) = mkBinOpExp (intTyToClass ty) Xor args
1403+mkExp (SOp (LCompl ty) [var]) = PreBitCompl <$> mkVarAccess (Just $ intTyToClass ty) var
1404+mkExp (SOp (LZExt from to) [var])
1405+ | intTyWidth from < intTyWidth to
1406+ = mkZeroExt (intTyToMethod to) (intTyWidth from) (intTyToClass from) (intTyToClass to) var
1407+mkExp (SOp (LSExt from to) [var])
1408+ | intTyWidth from < intTyWidth to
1409+ = mkSignedExt (intTyToMethod to) (intTyToClass from) (intTyToClass to) var
1410+mkExp (SOp (LTrunc from to) [var])
1411+ | intTyWidth from > intTyWidth to
1412+ = (\ var -> MethodInv $
1413+ TypeMethodCall (J.Name [intTyToIdent to])
14211414 []
14221415 (Ident "valueOf")
14231416 [ MethodInv
1424− $ PrimaryMethodCall var [] (Ident "byteValue") [] ]
1425− )
1426− <$> mkVarAccess (Just $ shortType) var
1427−mkExp (SOp LB32Lt args) = mkLogicalBinOpExp integerType LThan args
1428−mkExp (SOp LB32Lte args) = mkLogicalBinOpExp integerType LThanE args
1429−mkExp (SOp LB32Eq args) =
1430− mkMethodOpChain1 (mkBoolToNumber integerType) integerType "equals" args
1431−mkExp (SOp LB32Gt args) = mkLogicalBinOpExp integerType GThan args
1432−mkExp (SOp LB32Gte args) = mkLogicalBinOpExp integerType GThanE args
1433−mkExp (SOp LB32Plus args) = mkBinOpExp integerType Add args
1434−mkExp (SOp LB32Minus args) = mkBinOpExp integerType Sub args
1435−mkExp (SOp LB32Times args) = mkBinOpExp integerType Mult args
1436−mkExp (SOp LB32UDiv args) = mkBinOpExpConv "longValue" LongT integerType Div args
1437−mkExp (SOp LB32SDiv args) = mkBinOpExp integerType Div args
1438−mkExp (SOp LB32URem args) = mkBinOpExpConv "longValue" LongT integerType Rem args
1439−mkExp (SOp LB32SRem args) = mkBinOpExp integerType Rem args
1440−mkExp (SOp LB32Shl args) = mkBinOpExp integerType LShift args
1441−mkExp (SOp LB32LShr args) = mkBinOpExp integerType RRShift args
1442−mkExp (SOp LB32AShr args) = mkBinOpExp integerType RShift args
1443−mkExp (SOp LB32And args) = mkBinOpExp integerType And args
1444−mkExp (SOp LB32Or args) = mkBinOpExp integerType Or args
1445−mkExp (SOp LB32Xor args) = mkBinOpExp integerType Xor args
1446−mkExp (SOp LB32Compl [var]) =
1447− PreBitCompl <$> mkVarAccess (Just $ integerType) var
1448−mkExp (SOp LB32Z64 [var]) = mkZeroExt "longValue" 32 integerType longType var
1449−mkExp (SOp LB32S64 [var]) = mkSignedExt "longValue" integerType longType var
1450−mkExp (SOp LB32T8 [var]) =
1451− (\ var -> MethodInv
1452− $ TypeMethodCall (J.Name [Ident "Byte"])
1453− []
1454− (Ident "valueOf")
1455− [ MethodInv $ PrimaryMethodCall var [] (Ident "byteValue") [] ]
1456− )
1457− <$> mkVarAccess (Just $ integerType) var
1458−mkExp (SOp LB32T16 [var]) =
1459− (\ var -> MethodInv
1460− $ TypeMethodCall (J.Name [Ident "Short"])
1461− []
1462− (Ident "valueOf")
1463− [ MethodInv $ PrimaryMethodCall var [] (Ident "shortValue") [] ]
1464− )
1465− <$> mkVarAccess (Just $ integerType) var
1466−mkExp (SOp LB64Lt args) = mkLogicalBinOpExp longType LThan args
1467−mkExp (SOp LB64Lte args) = mkLogicalBinOpExp longType LThanE args
1468−mkExp (SOp LB64Eq args) =
1469− mkMethodOpChain1 (mkBoolToNumber longType) longType "equals" args
1470−mkExp (SOp LB64Gt args) = mkLogicalBinOpExp longType GThan args
1471−mkExp (SOp LB64Gte args) = mkLogicalBinOpExp longType GThanE args
1472−mkExp (SOp LB64Plus args) = mkBinOpExp longType Add args
1473−mkExp (SOp LB64Minus args) = mkBinOpExp longType Sub args
1474−mkExp (SOp LB64Times args) = mkBinOpExp longType Mult args
1475−mkExp (SOp LB64UDiv (arg:args)) = do
1476− (arg:args) <- mapM (mkVarAccess (Just longType)) (arg:args)
1477− return $ foldl (\ exp arg ->
1478− MethodInv $ PrimaryMethodCall
1479− ( MethodInv $ PrimaryMethodCall
1480− ( MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])
1481− []
1482− (Ident "valueOf")
1483− [ exp ]
1484− )
1485− []
1486− (Ident "divide")
1487− [ MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])
1488− []
1489− (Ident "valueOf")
1490− [ arg ]
1491− ]
1492− )
1493− []
1494− (Ident "longValue")
1495− []
1496− )
1497− arg
1498− args
1499−mkExp (SOp LB64SDiv args) = mkBinOpExp longType Div args
1500−mkExp (SOp LB64URem (arg:args)) = do
1501− (arg:args) <- mapM (mkVarAccess (Just longType)) (arg:args)
1502− return $ foldl (\ exp arg ->
1503− MethodInv $ PrimaryMethodCall
1504− ( MethodInv $ PrimaryMethodCall
1505− ( MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])
1506− []
1507− (Ident "valueOf")
1508− [ exp ]
1509− )
1510− []
1511− (Ident "remainder")
1512− [ MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])
1513− []
1514− (Ident "valueOf")
1515− [ arg ]
1516− ]
1517− )
1518− []
1519− (Ident "longValue")
1520− []
1521− )
1522− arg
1523− args
1524−mkExp (SOp LB64SRem args) = mkBinOpExp longType Rem args
1525−mkExp (SOp LB64Shl args) = mkBinOpExp longType LShift args
1526−mkExp (SOp LB64LShr args) = mkBinOpExp longType RRShift args
1527−mkExp (SOp LB64AShr args) = mkBinOpExp longType RShift args
1528−mkExp (SOp LB64And args) = mkBinOpExp longType And args
1529−mkExp (SOp LB64Or args) = mkBinOpExp longType Or args
1530−mkExp (SOp LB64Xor args) = mkBinOpExp longType Xor args
1531−mkExp (SOp LB64Compl [var]) =
1532− PreBitCompl <$> mkVarAccess (Just $ longType) var
1533−mkExp (SOp LB64T8 [var]) =
1534− (\ var -> MethodInv
1535− $ TypeMethodCall (J.Name [Ident "Byte"])
1536− []
1537− (Ident "valueOf")
1538− [ MethodInv
1539− $ PrimaryMethodCall var [] (Ident "byteValue") []
1540− ]
1541− )
1542− <$> mkVarAccess (Just $ longType) var
1543−mkExp (SOp LB64T16 [var]) =
1544− (\ var -> MethodInv
1545− $ TypeMethodCall (J.Name [Ident "Short"])
1546− []
1547− (Ident "valueOf")
1548− [ MethodInv $ PrimaryMethodCall var [] (Ident "shortValue") [] ]
1549− )
1550− <$> mkVarAccess (Just $ longType) var
1551−mkExp (SOp LB64T32 [var]) =
1552− (\ var -> MethodInv
1553− $ TypeMethodCall (J.Name [Ident "Integer"])
1554− []
1555− (Ident "valueOf")
1556− [ MethodInv $ PrimaryMethodCall var [] (Ident "intValue") [] ]
1417+ $ PrimaryMethodCall var [] (Ident (intTyToMethod to)) [] ]
15571418 )
1558− <$> mkVarAccess (Just $ longType) var
1559−mkExp (SOp LIntB8 [arg]) = mkExp (SOp LB32T8 [arg])
1560−mkExp (SOp LIntB16 [arg]) = mkExp (SOp LB32T16 [arg])
1419+ <$> mkVarAccess (Just $ intTyToClass from) var
1420+mkExp (SOp LIntB8 [arg]) = mkExp (SOp (LTrunc IT32 IT8) [arg])
1421+mkExp (SOp LIntB16 [arg]) = mkExp (SOp (LTrunc IT32 IT16) [arg])
15611422mkExp (SOp LIntB32 [arg]) = mkExp (SV arg)
1562−mkExp (SOp LIntB64 [arg]) = mkExp (SOp LB32S64 [arg])
1423+mkExp (SOp LIntB64 [arg]) = mkExp (SOp (LSExt IT32 IT64) [arg])
15631424mkExp (SOp LB32Int [arg]) = mkExp (SV arg)
15641425mkExp (SOp LFExp [arg]) = mkMathFun "exp" arg
15651426mkExp (SOp LFLog [arg]) = mkMathFun "log" arg
src/IRTS/CodegenJavaScript.hs+16−16
@@ -202,37 +202,37 @@ translateExpression (SApp True name vars) =
202202 ++ ";\n});"
203203
204204translateExpression (SOp op vars)
205− | LPlus <- op
205+ | (LPlus _) <- op
206206 , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
207− | LMinus <- op
207+ | (LMinus _) <- op
208208 , (lhs:rhs:_) <- vars = translateBinaryOp "-" lhs rhs
209− | LTimes <- op
209+ | (LTimes _) <- op
210210 , (lhs:rhs:_) <- vars = translateBinaryOp "*" lhs rhs
211− | LDiv <- op
211+ | (LSDiv _) <- op
212212 , (lhs:rhs:_) <- vars = translateBinaryOp "/" lhs rhs
213− | LMod <- op
213+ | (LSRem _) <- op
214214 , (lhs:rhs:_) <- vars = translateBinaryOp "%" lhs rhs
215− | LEq <- op
215+ | (LEq _) <- op
216216 , (lhs:rhs:_) <- vars = translateBinaryOp "==" lhs rhs
217− | LLt <- op
217+ | (LLt _) <- op
218218 , (lhs:rhs:_) <- vars = translateBinaryOp "<" lhs rhs
219− | LLe <- op
219+ | (LLe _) <- op
220220 , (lhs:rhs:_) <- vars = translateBinaryOp "<=" lhs rhs
221− | LGt <- op
221+ | (LGt _) <- op
222222 , (lhs:rhs:_) <- vars = translateBinaryOp ">" lhs rhs
223− | LGe <- op
223+ | (LGe _) <- op
224224 , (lhs:rhs:_) <- vars = translateBinaryOp ">=" lhs rhs
225− | LAnd <- op
225+ | (LAnd _) <- op
226226 , (lhs:rhs:_) <- vars = translateBinaryOp "&" lhs rhs
227− | LOr <- op
227+ | (LOr _) <- op
228228 , (lhs:rhs:_) <- vars = translateBinaryOp "|" lhs rhs
229− | LXOr <- op
229+ | (LXOr _) <- op
230230 , (lhs:rhs:_) <- vars = translateBinaryOp "^" lhs rhs
231− | LSHL <- op
231+ | (LSHL _) <- op
232232 , (lhs:rhs:_) <- vars = translateBinaryOp "<<" rhs lhs
233− | LSHR <- op
233+ | (LASHR _) <- op
234234 , (lhs:rhs:_) <- vars = translateBinaryOp ">>" rhs lhs
235− | LCompl <- op
235+ | (LCompl _) <- op
236236 , (arg:_) <- vars = '~' : translateVariableName arg
237237
238238 | LBPlus <- op
src/IRTS/LParser.hs+9−9
@@ -92,16 +92,16 @@ pLDecl = do reserved "data"
9292
9393pLExp = buildExpressionParser optable pLExp'
9494
95−optable = [[binary "*" (\x y -> LOp LTimes [x,y]) AssocLeft,
96− binary "/" (\x y -> LOp LDiv [x,y]) AssocLeft,
95+optable = [[binary "*" (\x y -> LOp (LTimes ITNative) [x,y]) AssocLeft,
96+ binary "/" (\x y -> LOp (LSDiv ITNative) [x,y]) AssocLeft,
9797 binary "*." (\x y -> LOp LFTimes [x,y]) AssocLeft,
9898 binary "/." (\x y -> LOp LFDiv [x,y]) AssocLeft,
9999 binary "*:" (\x y -> LOp LBTimes [x,y]) AssocLeft,
100100 binary "/:" (\x y -> LOp LBDiv [x,y]) AssocLeft
101101 ],
102102 [
103− binary "+" (\x y -> LOp LPlus [x,y]) AssocLeft,
104− binary "-" (\x y -> LOp LMinus [x,y]) AssocLeft,
103+ binary "+" (\x y -> LOp (LPlus ITNative) [x,y]) AssocLeft,
104+ binary "-" (\x y -> LOp (LMinus ITNative) [x,y]) AssocLeft,
105105 binary "++" (\x y -> LOp LStrConcat [x,y]) AssocLeft,
106106 binary "+." (\x y -> LOp LFPlus [x,y]) AssocLeft,
107107 binary "-." (\x y -> LOp LFMinus [x,y]) AssocLeft,
@@ -109,15 +109,15 @@ optable = [[binary "*" (\x y -> LOp LTimes [x,y]) AssocLeft,
109109 binary "-:" (\x y -> LOp LBMinus [x,y]) AssocLeft
110110 ],
111111 [
112− binary "==" (\x y -> LOp LEq [x, y]) AssocNone,
112+ binary "==" (\x y -> LOp (LEq ITNative) [x, y]) AssocNone,
113113 binary "==." (\x y -> LOp LFEq [x, y]) AssocNone,
114− binary "<" (\x y -> LOp LLt [x, y]) AssocNone,
114+ binary "<" (\x y -> LOp (LLt ITNative) [x, y]) AssocNone,
115115 binary "<." (\x y -> LOp LFLt [x, y]) AssocNone,
116− binary ">" (\x y -> LOp LGt [x, y]) AssocNone,
116+ binary ">" (\x y -> LOp (LGt ITNative) [x, y]) AssocNone,
117117 binary ">." (\x y -> LOp LFGt [x, y]) AssocNone,
118− binary "<=" (\x y -> LOp LLe [x, y]) AssocNone,
118+ binary "<=" (\x y -> LOp (LLe ITNative) [x, y]) AssocNone,
119119 binary "<=." (\x y -> LOp LFLe [x, y]) AssocNone,
120− binary ">=" (\x y -> LOp LGe [x, y]) AssocNone,
120+ binary ">=" (\x y -> LOp (LGe ITNative) [x, y]) AssocNone,
121121 binary ">=." (\x y -> LOp LFGe [x, y]) AssocNone,
122122
123123 binary "==:" (\x y -> LOp LBEq [x, y]) AssocNone,
src/IRTS/Lang.hs+23−19
@@ -28,9 +28,29 @@ data LExp = LV LVar
2828-- Primitive operators. Backends are not *required* to implement all
2929-- of these, but should report an error if they are unable
3030
31−data PrimFn = LPlus | LMinus | LTimes | LDiv | LMod
32− | LAnd | LOr | LXOr | LCompl | LSHL| LSHR
33− | LEq | LLt | LLe | LGt | LGe
31+data IntTy = ITNative | IT8 | IT16 | IT32 | IT64
32+ deriving (Show, Eq)
33+
34+intTyWidth :: IntTy -> Int
35+intTyWidth IT8 = 8
36+intTyWidth IT16 = 16
37+intTyWidth IT32 = 32
38+intTyWidth IT64 = 64
39+intTyWidth ITNative = error "IRTS.Lang.intTyWidth: Native integer width is unspecified"
40+
41+intTyToConst :: IntTy -> Const
42+intTyToConst IT8 = B8Type
43+intTyToConst IT16 = B16Type
44+intTyToConst IT32 = B32Type
45+intTyToConst IT64 = B64Type
46+intTyToConst ITNative = IType
47+
48+data PrimFn = LPlus IntTy | LMinus IntTy | LTimes IntTy
49+ | LUDiv IntTy | LSDiv IntTy | LURem IntTy | LSRem IntTy
50+ | LAnd IntTy | LOr IntTy | LXOr IntTy | LCompl IntTy
51+ | LSHL IntTy | LLSHR IntTy | LASHR IntTy
52+ | LEq IntTy | LLt IntTy | LLe IntTy | LGt IntTy | LGe IntTy
53+ | LSExt IntTy IntTy | LZExt IntTy IntTy | LTrunc IntTy IntTy
3454 | LFPlus | LFMinus | LFTimes | LFDiv
3555 | LFEq | LFLt | LFLe | LFGt | LFGe
3656 | LBPlus | LBMinus | LBDec | LBTimes | LBDiv | LBMod
@@ -40,22 +60,6 @@ data PrimFn = LPlus | LMinus | LTimes | LDiv | LMod
4060 | LIntBig | LBigInt | LStrBig | LBigStr | LChInt | LIntCh
4161 | LPrintNum | LPrintStr | LReadStr
4262
43− | LB8Lt | LB8Lte | LB8Eq | LB8Gt | LB8Gte
44− | LB8Plus | LB8Minus | LB8Times | LB8UDiv | LB8SDiv | LB8URem | LB8SRem
45− | LB8Shl | LB8LShr | LB8AShr | LB8And | LB8Or | LB8Xor | LB8Compl
46− | LB8Z16 | LB8Z32 | LB8Z64 | LB8S16 | LB8S32 | LB8S64 -- Zero/Sign extension
47− | LB16Lt | LB16Lte | LB16Eq | LB16Gt | LB16Gte
48− | LB16Plus | LB16Minus | LB16Times | LB16UDiv | LB16SDiv | LB16URem | LB16SRem
49− | LB16Shl | LB16LShr | LB16AShr | LB16And | LB16Or | LB16Xor | LB16Compl
50− | LB16Z32 | LB16Z64 | LB16S32 | LB16S64 | LB16T8 -- and Truncation
51− | LB32Lt | LB32Lte | LB32Eq | LB32Gt | LB32Gte
52− | LB32Plus | LB32Minus | LB32Times | LB32UDiv | LB32SDiv | LB32URem | LB32SRem
53− | LB32Shl | LB32LShr | LB32AShr | LB32And | LB32Or | LB32Xor | LB32Compl
54− | LB32Z64 | LB32S64 | LB32T8 | LB32T16
55− | LB64Lt | LB64Lte | LB64Eq | LB64Gt | LB64Gte
56− | LB64Plus | LB64Minus | LB64Times | LB64UDiv | LB64SDiv | LB64URem | LB64SRem
57− | LB64Shl | LB64LShr | LB64AShr | LB64And | LB64Or | LB64Xor | LB64Compl
58− | LB64T8 | LB64T16 | LB64T32
5963 | LIntB8 | LIntB16 | LIntB32 | LIntB64 | LB32Int
6064
6165 | LFExp | LFLog | LFSin | LFCos | LFTan | LFASin | LFACos | LFATan
src/Idris/Primitives.hs+159−345
@@ -35,247 +35,68 @@ partial = Partial NotCovering
3535primitives =
3636 -- operators
3737 [Prim (UN "prim__addInt") (ty [IType, IType] IType) 2 (iBin (+))
38− (2, LPlus) total,
38+ (2, LPlus ITNative) total,
3939 Prim (UN "prim__subInt") (ty [IType, IType] IType) 2 (iBin (-))
40− (2, LMinus) total,
40+ (2, LMinus ITNative) total,
4141 Prim (UN "prim__mulInt") (ty [IType, IType] IType) 2 (iBin (*))
42− (2, LTimes) total,
42+ (2, LTimes ITNative) total,
4343 Prim (UN "prim__divInt") (ty [IType, IType] IType) 2 (iBin div)
44− (2, LDiv) partial,
44+ (2, LSDiv ITNative) partial,
4545 Prim (UN "prim__modInt") (ty [IType, IType] IType) 2 (iBin mod)
46− (2, LMod) partial,
46+ (2, LSRem ITNative) partial,
4747 Prim (UN "prim__andInt") (ty [IType, IType] IType) 2 (iBin (.&.))
48− (2, LAnd) partial,
48+ (2, LAnd ITNative) partial,
4949 Prim (UN "prim__orInt") (ty [IType, IType] IType) 2 (iBin (.|.))
50− (2, LOr) partial,
50+ (2, LOr ITNative) partial,
5151 Prim (UN "prim__xorInt") (ty [IType, IType] IType) 2 (iBin xor)
52− (2, LXOr) partial,
52+ (2, LXOr ITNative) partial,
5353 Prim (UN "prim__shLInt") (ty [IType, IType] IType) 2 (iBin shiftL)
54− (2, LSHL) partial,
54+ (2, LSHL ITNative) partial,
5555 Prim (UN "prim__shRInt") (ty [IType, IType] IType) 2 (iBin shiftR)
56− (2, LSHR) partial,
56+ (2, LASHR ITNative) partial,
5757 Prim (UN "prim__complInt") (ty [IType] IType) 1 (iUn complement)
58− (1, LCompl) partial,
58+ (1, LCompl ITNative) partial,
5959 Prim (UN "prim__eqInt") (ty [IType, IType] IType) 2 (biBin (==))
60− (2, LEq) total,
60+ (2, LEq ITNative) total,
6161 Prim (UN "prim__ltInt") (ty [IType, IType] IType) 2 (biBin (<))
62− (2, LLt) total,
62+ (2, LLt ITNative) total,
6363 Prim (UN "prim__lteInt") (ty [IType, IType] IType) 2 (biBin (<=))
64− (2, LLe) total,
64+ (2, LLe ITNative) total,
6565 Prim (UN "prim__gtInt") (ty [IType, IType] IType) 2 (biBin (>))
66− (2, LGt) total,
66+ (2, LGt ITNative) total,
6767 Prim (UN "prim__gteInt") (ty [IType, IType] IType) 2 (biBin (>=))
68− (2, LGe) total,
68+ (2, LGe ITNative) total,
6969 Prim (UN "prim__eqChar") (ty [ChType, ChType] IType) 2 (bcBin (==))
70− (2, LEq) total,
70+ (2, LEq ITNative) total,
7171 Prim (UN "prim__ltChar") (ty [ChType, ChType] IType) 2 (bcBin (<))
72− (2, LLt) total,
72+ (2, LLt ITNative) total,
7373 Prim (UN "prim__lteChar") (ty [ChType, ChType] IType) 2 (bcBin (<=))
74− (2, LLe) total,
74+ (2, LLe ITNative) total,
7575 Prim (UN "prim__gtChar") (ty [ChType, ChType] IType) 2 (bcBin (>))
76− (2, LGt) total,
76+ (2, LGt ITNative) total,
7777 Prim (UN "prim__gteChar") (ty [ChType, ChType] IType) 2 (bcBin (>=))
78− (2, LGe) total,
79−
80− Prim (UN "prim__ltB8") (ty [B8Type, B8Type] IType) 2 (b8Cmp (<))
81− (2, LB8Lt) total,
82− Prim (UN "prim__lteB8") (ty [B8Type, B8Type] IType) 2 (b8Cmp (<=))
83− (2, LB8Lte) total,
84− Prim (UN "prim__eqB8") (ty [B8Type, B8Type] IType) 2 (b8Cmp (==))
85− (2, LB8Eq) total,
86− Prim (UN "prim__gteB8") (ty [B8Type, B8Type] IType) 2 (b8Cmp (>))
87− (2, LB8Gte) total,
88− Prim (UN "prim__gtB8") (ty [B8Type, B8Type] IType) 2 (b8Cmp (>=))
89− (2, LB8Gt) total,
90− Prim (UN "prim__addB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (+))
91− (2, LB8Plus) total,
92− Prim (UN "prim__subB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (-))
93− (2, LB8Minus) total,
94− Prim (UN "prim__mulB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (*))
95− (2, LB8Times) total,
96− Prim (UN "prim__udivB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin div)
97− (2, LB8UDiv) partial,
98− Prim (UN "prim__sdivB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin s8div)
99− (2, LB8SDiv) partial,
100− Prim (UN "prim__uremB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin rem)
101− (2, LB8URem) partial,
102− Prim (UN "prim__sremB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin s8rem)
103− (2, LB8SRem) partial,
104− Prim (UN "prim__shlB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (\x y -> shiftL x (fromIntegral y)))
105− (2, LB8Shl) total,
106− Prim (UN "prim__lshrB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (\x y -> shiftR x (fromIntegral y)))
107− (2, LB8AShr) total,
108− Prim (UN "prim__ashrB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (\x y -> fromIntegral $
109− shiftR (fromIntegral x :: Int8)
110− (fromIntegral y)))
111− (2, LB8LShr) total,
112− Prim (UN "prim__andB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (.&.))
113− (2, LB8And) total,
114− Prim (UN "prim__orB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (.|.))
115− (2, LB8Or) total,
116− Prim (UN "prim__xorB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin xor)
117− (2, LB8Xor) total,
118− Prim (UN "prim__complB8") (ty [B8Type] B8Type) 1 (b8Un complement)
119− (1, LB8Compl) total,
120− Prim (UN "prim__zextB8_16") (ty [B8Type] B16Type) 1 zext8_16
121− (1, LB8Z16) total,
122− Prim (UN "prim__zextB8_32") (ty [B8Type] B32Type) 1 zext8_32
123− (1, LB8Z32) total,
124− Prim (UN "prim__zextB8_64") (ty [B8Type] B64Type) 1 zext8_64
125− (1, LB8Z64) total,
126− Prim (UN "prim__sextB8_16") (ty [B8Type] B16Type) 1 sext8_16
127− (1, LB8Z16) total,
128− Prim (UN "prim__sextB8_32") (ty [B8Type] B32Type) 1 sext8_32
129− (1, LB8Z32) total,
130− Prim (UN "prim__sextB8_64") (ty [B8Type] B64Type) 1 sext8_64
131− (1, LB8Z64) total,
132−
133− Prim (UN "prim__ltB16") (ty [B16Type, B16Type] IType) 2 (b16Cmp (<))
134− (2, LB16Lt) total,
135− Prim (UN "prim__lteB16") (ty [B16Type, B16Type] IType) 2 (b16Cmp (<=))
136− (2, LB16Lte) total,
137− Prim (UN "prim__eqB16") (ty [B16Type, B16Type] IType) 2 (b16Cmp (==))
138− (2, LB16Eq) total,
139− Prim (UN "prim__gteB16") (ty [B16Type, B16Type] IType) 2 (b16Cmp (>))
140− (2, LB16Gte) total,
141− Prim (UN "prim__gtB16") (ty [B16Type, B16Type] IType) 2 (b16Cmp (>=))
142− (2, LB16Gt) total,
143− Prim (UN "prim__addB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin (+))
144− (2, LB16Plus) total,
145− Prim (UN "prim__subB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin (-))
146− (2, LB16Minus) total,
147− Prim (UN "prim__mulB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin (*))
148− (2, LB16Times) total,
149− Prim (UN "prim__udivB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin div)
150− (2, LB16UDiv) partial,
151− Prim (UN "prim__sdivB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin s16div)
152− (2, LB16SDiv) partial,
153− Prim (UN "prim__uremB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin rem)
154− (2, LB16URem) partial,
155− Prim (UN "prim__sremB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin s16rem)
156− (2, LB16SRem) partial,
157− Prim (UN "prim__shlB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin (\x y -> shiftL x (fromIntegral y)))
158− (2, LB16Shl) total,
159− Prim (UN "prim__lshrB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin (\x y -> shiftR x (fromIntegral y)))
160− (2, LB16AShr) total,
161− Prim (UN "prim__ashrB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin (\x y -> fromIntegral $
162− shiftR (fromIntegral x :: Int16)
163− (fromIntegral y)))
164− (2, LB16LShr) total,
165− Prim (UN "prim__andB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin (.&.))
166− (2, LB16And) total,
167− Prim (UN "prim__orB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin (.|.))
168− (2, LB16Or) total,
169− Prim (UN "prim__xorB16") (ty [B16Type, B16Type] B16Type) 2 (b16Bin xor)
170− (2, LB16Xor) total,
171− Prim (UN "prim__complB16") (ty [B16Type] B16Type) 1 (b16Un complement)
172− (1, LB16Compl) total,
173− Prim (UN "prim__zextB16_32") (ty [B16Type] B32Type) 1 zext16_32
174− (1, LB16Z32) total,
175− Prim (UN "prim__zextB16_64") (ty [B16Type] B64Type) 1 zext16_64
176− (1, LB16Z64) total,
177− Prim (UN "prim__sextB16_32") (ty [B16Type] B32Type) 1 sext16_32
178− (1, LB16Z32) total,
179− Prim (UN "prim__sextB16_64") (ty [B16Type] B64Type) 1 sext16_64
180− (1, LB16Z64) total,
181− Prim (UN "prim__truncB16_8") (ty [B16Type] B8Type) 1 trunc16_8
182− (1, LB16T8) total,
183−
184− Prim (UN "prim__ltB32") (ty [B32Type, B32Type] IType) 2 (b32Cmp (<))
185− (2, LB32Lt) total,
186− Prim (UN "prim__lteB32") (ty [B32Type, B32Type] IType) 2 (b32Cmp (<=))
187− (2, LB32Lte) total,
188− Prim (UN "prim__eqB32") (ty [B32Type, B32Type] IType) 2 (b32Cmp (==))
189− (2, LB32Eq) total,
190− Prim (UN "prim__gteB32") (ty [B32Type, B32Type] IType) 2 (b32Cmp (>))
191− (2, LB32Gte) total,
192− Prim (UN "prim__gtB32") (ty [B32Type, B32Type] IType) 2 (b32Cmp (>=))
193− (2, LB32Gt) total,
194− Prim (UN "prim__addB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin (+))
195− (2, LB32Plus) total,
196− Prim (UN "prim__subB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin (-))
197− (2, LB32Minus) total,
198− Prim (UN "prim__mulB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin (*))
199− (2, LB32Times) total,
200− Prim (UN "prim__udivB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin div)
201− (2, LB32UDiv) partial,
202− Prim (UN "prim__sdivB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin s32div)
203− (2, LB32SDiv) partial,
204− Prim (UN "prim__uremB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin rem)
205− (2, LB32URem) partial,
206− Prim (UN "prim__sremB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin s32rem)
207− (2, LB32SRem) partial,
208− Prim (UN "prim__shlB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin (\x y -> shiftL x (fromIntegral y)))
209− (2, LB32Shl) total,
210− Prim (UN "prim__lshrB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin (\x y -> shiftR x (fromIntegral y)))
211− (2, LB32AShr) total,
212− Prim (UN "prim__ashrB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin (\x y -> fromIntegral $
213− shiftR (fromIntegral x :: Int32)
214− (fromIntegral y)))
215− (2, LB32LShr) total,
216− Prim (UN "prim__andB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin (.&.))
217− (2, LB32And) total,
218− Prim (UN "prim__orB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin (.|.))
219− (2, LB32Or) total,
220− Prim (UN "prim__xorB32") (ty [B32Type, B32Type] B32Type) 2 (b32Bin xor)
221− (2, LB32Xor) total,
222− Prim (UN "prim__complB32") (ty [B32Type] B32Type) 1 (b32Un complement)
223− (1, LB32Compl) total,
224− Prim (UN "prim__zextB32_64") (ty [B32Type] B64Type) 1 zext32_64
225− (1, LB32Z64) total,
226− Prim (UN "prim__sextB32_64") (ty [B32Type] B64Type) 1 sext32_64
227− (1, LB32Z64) total,
228− Prim (UN "prim__truncB32_8") (ty [B32Type] B8Type) 1 trunc32_8
229− (1, LB32T8) total,
230− Prim (UN "prim__truncB32_16") (ty [B32Type] B16Type) 1 trunc32_16
231− (1, LB32T16) total,
232−
233− Prim (UN "prim__ltB64") (ty [B64Type, B64Type] IType) 2 (b64Cmp (<))
234− (2, LB64Lt) total,
235− Prim (UN "prim__lteB64") (ty [B64Type, B64Type] IType) 2 (b64Cmp (<=))
236− (2, LB64Lte) total,
237− Prim (UN "prim__eqB64") (ty [B64Type, B64Type] IType) 2 (b64Cmp (==))
238− (2, LB64Eq) total,
239− Prim (UN "prim__gteB64") (ty [B64Type, B64Type] IType) 2 (b64Cmp (>))
240− (2, LB64Gte) total,
241− Prim (UN "prim__gtB64") (ty [B64Type, B64Type] IType) 2 (b64Cmp (>=))
242− (2, LB64Gt) total,
243− Prim (UN "prim__addB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin (+))
244− (2, LB64Plus) total,
245− Prim (UN "prim__subB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin (-))
246− (2, LB64Minus) total,
247− Prim (UN "prim__mulB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin (*))
248− (2, LB64Times) total,
249− Prim (UN "prim__udivB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin div)
250− (2, LB64UDiv) partial,
251− Prim (UN "prim__sdivB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin s64div)
252− (2, LB64SDiv) partial,
253− Prim (UN "prim__uremB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin rem)
254− (2, LB64URem) partial,
255− Prim (UN "prim__sremB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin s64rem)
256− (2, LB64SRem) partial,
257− Prim (UN "prim__shlB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin (\x y -> shiftL x (fromIntegral y)))
258− (2, LB64Shl) total,
259− Prim (UN "prim__lshrB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin (\x y -> shiftR x (fromIntegral y)))
260− (2, LB64AShr) total,
261− Prim (UN "prim__ashrB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin (\x y -> fromIntegral $
262− shiftR (fromIntegral x :: Int64)
263− (fromIntegral y)))
264− (2, LB64LShr) total,
265− Prim (UN "prim__andB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin (.&.))
266− (2, LB64And) total,
267− Prim (UN "prim__orB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin (.|.))
268− (2, LB64Or) total,
269− Prim (UN "prim__xorB64") (ty [B64Type, B64Type] B64Type) 2 (b64Bin xor)
270− (2, LB64Xor) total,
271− Prim (UN "prim__complB64") (ty [B64Type] B64Type) 1 (b64Un complement)
272− (1, LB64Compl) total,
273− Prim (UN "prim__truncB64_8") (ty [B64Type] B8Type) 1 trunc64_8
274− (1, LB64T8) total,
275− Prim (UN "prim__truncB64_16") (ty [B64Type] B16Type) 1 trunc64_16
276− (1, LB64T16) total,
277− Prim (UN "prim__truncB64_32") (ty [B64Type] B32Type) 1 trunc64_32
278− (1, LB64T32) total,
78+ (2, LGe ITNative) total,
79+
80+ iCoerce IT8 IT16 "zext" zext LZExt,
81+ iCoerce IT8 IT32 "zext" zext LZExt,
82+ iCoerce IT8 IT64 "zext" zext LZExt,
83+ iCoerce IT16 IT32 "zext" zext LZExt,
84+ iCoerce IT16 IT64 "zext" zext LZExt,
85+ iCoerce IT32 IT64 "zext" zext LZExt,
86+
87+ iCoerce IT8 IT16 "sext" sext LSExt,
88+ iCoerce IT8 IT32 "sext" sext LSExt,
89+ iCoerce IT8 IT64 "sext" sext LSExt,
90+ iCoerce IT16 IT32 "sext" sext LSExt,
91+ iCoerce IT16 IT64 "sext" sext LSExt,
92+ iCoerce IT32 IT64 "sext" sext LSExt,
93+
94+ iCoerce IT16 IT8 "trunc" trunc LTrunc,
95+ iCoerce IT32 IT8 "trunc" trunc LTrunc,
96+ iCoerce IT64 IT8 "trunc" trunc LTrunc,
97+ iCoerce IT32 IT16 "trunc" trunc LTrunc,
98+ iCoerce IT64 IT16 "trunc" trunc LTrunc,
99+ iCoerce IT64 IT32 "trunc" trunc LTrunc,
279100
280101 Prim (UN "prim__intToB8") (ty [IType] B8Type) 1 intToBits8
281102 (1, LIntB8) total,
@@ -402,7 +223,36 @@ primitives =
402223 (0, LStdIn) partial,
403224 Prim (UN "prim__believe_me") believeTy 3 (p_believeMe)
404225 (3, LNoOp) partial -- ahem
405− ]
226+ ] ++ concatMap intOps [IT8, IT16, IT32, IT64]
227+
228+intOps ity =
229+ [ iCmp ity "lt" (bCmp ity (<)) LLt total
230+ , iCmp ity "lte" (bCmp ity (<=)) LLe total
231+ , iCmp ity "eq" (bCmp ity (==)) LEq total
232+ , iCmp ity "gte" (bCmp ity (>=)) LGe total
233+ , iCmp ity "gt" (bCmp ity (>)) LGt total
234+ , iBinOp ity "add" (bitBin ity (+)) LPlus total
235+ , iBinOp ity "sub" (bitBin ity (-)) LMinus total
236+ , iBinOp ity "mul" (bitBin ity (*)) LTimes total
237+ , iBinOp ity "udiv" (bitBin ity div) LUDiv partial
238+ , iBinOp ity "sdiv" (bsdiv ity) LSDiv partial
239+ , iBinOp ity "urem" (bitBin ity rem) LURem partial
240+ , iBinOp ity "srem" (bsrem ity) LSRem partial
241+ , iBinOp ity "shl" (bitBin ity (\x y -> shiftL x (fromIntegral y))) LSHL total
242+ , iBinOp ity "lshr" (bitBin ity (\x y -> shiftR x (fromIntegral y))) LLSHR total
243+ , iBinOp ity "ashr" (bashr ity) LASHR total
244+ , iBinOp ity "and" (bitBin ity (.&.)) LAnd total
245+ , iBinOp ity "or" (bitBin ity (.|.)) LOr total
246+ , iBinOp ity "xor" (bitBin ity (xor)) LXOr total
247+ , iUnOp ity "compl" (bUn ity complement) LCompl total
248+ ]
249+
250+iCmp ity op impl irop totality = Prim (UN $ "prim__" ++ op ++ "B" ++ show (intTyWidth ity)) (ty (replicate 2 $ intTyToConst ity) IType) 2 impl (2, irop ity) totality
251+iBinOp ity op impl irop totality = Prim (UN $ "prim__" ++ op ++ "B" ++ show (intTyWidth ity)) (ty (replicate 2 $ intTyToConst ity) (intTyToConst ity)) 2 impl (2, irop ity) totality
252+iUnOp ity op impl irop totality = Prim (UN $ "prim__" ++ op ++ "B" ++ show (intTyWidth ity)) (ty [intTyToConst ity] (intTyToConst ity)) 1 impl (1, irop ity) totality
253+iCoerce from to op impl irop =
254+ Prim (UN $ "prim__" ++ op ++ "B" ++ show (intTyWidth from) ++ "_" ++ show (intTyWidth to))
255+ (ty [intTyToConst from] (intTyToConst to)) 1 (impl from to) (1, irop from to) total
406256
407257p_believeMe [_,_,x] = Just x
408258p_believeMe _ = Nothing
@@ -441,132 +291,96 @@ bsBin _ _ = Nothing
441291sBin op [VConstant (Str x), VConstant (Str y)] = Just $ VConstant (Str (op x y))
442292sBin _ _ = Nothing
443293
444−s8div :: Word8 -> Word8 -> Word8
445−s8div x y = fromIntegral (fromIntegral x `div` fromIntegral y :: Int8)
446−
447−s16div :: Word16 -> Word16 -> Word16
448−s16div x y = fromIntegral (fromIntegral x `div` fromIntegral y :: Int16)
449−
450−s32div :: Word32 -> Word32 -> Word32
451−s32div x y = fromIntegral (fromIntegral x `div` fromIntegral y :: Int32)
452−
453−s64div :: Word64 -> Word64 -> Word64
454−s64div x y = fromIntegral (fromIntegral x `div` fromIntegral y :: Int64)
455−
456−s8rem :: Word8 -> Word8 -> Word8
457−s8rem x y = fromIntegral (fromIntegral x `rem` fromIntegral y :: Int8)
458−
459−s16rem :: Word16 -> Word16 -> Word16
460−s16rem x y = fromIntegral (fromIntegral x `rem` fromIntegral y :: Int16)
461−
462−s32rem :: Word32 -> Word32 -> Word32
463−s32rem x y = fromIntegral (fromIntegral x `rem` fromIntegral y :: Int32)
464−
465−s64rem :: Word64 -> Word64 -> Word64
466−s64rem x y = fromIntegral (fromIntegral x `rem` fromIntegral y :: Int64)
467−
468−b8Bin op [VConstant (B8 x), VConstant (B8 y)] = Just $ VConstant (B8 (op x y))
469−b8Bin _ _ = Nothing
470−
471−b8Un op [VConstant (B8 x)] = Just $ VConstant (B8 (op x))
472−b8Un _ _ = Nothing
473−
474−b16Bin op [VConstant (B16 x), VConstant (B16 y)] = Just $ VConstant (B16 (op x y))
475−b16Bin _ _ = Nothing
476−
477−b16Un op [VConstant (B16 x)] = Just $ VConstant (B16 (op x))
478−b16Un _ _ = Nothing
479−
480−b32Bin op [VConstant (B32 x), VConstant (B32 y)] = Just $ VConstant (B32 (op x y))
481−b32Bin _ _ = Nothing
482−
483−b32Un op [VConstant (B32 x)] = Just $ VConstant (B32 (op x))
484−b32Un _ _ = Nothing
485−
486−b64Bin op [VConstant (B64 x), VConstant (B64 y)] = Just $ VConstant (B64 (op x y))
487−b64Bin _ _ = Nothing
488−
489−b64Un op [VConstant (B64 x)] = Just $ VConstant (B64 (op x))
490−b64Un _ _ = Nothing
491−
492−b8Cmp op [VConstant (B8 x), VConstant (B8 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
493−b8Cmp _ _ = Nothing
494−
495−b16Cmp op [VConstant (B16 x), VConstant (B16 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
496−b16Cmp _ _ = Nothing
497−
498−b32Cmp op [VConstant (B32 x), VConstant (B32 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
499−b32Cmp _ _ = Nothing
500−
501−b64Cmp op [VConstant (B64 x), VConstant (B64 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
502−b64Cmp _ _ = Nothing
503−
504−toB8 x = VConstant (B8 (fromIntegral x))
505−toB16 x = VConstant (B16 (fromIntegral x))
506−toB32 x = VConstant (B32 (fromIntegral x))
507−toB64 x = VConstant (B64 (fromIntegral x))
508−
509−zext8_16 [VConstant (B8 x)] = Just $ toB16 x
510−zext8_16 _ = Nothing
511−
512−zext8_32 [VConstant (B8 x)] = Just $ toB32 x
513−zext8_32 _ = Nothing
514−
515−zext8_64 [VConstant (B8 x)] = Just $ toB64 x
516−zext8_64 _ = Nothing
517−
518−sext8_16 [VConstant (B8 x)] = Just $ toB16 (fromIntegral x :: Int8)
519−sext8_16 _ = Nothing
520−
521−sext8_32 [VConstant (B8 x)] = Just $ toB32 (fromIntegral x :: Int8)
522−sext8_32 _ = Nothing
523−
524−sext8_64 [VConstant (B8 x)] = Just $ toB64 (fromIntegral x :: Int8)
525−sext8_64 _ = Nothing
526−
527−zext16_32 [VConstant (B16 x)] = Just $ toB32 x
528−zext16_32 _ = Nothing
529−
530−zext16_64 [VConstant (B16 x)] = Just $ toB64 x
531−zext16_64 _ = Nothing
532−
533−sext16_32 [VConstant (B16 x)] = Just $ toB32 (fromIntegral x :: Int16)
534−sext16_32 _ = Nothing
535−
536−sext16_64 [VConstant (B16 x)] = Just $ toB64 (fromIntegral x :: Int16)
537−sext16_64 _ = Nothing
538−
539−trunc16_8 [VConstant (B16 x)] = Just $ toB8 x
540−trunc16_8 _ = Nothing
541−
542−zext32_64 [VConstant (B32 x)] = Just $ toB64 x
543−zext32_64 _ = Nothing
544−
545−sext32_64 [VConstant (B32 x)] = Just $ toB64 (fromIntegral x :: Int32)
546−sext32_64 _ = Nothing
547−
548−trunc32_8 [VConstant (B32 x)] = Just $ toB8 x
549−trunc32_8 _ = Nothing
550−
551−trunc32_16 [VConstant (B32 x)] = Just $ toB16 x
552−trunc32_16 _ = Nothing
553−
554−trunc64_8 [VConstant (B64 x)] = Just $ toB8 x
555−trunc64_8 _ = Nothing
556−
557−trunc64_16 [VConstant (B64 x)] = Just $ toB16 x
558−trunc64_16 _ = Nothing
559−
560−trunc64_32 [VConstant (B64 x)] = Just $ toB32 x
561−trunc64_32 _ = Nothing
562−
563−intToBits8 [VConstant (I x)] = Just $ toB8 x
294+bsrem IT8 [VConstant (B8 x), VConstant (B8 y)]
295+ = Just $ VConstant (B8 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int8)))
296+bsrem IT16 [VConstant (B16 x), VConstant (B16 y)]
297+ = Just $ VConstant (B16 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int16)))
298+bsrem IT32 [VConstant (B32 x), VConstant (B32 y)]
299+ = Just $ VConstant (B32 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int32)))
300+bsrem IT64 [VConstant (B64 x), VConstant (B64 y)]
301+ = Just $ VConstant (B64 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int64)))
302+bsrem ITNative [VConstant (I x), VConstant (I y)] = Just $ VConstant (I (x `rem` y))
303+bsrem _ _ = Nothing
304+
305+bsdiv IT8 [VConstant (B8 x), VConstant (B8 y)]
306+ = Just $ VConstant (B8 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int8)))
307+bsdiv IT16 [VConstant (B16 x), VConstant (B16 y)]
308+ = Just $ VConstant (B16 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int16)))
309+bsdiv IT32 [VConstant (B32 x), VConstant (B32 y)]
310+ = Just $ VConstant (B32 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int32)))
311+bsdiv IT64 [VConstant (B64 x), VConstant (B64 y)]
312+ = Just $ VConstant (B64 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int64)))
313+bsdiv ITNative [VConstant (I x), VConstant (I y)] = Just $ VConstant (I (x `div` y))
314+bsdiv _ _ = Nothing
315+
316+bashr IT8 [VConstant (B8 x), VConstant (B8 y)]
317+ = Just $ VConstant (B8 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int8)))
318+bashr IT16 [VConstant (B16 x), VConstant (B16 y)]
319+ = Just $ VConstant (B16 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int16)))
320+bashr IT32 [VConstant (B32 x), VConstant (B32 y)]
321+ = Just $ VConstant (B32 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int32)))
322+bashr IT64 [VConstant (B64 x), VConstant (B64 y)]
323+ = Just $ VConstant (B64 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int64)))
324+bashr ITNative [VConstant (I x), VConstant (I y)] = Just $ VConstant (I (x `shiftR` y))
325+bashr _ _ = Nothing
326+
327+bUn :: IntTy -> (forall a. Bits a => a -> a) -> [Value] -> Maybe Value
328+bUn IT8 op [VConstant (B8 x)] = Just $ VConstant (B8 (op x))
329+bUn IT16 op [VConstant (B16 x)] = Just $ VConstant (B16 (op x))
330+bUn IT32 op [VConstant (B32 x)] = Just $ VConstant (B32 (op x))
331+bUn IT64 op [VConstant (B64 x)] = Just $ VConstant (B64 (op x))
332+bUn _ _ _ = Nothing
333+
334+bitBin :: IntTy -> (forall a. (Bits a, Integral a) => a -> a -> a) -> [Value] -> Maybe Value
335+bitBin IT8 op [VConstant (B8 x), VConstant (B8 y)] = Just $ VConstant (B8 (op x y))
336+bitBin IT16 op [VConstant (B16 x), VConstant (B16 y)] = Just $ VConstant (B16 (op x y))
337+bitBin IT32 op [VConstant (B32 x), VConstant (B32 y)] = Just $ VConstant (B32 (op x y))
338+bitBin IT64 op [VConstant (B64 x), VConstant (B64 y)] = Just $ VConstant (B64 (op x y))
339+bitBin _ _ _ = Nothing
340+
341+bCmp :: IntTy -> (forall a. Ord a => a -> a -> Bool) -> [Value] -> Maybe Value
342+bCmp IT8 op [VConstant (B8 x), VConstant (B8 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
343+bCmp IT16 op [VConstant (B16 x), VConstant (B16 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
344+bCmp IT32 op [VConstant (B32 x), VConstant (B32 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
345+bCmp IT64 op [VConstant (B64 x), VConstant (B64 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
346+bCmp _ _ _ = Nothing
347+
348+toB IT8 x = VConstant (B8 (fromIntegral x))
349+toB IT16 x = VConstant (B16 (fromIntegral x))
350+toB IT32 x = VConstant (B32 (fromIntegral x))
351+toB IT64 x = VConstant (B64 (fromIntegral x))
352+
353+zext IT8 IT16 [VConstant (B8 x)] = Just $ VConstant (B16 (fromIntegral x))
354+zext IT8 IT32 [VConstant (B8 x)] = Just $ VConstant (B32 (fromIntegral x))
355+zext IT8 IT64 [VConstant (B8 x)] = Just $ VConstant (B64 (fromIntegral x))
356+zext IT16 IT32 [VConstant (B16 x)] = Just $ VConstant (B32 (fromIntegral x))
357+zext IT16 IT64 [VConstant (B16 x)] = Just $ VConstant (B64 (fromIntegral x))
358+zext IT32 IT64 [VConstant (B32 x)] = Just $ VConstant (B64 (fromIntegral x))
359+zext _ _ _ = Nothing
360+
361+sext IT8 IT16 [VConstant (B8 x)] = Just $ VConstant (B16 (fromIntegral (fromIntegral x :: Int8)))
362+sext IT8 IT32 [VConstant (B8 x)] = Just $ VConstant (B32 (fromIntegral (fromIntegral x :: Int8)))
363+sext IT8 IT64 [VConstant (B8 x)] = Just $ VConstant (B64 (fromIntegral (fromIntegral x :: Int8)))
364+sext IT16 IT32 [VConstant (B16 x)] = Just $ VConstant (B32 (fromIntegral (fromIntegral x :: Int16)))
365+sext IT16 IT64 [VConstant (B16 x)] = Just $ VConstant (B64 (fromIntegral (fromIntegral x :: Int16)))
366+sext IT32 IT64 [VConstant (B32 x)] = Just $ VConstant (B64 (fromIntegral (fromIntegral x :: Int32)))
367+sext _ _ _ = Nothing
368+
369+trunc IT16 IT8 [VConstant (B16 x)] = Just $ VConstant (B8 (fromIntegral x))
370+trunc IT32 IT8 [VConstant (B32 x)] = Just $ VConstant (B8 (fromIntegral x))
371+trunc IT64 IT8 [VConstant (B64 x)] = Just $ VConstant (B8 (fromIntegral x))
372+trunc IT32 IT16 [VConstant (B32 x)] = Just $ VConstant (B16 (fromIntegral x))
373+trunc IT64 IT16 [VConstant (B64 x)] = Just $ VConstant (B16 (fromIntegral x))
374+trunc IT64 IT32 [VConstant (B64 x)] = Just $ VConstant (B32 (fromIntegral x))
375+trunc _ _ _ = Nothing
376+
377+intToBits8 [VConstant (I x)] = Just $ toB IT8 x
564378intToBits8 _ = Nothing
565−intToBits16 [VConstant (I x)] = Just $ toB16 x
379+intToBits16 [VConstant (I x)] = Just $ toB IT16 x
566380intToBits16 _ = Nothing
567−intToBits32 [VConstant (I x)] = Just $ toB32 x
381+intToBits32 [VConstant (I x)] = Just $ toB IT32 x
568382intToBits32 _ = Nothing
569−intToBits64 [VConstant (I x)] = Just $ toB64 x
383+intToBits64 [VConstant (I x)] = Just $ toB IT64 x
570384intToBits64 _ = Nothing
571385
572386bits32ToInt [VConstant (B32 x)] = Just $ VConstant (I (fromIntegral x))