05895a5 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Revert "Merge pull request #294 from bitlisp/unified-int-primitives"

05895a5Edwin Brady13 years ago

effects/Effect/Memory.idr+2−2

compare with master

unifiedsplit

@@ -48,7 +48,7 @@ do_malloc size with (fromInteger (cast size) == size)

48private

49do_memset : Ptr -> Nat -> Bits8 -> Nat -> IO ()

50do_memset ptr offset c size

51− = mkForeign (FFun "idris_memset" [FPtr, FInt, FChar, FInt] FUnit)

51+ = mkForeign (FFun "idris_memset" [FPtr, FInt, FAny Bits8, FInt] FUnit)

52 ptr (cast offset) c (cast size)

54private

@@ -73,7 +73,7 @@ private

73do_poke : Ptr -> Nat -> Vect Bits8 size -> IO ()

74do_poke _ _ [] = return ()

75do_poke ptr offset (b::bs)

76− = do mkForeign (FFun "idris_poke" [FPtr, FInt, FChar] FUnit) ptr (cast offset) b

76+ = do mkForeign (FFun "idris_poke" [FPtr, FInt, FAny Bits8] FUnit) ptr (cast offset) b

77 do_poke ptr (S offset) bs

79instance Handler RawMemory (IOExcept String) where

lib/IO.idr+3−19

@@ -21,28 +21,12 @@ io_return x = prim__IO x

21run__IO : IO () -> IO ()

22run__IO v = io_bind v (\v' => io_return v')

24−data IntTy = ITNative | IT8 | IT16 | IT32 | IT64

26−

27−FInt : FTy

28−FInt = FIntT ITNative

29−

30−FChar : FTy

31−FChar = FIntT IT8

32−

33−FShort : FTy

34−FShort = FIntT IT16

35−

36−FLong : FTy

37−FLong = FIntT IT64

39interpFTy : FTy -> Type

26interpFTy : FTy -> Type

40−interpFTy (FIntT ITNative) = Int

27+interpFTy FInt = Int

41−interpFTy (FIntT IT8) = Bits8

42−interpFTy (FIntT IT16) = Bits16

43−interpFTy (FIntT IT32) = Bits32

44−interpFTy (FIntT IT64) = Bits64

45interpFTy FFloat = Float

28interpFTy FFloat = Float

29+interpFTy FChar = Char

46interpFTy FString = String

30interpFTy FString = String

47interpFTy FPtr = Ptr

31interpFTy FPtr = Ptr

48interpFTy (FAny t) = t

32interpFTy (FAny t) = t

lib/Prelude.idr+3−3

@@ -251,11 +251,11 @@ getLine = return (prim__readString prim__stdin)

251

252partial

253putChar : Char -> IO ()

254−putChar c = mkForeign (FFun "putchar" [FInt] FUnit) (cast c)

254+putChar c = mkForeign (FFun "putchar" [FChar] FUnit) c

255

256partial

257getChar : IO Char

258−getChar = fmap cast $ mkForeign (FFun "getchar" [] FInt)

258+getChar = mkForeign (FFun "getchar" [] FChar)

259

260---- some basic file handling

261

@@ -323,7 +323,7 @@ ferror (FHandle h) = do err <- do_ferror h

323

324partial

325nullPtr : Ptr -> IO Bool

326−nullPtr p = do ok <- mkForeign (FFun "isNull" [FPtr] FInt) p

326+nullPtr p = do ok <- mkForeign (FFun "isNull" [FPtr] FInt) p

327 return (ok /= 0);

328

329partial

rts/idris_bitstring.c−28

@@ -60,34 +60,6 @@ VAL idris_castB32Int(VM *vm, VAL a) {

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

61}

63−VAL idris_b8const(VM *vm, uint8_t a) {

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

65− SETTY(cl, BITS8);

66− cl->info.bits8 = a;

67− return cl;

68−}

69−

70−VAL idris_b16const(VM *vm, uint16_t a) {

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

72− SETTY(cl, BITS16);

73− cl->info.bits16 = a;

74− return cl;

75−}

76−

77−VAL idris_b32const(VM *vm, uint32_t a) {

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

79− SETTY(cl, BITS32);

80− cl->info.bits32 = a;

81− return cl;

82−}

83−

84−VAL idris_b64const(VM *vm, uint64_t a) {

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

86− SETTY(cl, BITS64);

87− cl->info.bits64 = a;

88− return cl;

89−}

90−

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

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

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

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

93 SETTY(cl, BITS8);

65 SETTY(cl, BITS8);

rts/idris_bitstring.h−4

@@ -11,10 +11,6 @@ VAL idris_b16(VM *vm, VAL a);

11VAL idris_b32(VM *vm, VAL a);

12VAL idris_b64(VM *vm, VAL a);

13VAL idris_castB32Int(VM *vm, VAL a);

14−VAL idris_b8const(VM *vm, uint8_t a);

15−VAL idris_b16const(VM *vm, uint16_t a);

16−VAL idris_b32const(VM *vm, uint32_t a);

17−VAL idris_b64const(VM *vm, uint64_t a);

19VAL idris_b8Plus(VM *vm, VAL a, VAL b);

15VAL idris_b8Plus(VM *vm, VAL a, VAL b);

20VAL idris_b8Minus(VM *vm, VAL a, VAL b);

16VAL idris_b8Minus(VM *vm, VAL a, VAL b);

rts/idris_rts.h−1

@@ -125,7 +125,6 @@ typedef intptr_t i_int;

125#define ISINT(x) ((((i_int)x)&1) == 1)

126

127#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)))

129#define FLOATOP(op,x,y) MKFLOAT(vm, ((GETFLOAT(x)) op (GETFLOAT(y))))

128#define FLOATOP(op,x,y) MKFLOAT(vm, ((GETFLOAT(x)) op (GETFLOAT(y))))

130#define FLOATBOP(op,x,y) MKINT((i_int)(((GETFLOAT(x)) op (GETFLOAT(y)))))

129#define FLOATBOP(op,x,y) MKINT((i_int)(((GETFLOAT(x)) op (GETFLOAT(y)))))

131#define ADD(x,y) (void*)(((i_int)x)+(((i_int)y)-1))

130#define ADD(x,y) (void*)(((i_int)x)+(((i_int)y)-1))

src/Core/Execute.hs+14−34

@@ -3,9 +3,6 @@ module Core.Execute (execute) where

4import Idris.AbsSyntax

5import Idris.AbsSyntaxTree

6−import IRTS.Lang( IntTy(..)

7− , intTyToConst

8− , FType(..))

10import Core.TT

7import Core.TT

11import Core.Evaluate

8import Core.Evaluate

@@ -428,16 +425,18 @@ chooseAlt _ [] = Nothing

428

425

429

426

430

427

429+

431−idrisType :: FType -> ExecVal

430+idrisType :: FTy -> ExecVal

432idrisType FUnit = EP Ref unitTy EErased

431idrisType FUnit = EP Ref unitTy EErased

433idrisType ft = EConstant (idr ft)

432idrisType ft = EConstant (idr ft)

434− where idr (FInt ty) = intTyToConst ty

433+ where idr FInt = IType

435− idr FDouble = FlType

434+ idr FFloat = FlType

436 idr FChar = ChType

435 idr FChar = ChType

437 idr FString = StrType

436 idr FString = StrType

438 idr FPtr = PtrType

437 idr FPtr = PtrType

439

438

440−data Foreign = FFun String [FType] FType deriving Show

439+data Foreign = FFun String [FTy] FTy deriving Show

441

440

442

441

443call :: Foreign -> [ExecVal] -> Exec (Maybe ExecVal)

442call :: Foreign -> [ExecVal] -> Exec (Maybe ExecVal)

@@ -447,19 +446,11 @@ call (FFun name argTypes retType) args =

447 Nothing -> return Nothing

446 Nothing -> return Nothing

448 Just f -> do res <- call' f args retType

447 Just f -> do res <- call' f args retType

449 return . Just . ioWrap $ res

448 return . Just . ioWrap $ res

450− where call' :: ForeignFun -> [ExecVal] -> FType -> Exec ExecVal

449+ where call' :: ForeignFun -> [ExecVal] -> FTy -> Exec ExecVal

451− call' (Fun _ h) args (FInt ITNative) = do res <- execIO $ callFFI h retCInt (prepArgs args)

450+ call' (Fun _ h) args FInt = do res <- execIO $ callFFI h retCInt (prepArgs args)

452− return (EConstant (I (fromIntegral res)))

451+ return (EConstant (I (fromIntegral res)))

453− call' (Fun _ h) args (FInt IT8) = do res <- execIO $ callFFI h retCChar (prepArgs args)

454− return (EConstant (B8 (fromIntegral res)))

455− call' (Fun _ h) args (FInt IT16) = do res <- execIO $ callFFI h retCWchar (prepArgs args)

456− return (EConstant (B16 (fromIntegral res)))

457− call' (Fun _ h) args (FInt IT32) = do res <- execIO $ callFFI h retCInt (prepArgs args)

458− return (EConstant (B32 (fromIntegral res)))

459− call' (Fun _ h) args (FInt IT64) = do res <- execIO $ callFFI h retCLong (prepArgs args)

460− return (EConstant (B64 (fromIntegral res)))

461− call' (Fun _ h) args FDouble = do res <- execIO $ callFFI h retCDouble (prepArgs args)

452+ call' (Fun _ h) args FFloat = do res <- execIO $ callFFI h retCDouble (prepArgs args)

462− return (EConstant (Fl (realToFrac res)))

453+ return (EConstant (Fl (realToFrac res)))

463 call' (Fun _ h) args FChar = do res <- execIO $ callFFI h retCChar (prepArgs args)

454 call' (Fun _ h) args FChar = do res <- execIO $ callFFI h retCChar (prepArgs args)

464 return (EConstant (Ch (castCCharToChar res)))

455 return (EConstant (Ch (castCCharToChar res)))

465 call' (Fun _ h) args FString = do res <- execIO $ callFFI h retCString (prepArgs args)

456 call' (Fun _ h) args FString = do res <- execIO $ callFFI h retCString (prepArgs args)

@@ -476,10 +467,6 @@ call (FFun name argTypes retType) args =

476

467

477 prepArgs = map prepArg

468 prepArgs = map prepArg

478 prepArg (EConstant (I i)) = argCInt (fromIntegral i)

469 prepArg (EConstant (I i)) = argCInt (fromIntegral i)

479− prepArg (EConstant (B8 i)) = argCChar (fromIntegral i)

480− prepArg (EConstant (B16 i)) = argCWchar (fromIntegral i)

481− prepArg (EConstant (B32 i)) = argCInt (fromIntegral i)

482− prepArg (EConstant (B64 i)) = argCLong (fromIntegral i)

483 prepArg (EConstant (Fl f)) = argCDouble (realToFrac f)

470 prepArg (EConstant (Fl f)) = argCDouble (realToFrac f)

484 prepArg (EConstant (Ch c)) = argCChar (castCharToCChar c) -- FIXME - castCharToCChar only safe for first 256 chars

471 prepArg (EConstant (Ch c)) = argCChar (castCharToCChar c) -- FIXME - castCharToCChar only safe for first 256 chars

485 prepArg (EConstant (Str s)) = argString s

472 prepArg (EConstant (Str s)) = argString s

@@ -497,18 +484,11 @@ foreignFromTT t = case (unApplyV t) of

497 return $ FFun name argFTy retFTy

484 return $ FFun name argFTy retFTy

498 _ -> trace "failed to construct ffun" Nothing

485 _ -> trace "failed to construct ffun" Nothing

499

486

500−getFTy :: ExecVal -> Maybe FType

487+getFTy :: ExecVal -> Maybe FTy

501−getFTy (EApp (EP _ (UN "FInt") _) (EP _ (UN intTy) _)) =

502− case intTy of

503− "ITNative" -> Just $ FInt ITNative

504− "IT8" -> Just $ FInt IT8

505− "IT16" -> Just $ FInt IT16

506− "IT32" -> Just $ FInt IT32

507− "IT64" -> Just $ FInt IT64

508− _ -> Nothing

509getFTy (EP _ (UN t) _) =

488getFTy (EP _ (UN t) _) =

510 case t of

489 case t of

490+ "FInt" -> Just FInt

511− "FFloat" -> Just FDouble

491+ "FFloat" -> Just FFloat

512 "FChar" -> Just FChar

492 "FChar" -> Just FChar

513 "FString" -> Just FString

493 "FString" -> Just FString

514 "FPtr" -> Just FPtr

494 "FPtr" -> Just FPtr

src/IRTS/CodegenC.hs+152−63

@@ -10,7 +10,6 @@ import Paths_idris

10import Util.System

12import Data.Char

13−import Data.List (intercalate)

14import System.Process

13import System.Process

15import System.Exit

14import System.Exit

16import System.IO

15import System.IO

@@ -106,10 +105,10 @@ bcc i (ASSIGNCONST l c)

106 mkConst (Fl f) = "MKFLOAT(vm, " ++ show f ++ ")"

105 mkConst (Fl f) = "MKFLOAT(vm, " ++ show f ++ ")"

107 mkConst (Ch c) = "MKINT(" ++ show (fromEnum c) ++ ")"

106 mkConst (Ch c) = "MKINT(" ++ show (fromEnum c) ++ ")"

108 mkConst (Str s) = "MKSTR(vm, " ++ show s ++ ")"

107 mkConst (Str s) = "MKSTR(vm, " ++ show s ++ ")"

109− mkConst (B8 x) = "idris_b8const(vm, " ++ show x ++ ")"

108+ mkConst (B8 b) = "MKB8(vm, " ++ show b ++")"

110− mkConst (B16 x) = "idris_b16const(vm, " ++ show x ++ ")"

109+ mkConst (B16 b) = "MKB16(vm, " ++ show b ++ ")"

111− mkConst (B32 x) = "idris_b32const(vm, " ++ show x ++ ")"

110+ mkConst (B32 b) = "MKB32(vm, " ++ show b ++ ")"

112− mkConst (B64 x) = "idris_b64const(vm, " ++ show x ++ ")"

111+ mkConst (B64 b) = "MKB64(vm, " ++ show b ++ ")"

113 mkConst _ = "MKINT(42424242)"

112 mkConst _ = "MKINT(42424242)"

114bcc i (UPDATE l r) = indent i ++ creg l ++ " = " ++ creg r ++ ";\n"

113bcc i (UPDATE l r) = indent i ++ creg l ++ " = " ++ creg r ++ ";\n"

115bcc i (MKCON l tag args)

114bcc i (MKCON l tag args)

@@ -227,10 +226,7 @@ bcc i (NULL r) = indent i ++ creg r ++ " = NULL;\n" -- clear, so it'll be GCed

227bcc i (ERROR str) = indent i ++ "fprintf(stderr, " ++ show str ++ "); assert(0); exit(-1);"

226bcc i (ERROR str) = indent i ++ "fprintf(stderr, " ++ show str ++ "); assert(0); exit(-1);"

228-- bcc i _ = indent i ++ "// not done yet\n"

227-- bcc i _ = indent i ++ "// not done yet\n"

229

228

230−

231−

232−c_irts (FInt ITNative) l x = l ++ "MKINT((i_int)(" ++ x ++ "))"

229+c_irts FInt l x = l ++ "MKINT((i_int)(" ++ x ++ "))"

233−c_irts (FInt ty) l x = l ++ "idris_b" ++ show (intTyWidth ty) ++ "const(vm, " ++ x ++ ")"

234c_irts FChar l x = l ++ "MKINT((i_int)(" ++ x ++ "))"

230c_irts FChar l x = l ++ "MKINT((i_int)(" ++ x ++ "))"

235c_irts FString l x = l ++ "MKSTR(vm, " ++ x ++ ")"

231c_irts FString l x = l ++ "MKSTR(vm, " ++ x ++ ")"

236c_irts FUnit l x = x

232c_irts FUnit l x = x

@@ -238,8 +234,7 @@ c_irts FPtr l x = l ++ "MKPTR(vm, " ++ x ++ ")"

238c_irts FDouble l x = l ++ "MKFLOAT(vm, " ++ x ++ ")"

234c_irts FDouble l x = l ++ "MKFLOAT(vm, " ++ x ++ ")"

239c_irts FAny l x = l ++ x

235c_irts FAny l x = l ++ x

240

236

241−irts_c (FInt ITNative) x = "GETINT(" ++ x ++ ")"

237+irts_c FInt x = "GETINT(" ++ x ++ ")"

242−irts_c (FInt ty) x = "(" ++ x ++ "->info.bits" ++ show (intTyWidth ty) ++ ")"

243irts_c FChar x = "GETINT(" ++ x ++ ")"

238irts_c FChar x = "GETINT(" ++ x ++ ")"

244irts_c FString x = "GETSTR(" ++ x ++ ")"

239irts_c FString x = "GETSTR(" ++ x ++ ")"

245irts_c FUnit x = x

240irts_c FUnit x = x

@@ -247,30 +242,22 @@ irts_c FPtr x = "GETPTR(" ++ x ++ ")"

247irts_c FDouble x = "GETFLOAT(" ++ x ++ ")"

242irts_c FDouble x = "GETFLOAT(" ++ x ++ ")"

248irts_c FAny x = x

243irts_c FAny x = x

249

244

250−bitOp v op ty args = v ++ "idris_b" ++ show (intTyWidth ty) ++ op ++ "(vm, " ++ intercalate ", " (map creg args) ++ ")"

251−

252−bitCoerce v op input output arg

253− = v ++ "idris_b" ++ show (intTyWidth input) ++ op ++ show (intTyWidth output) ++ "(vm, " ++ creg arg ++ ")"

254−

255−doOp v (LPlus ITNative) [l, r] = v ++ "ADD(" ++ creg l ++ ", " ++ creg r ++ ")"

245+doOp v LPlus [l, r] = v ++ "ADD(" ++ creg l ++ ", " ++ creg r ++ ")"

256−doOp v (LMinus ITNative) [l, r] = v ++ "INTOP(-," ++ creg l ++ ", " ++ creg r ++ ")"

246+doOp v LMinus [l, r] = v ++ "INTOP(-," ++ creg l ++ ", " ++ creg r ++ ")"

257−doOp v (LTimes ITNative) [l, r] = v ++ "MULT(" ++ creg l ++ ", " ++ creg r ++ ")"

247+doOp v LTimes [l, r] = v ++ "MULT(" ++ creg l ++ ", " ++ creg r ++ ")"

258−doOp v (LUDiv ITNative) [l, r] = v ++ "UINTOP(/," ++ creg l ++ ", " ++ creg r ++ ")"

259−doOp v (LSDiv ITNative) [l, r] = v ++ "INTOP(/," ++ creg l ++ ", " ++ creg r ++ ")"

248+doOp v LDiv [l, r] = v ++ "INTOP(/," ++ creg l ++ ", " ++ creg r ++ ")"

260−doOp v (LURem ITNative) [l, r] = v ++ "UINTOP(%," ++ creg l ++ ", " ++ creg r ++ ")"

261−doOp v (LSRem ITNative) [l, r] = v ++ "INTOP(%," ++ creg l ++ ", " ++ creg r ++ ")"

249+doOp v LMod [l, r] = v ++ "INTOP(%," ++ creg l ++ ", " ++ creg r ++ ")"

262−doOp v (LAnd ITNative) [l, r] = v ++ "INTOP(&," ++ creg l ++ ", " ++ creg r ++ ")"

250+doOp v LAnd [l, r] = v ++ "INTOP(&," ++ creg l ++ ", " ++ creg r ++ ")"

263−doOp v (LOr ITNative) [l, r] = v ++ "INTOP(|," ++ creg l ++ ", " ++ creg r ++ ")"

251+doOp v LOr [l, r] = v ++ "INTOP(|," ++ creg l ++ ", " ++ creg r ++ ")"

264−doOp v (LXOr ITNative) [l, r] = v ++ "INTOP(^," ++ creg l ++ ", " ++ creg r ++ ")"

252+doOp v LXOr [l, r] = v ++ "INTOP(^," ++ creg l ++ ", " ++ creg r ++ ")"

265−doOp v (LSHL ITNative) [l, r] = v ++ "INTOP(<<," ++ creg l ++ ", " ++ creg r ++ ")"

253+doOp v LSHL [l, r] = v ++ "INTOP(<<," ++ creg l ++ ", " ++ creg r ++ ")"

266−doOp v (LLSHR ITNative) [l, r] = v ++ "UINTOP(>>," ++ creg l ++ ", " ++ creg r ++ ")"

267−doOp v (LASHR ITNative) [l, r] = v ++ "INTOP(>>," ++ creg l ++ ", " ++ creg r ++ ")"

254+doOp v LSHR [l, r] = v ++ "INTOP(>>," ++ creg l ++ ", " ++ creg r ++ ")"

268−doOp v (LCompl ITNative) [x] = v ++ "INTOP(~," ++ creg x ++ ")"

255+doOp v LCompl [x] = v ++ "INTOP(~," ++ creg x ++ ")"

269−doOp v (LEq ITNative) [l, r] = v ++ "INTOP(==," ++ creg l ++ ", " ++ creg r ++ ")"

256+doOp v LEq [l, r] = v ++ "INTOP(==," ++ creg l ++ ", " ++ creg r ++ ")"

270−doOp v (LLt ITNative) [l, r] = v ++ "INTOP(<," ++ creg l ++ ", " ++ creg r ++ ")"

257+doOp v LLt [l, r] = v ++ "INTOP(<," ++ creg l ++ ", " ++ creg r ++ ")"

271−doOp v (LLe ITNative) [l, r] = v ++ "INTOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"

258+doOp v LLe [l, r] = v ++ "INTOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"

272−doOp v (LGt ITNative) [l, r] = v ++ "INTOP(>," ++ creg l ++ ", " ++ creg r ++ ")"

259+doOp v LGt [l, r] = v ++ "INTOP(>," ++ creg l ++ ", " ++ creg r ++ ")"

273−doOp v (LGe ITNative) [l, r] = v ++ "INTOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"

260+doOp v LGe [l, r] = v ++ "INTOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"

274

261

275doOp v LFPlus [l, r] = v ++ "FLOATOP(+," ++ creg l ++ ", " ++ creg r ++ ")"

262doOp v LFPlus [l, r] = v ++ "FLOATOP(+," ++ creg l ++ ", " ++ creg r ++ ")"

276doOp v LFMinus [l, r] = v ++ "FLOATOP(-," ++ creg l ++ ", " ++ creg r ++ ")"

263doOp v LFMinus [l, r] = v ++ "FLOATOP(-," ++ creg l ++ ", " ++ creg r ++ ")"

@@ -321,34 +308,136 @@ doOp v LIntB64 [x] = v ++ "idris_b64(vm, " ++ creg x ++ ")"

321

308

322doOp v LB32Int [x] = v ++ "idris_castB32Int(vm, " ++ creg x ++ ")"

309doOp v LB32Int [x] = v ++ "idris_castB32Int(vm, " ++ creg x ++ ")"

323

310

324−doOp v (LLt ty) [x, y] = bitOp v "Lt" ty [x, y]

311+doOp v LB8Lt [x, y] = v ++ "idris_b8Lt(vm, " ++ creg x ++ "," ++ creg y ++ ")"

325−doOp v (LLe ty) [x, y] = bitOp v "Lte" ty [x, y]

312+doOp v LB8Lte [x, y] = v ++ "idris_b8Lte(vm, " ++ creg x ++ "," ++ creg y ++ ")"

326−doOp v (LEq ty) [x, y] = bitOp v "Eq" ty [x, y]

313+doOp v LB8Eq [x, y] = v ++ "idris_b8Eq(vm, " ++ creg x ++ "," ++ creg y ++ ")"

327−doOp v (LGe ty) [x, y] = bitOp v "Gte" ty [x, y]

314+doOp v LB8Gte [x, y] = v ++ "idris_b8Gte(vm, " ++ creg x ++ "," ++ creg y ++ ")"

328−doOp v (LGt ty) [x, y] = bitOp v "Gt" ty [x, y]

315+doOp v LB8Gt [x, y] = v ++ "idris_b8Gt(vm, " ++ creg x ++ "," ++ creg y ++ ")"

329−

316+

330−doOp v (LSHL ty) [x, y] = bitOp v "Shl" ty [x, y]

317+doOp v LB8Shl [x, y] = v ++ "idris_b8Shl(vm, " ++ creg x ++ "," ++ creg y ++ ")"

331−doOp v (LLSHR ty) [x, y] = bitOp v "Shr" ty [x, y]

318+doOp v LB8LShr [x, y] = v ++ "idris_b8Shr(vm, " ++ creg x ++ "," ++ creg y ++ ")"

332−doOp v (LASHR ty) [x, y] = bitOp v "AShr" ty [x, y]

319+doOp v LB8AShr [x, y] = v ++ "idris_b8AShr(vm, " ++ creg x ++ "," ++ creg y ++ ")"

333−doOp v (LAnd ty) [x, y] = bitOp v "And" ty [x, y]

320+doOp v LB8And [x, y] = v ++ "idris_b8And(vm, " ++ creg x ++ "," ++ creg y ++ ")"

334−doOp v (LOr ty) [x, y] = bitOp v "Or" ty [x, y]

321+doOp v LB8Or [x, y] = v ++ "idris_b8Or(vm, " ++ creg x ++ "," ++ creg y ++ ")"

335−doOp v (LXOr ty) [x, y] = bitOp v "Xor" ty [x, y]

322+doOp v LB8Xor [x, y] = v ++ "idris_b8Xor(vm, " ++ creg x ++ "," ++ creg y ++ ")"

336−doOp v (LCompl ty) [x] = bitOp v "Compl" ty [x]

323+doOp v LB8Compl [x] = v ++ "idris_b8Compl(vm, " ++ creg x ++ ")"

337−

324+

338−doOp v (LPlus ty) [x, y] = bitOp v "Plus" ty [x, y]

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

339−doOp v (LMinus ty) [x, y] = bitOp v "Minus" ty [x, y]

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

340−doOp v (LTimes ty) [x, y] = bitOp v "Times" ty [x, y]

327+doOp v LB8Times [x, y] = v ++ "idris_b8Times(vm, " ++ creg x ++ "," ++ creg y ++ ")"

341−doOp v (LUDiv ty) [x, y] = bitOp v "UDiv" ty [x, y]

328+doOp v LB8UDiv [x, y] = v ++ "idris_b8UDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"

342−doOp v (LSDiv ty) [x, y] = bitOp v "SDiv" ty [x, y]

329+doOp v LB8SDiv [x, y] = v ++ "idris_b8SDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"

343−doOp v (LURem ty) [x, y] = bitOp v "URem" ty [x, y]

330+doOp v LB8URem [x, y] = v ++ "idris_b8URem(vm, " ++ creg x ++ "," ++ creg y ++ ")"

344−doOp v (LSRem ty) [x, y] = bitOp v "SRem" ty [x, y]

331+doOp v LB8SRem [x, y] = v ++ "idris_b8SRem(vm, " ++ creg x ++ "," ++ creg y ++ ")"

345−

332+

346−doOp v (LSExt from to) [x]

333+doOp v LB8Z16 [x] = v ++ "idris_b8Z16(vm, " ++ creg x ++ ")"

347− | intTyWidth from < intTyWidth to = bitCoerce v "S" from to x

334+doOp v LB8Z32 [x] = v ++ "idris_b8Z32(vm, " ++ creg x ++ ")"

348−doOp v (LZExt from to) [x]

335+doOp v LB8Z64 [x] = v ++ "idris_b8Z64(vm, " ++ creg x ++ ")"

349− | intTyWidth from < intTyWidth to = bitCoerce v "Z" from to x

336+doOp v LB8S16 [x] = v ++ "idris_b8S16(vm, " ++ creg x ++ ")"

350−doOp v (LTrunc from to) [x]

337+doOp v LB8S32 [x] = v ++ "idris_b8S32(vm, " ++ creg x ++ ")"

351− | intTyWidth from > intTyWidth to = bitCoerce v "T" from to x

338+doOp v LB8S64 [x] = v ++ "idris_b8S64(vm, " ++ creg x ++ ")"

339+

340+doOp v LB16Lt [x, y] = v ++ "idris_b16Lt(vm, " ++ creg x ++ "," ++ creg y ++ ")"

341+doOp v LB16Lte [x, y] = v ++ "idris_b16Lte(vm, " ++ creg x ++ "," ++ creg y ++ ")"

342+doOp v LB16Eq [x, y] = v ++ "idris_b16Eq(vm, " ++ creg x ++ "," ++ creg y ++ ")"

343+doOp v LB16Gte [x, y] = v ++ "idris_b16Gte(vm, " ++ creg x ++ "," ++ creg y ++ ")"

344+doOp v LB16Gt [x, y] = v ++ "idris_b16Gt(vm, " ++ creg x ++ "," ++ creg y ++ ")"

345+

346+doOp v LB16Shl [x, y] = v ++ "idris_b16Shl(vm, " ++ creg x ++ "," ++ creg y ++ ")"

347+doOp v LB16LShr [x, y] = v ++ "idris_b16Shr(vm, " ++ creg x ++ "," ++ creg y ++ ")"

348+doOp v LB16AShr [x, y] = v ++ "idris_b16AShr(vm, " ++ creg x ++ "," ++ creg y ++ ")"

349+doOp v LB16And [x, y] = v ++ "idris_b16And(vm, " ++ creg x ++ "," ++ creg y ++ ")"

350+doOp v LB16Or [x, y] = v ++ "idris_b16Or(vm, " ++ creg x ++ "," ++ creg y ++ ")"

351+doOp v LB16Xor [x, y] = v ++ "idris_b16Xor(vm, " ++ creg x ++ "," ++ creg y ++ ")"

352+doOp v LB16Compl [x] = v ++ "idris_b16Compl(vm, " ++ creg x ++ ")"

353+

354+doOp v LB16Plus [x, y] =

355+ v ++ "idris_b16Plus(vm, " ++ creg x ++ "," ++ creg y ++ ")"

356+doOp v LB16Minus [x, y] =

357+ v ++ "idris_b16Minus(vm, " ++ creg x ++ "," ++ creg y ++ ")"

358+doOp v LB16Times [x, y] =

359+ v ++ "idris_b16Times(vm, " ++ creg x ++ "," ++ creg y ++ ")"

360+doOp v LB16UDiv [x, y] =

361+ v ++ "idris_b16UDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"

362+doOp v LB16SDiv [x, y] =

363+ v ++ "idris_b16SDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"

364+doOp v LB16URem [x, y] =

365+ v ++ "idris_b16URem(vm, " ++ creg x ++ "," ++ creg y ++ ")"

366+doOp v LB16SRem [x, y] =

367+ v ++ "idris_b16SRem(vm, " ++ creg x ++ "," ++ creg y ++ ")"

368+

369+doOp v LB16Z32 [x] = v ++ "idris_b16Z32(vm, " ++ creg x ++ ")"

370+doOp v LB16Z64 [x] = v ++ "idris_b16Z64(vm, " ++ creg x ++ ")"

371+doOp v LB16S32 [x] = v ++ "idris_b16S32(vm, " ++ creg x ++ ")"

372+doOp v LB16S64 [x] = v ++ "idris_b16S64(vm, " ++ creg x ++ ")"

373+doOp v LB16T8 [x] = v ++ "idris_b16T8(vm, " ++ creg x ++ ")"

374+

375+doOp v LB32Lt [x, y] = v ++ "idris_b32Lt(vm, " ++ creg x ++ "," ++ creg y ++ ")"

376+doOp v LB32Lte [x, y] = v ++ "idris_b32Lte(vm, " ++ creg x ++ "," ++ creg y ++ ")"

377+doOp v LB32Eq [x, y] = v ++ "idris_b32Eq(vm, " ++ creg x ++ "," ++ creg y ++ ")"

378+doOp v LB32Gte [x, y] = v ++ "idris_b32Gte(vm, " ++ creg x ++ "," ++ creg y ++ ")"

379+doOp v LB32Gt [x, y] = v ++ "idris_b32Gt(vm, " ++ creg x ++ "," ++ creg y ++ ")"

380+

381+doOp v LB32Shl [x, y] = v ++ "idris_b32Shl(vm, " ++ creg x ++ "," ++ creg y ++ ")"

382+doOp v LB32LShr [x, y] = v ++ "idris_b32Shr(vm, " ++ creg x ++ "," ++ creg y ++ ")"

383+doOp v LB32AShr [x, y] = v ++ "idris_b32AShr(vm, " ++ creg x ++ "," ++ creg y ++ ")"

384+doOp v LB32And [x, y] = v ++ "idris_b32And(vm, " ++ creg x ++ "," ++ creg y ++ ")"

385+doOp v LB32Or [x, y] = v ++ "idris_b32Or(vm, " ++ creg x ++ "," ++ creg y ++ ")"

386+doOp v LB32Xor [x, y] = v ++ "idris_b32Xor(vm, " ++ creg x ++ "," ++ creg y ++ ")"

387+doOp v LB32Compl [x] = v ++ "idris_b32Compl(vm, " ++ creg x ++ ")"

388+

389+doOp v LB32Plus [x, y] =

390+ v ++ "idris_b32Plus(vm, " ++ creg x ++ "," ++ creg y ++ ")"

391+doOp v LB32Minus [x, y] =

392+ v ++ "idris_b32Minus(vm, " ++ creg x ++ "," ++ creg y ++ ")"

393+doOp v LB32Times [x, y] =

394+ v ++ "idris_b32Times(vm, " ++ creg x ++ "," ++ creg y ++ ")"

395+doOp v LB32UDiv [x, y] =

396+ v ++ "idris_b32UDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"

397+doOp v LB32SDiv [x, y] =

398+ v ++ "idris_b32SDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"

399+doOp v LB32URem [x, y] =

400+ v ++ "idris_b32URem(vm, " ++ creg x ++ "," ++ creg y ++ ")"

401+doOp v LB32SRem [x, y] =

402+ v ++ "idris_b32SRem(vm, " ++ creg x ++ "," ++ creg y ++ ")"

403+

404+doOp v LB32Z64 [x] = v ++ "idris_b32Z64(vm, " ++ creg x ++ ")"

405+doOp v LB32S64 [x] = v ++ "idris_b32S64(vm, " ++ creg x ++ ")"

406+doOp v LB32T8 [x] = v ++ "idris_b32T8(vm, " ++ creg x ++ ")"

407+doOp v LB32T16 [x] = v ++ "idris_b32T16(vm, " ++ creg x ++ ")"

408+

409+doOp v LB64Lt [x, y] = v ++ "idris_b64Lt(vm, " ++ creg x ++ "," ++ creg y ++ ")"

410+doOp v LB64Lte [x, y] = v ++ "idris_b64Lte(vm, " ++ creg x ++ "," ++ creg y ++ ")"

411+doOp v LB64Eq [x, y] = v ++ "idris_b64Eq(vm, " ++ creg x ++ "," ++ creg y ++ ")"

412+doOp v LB64Gte [x, y] = v ++ "idris_b64Gte(vm, " ++ creg x ++ "," ++ creg y ++ ")"

413+doOp v LB64Gt [x, y] = v ++ "idris_b64Gt(vm, " ++ creg x ++ "," ++ creg y ++ ")"

414+

415+doOp v LB64Shl [x, y] = v ++ "idris_b64Shl(vm, " ++ creg x ++ "," ++ creg y ++ ")"

416+doOp v LB64LShr [x, y] = v ++ "idris_b64Shr(vm, " ++ creg x ++ "," ++ creg y ++ ")"

417+doOp v LB64AShr [x, y] = v ++ "idris_b64AShr(vm, " ++ creg x ++ "," ++ creg y ++ ")"

418+doOp v LB64And [x, y] = v ++ "idris_b64And(vm, " ++ creg x ++ "," ++ creg y ++ ")"

419+doOp v LB64Or [x, y] = v ++ "idris_b64Or(vm, " ++ creg x ++ "," ++ creg y ++ ")"

420+doOp v LB64Xor [x, y] = v ++ "idris_b64Xor(vm, " ++ creg x ++ "," ++ creg y ++ ")"

421+doOp v LB64Compl [x] = v ++ "idris_b64Compl(vm, " ++ creg x ++ ")"

422+

423+doOp v LB64Plus [x, y] =

424+ v ++ "idris_b64Plus(vm, " ++ creg x ++ "," ++ creg y ++ ")"

425+doOp v LB64Minus [x, y] =

426+ v ++ "idris_b64Minus(vm, " ++ creg x ++ "," ++ creg y ++ ")"

427+doOp v LB64Times [x, y] =

428+ v ++ "idris_b64Times(vm, " ++ creg x ++ "," ++ creg y ++ ")"

429+doOp v LB64UDiv [x, y] =

430+ v ++ "idris_b64UDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"

431+doOp v LB64SDiv [x, y] =

432+ v ++ "idris_b64SDiv(vm, " ++ creg x ++ "," ++ creg y ++ ")"

433+doOp v LB64URem [x, y] =

434+ v ++ "idris_b64URem(vm, " ++ creg x ++ "," ++ creg y ++ ")"

435+doOp v LB64SRem [x, y] =

436+ v ++ "idris_b64SRem(vm, " ++ creg x ++ "," ++ creg y ++ ")"

437+

438+doOp v LB64T8 [x] = v ++ "idris_b64T8(vm, " ++ creg x ++ ")"

439+doOp v LB64T16 [x] = v ++ "idris_b64T16(vm, " ++ creg x ++ ")"

440+doOp v LB64T32 [x] = v ++ "idris_b64T32(vm, " ++ creg x ++ ")"

352

441

353doOp v LFExp [x] = v ++ "MKFLOAT(exp(GETFLOAT(" ++ creg x ++ ")))"

442doOp v LFExp [x] = v ++ "MKFLOAT(exp(GETFLOAT(" ++ creg x ++ ")))"

354doOp v LFLog [x] = v ++ "MKFLOAT(log(GETFLOAT(" ++ creg x ++ ")))"

443doOp v LFLog [x] = v ++ "MKFLOAT(log(GETFLOAT(" ++ creg x ++ ")))"

src/IRTS/CodegenJava.hs+219−80

@@ -468,27 +468,7 @@ integerType :: ClassType

468integerType = ClassType [(Ident "Integer", [])]

469

470longType :: ClassType

471−longType = ClassType [(Ident "Long", [])]

471+longType = ClassType [(Ident "Integer", [])]

472−

473−intTyToIdent IT8 = Ident "Byte"

474−intTyToIdent IT16 = Ident "Short"

475−intTyToIdent IT32 = Ident "Int"

476−intTyToIdent IT64 = Ident "Long"

477−

478−intTyToClass :: IntTy -> ClassType

479−intTyToClass ty = ClassType [(intTyToIdent ty, [])]

480−

481−intTyToMethod :: IntTy -> String

482−intTyToMethod IT8 = "byteValue"

483−intTyToMethod IT16 = "shortValue"

484−intTyToMethod IT32 = "intValue"

485−intTyToMethod IT64 = "longValue"

486−

487−intTyToPrimTy :: IntTy -> PrimType

488−intTyToPrimTy IT8 = ByteT

489−intTyToPrimTy IT16 = ShortT

490−intTyToPrimTy IT32 = IntT

491−intTyToPrimTy IT64 = LongT

492

472

493bigIntegerType :: ClassType

473bigIntegerType :: ClassType

494bigIntegerType = ClassType [(Ident "BigInteger", [])]

474bigIntegerType = ClassType [(Ident "BigInteger", [])]

@@ -982,7 +962,7 @@ mkStringAtIndex var indexExp =

982 <$> mkVarAccess (Just stringType) var

962 <$> mkVarAccess (Just stringType) var

983

963

984mkForeignType :: FType -> Maybe ClassType

964mkForeignType :: FType -> Maybe ClassType

985−mkForeignType (FInt ty) = return (intTyToClass ty)

965+mkForeignType FInt = return integerType

986mkForeignType FChar = return integerType

966mkForeignType FChar = return integerType

987mkForeignType FString = return stringType

967mkForeignType FString = return stringType

988mkForeignType FPtr = return objectType

968mkForeignType FPtr = return objectType

@@ -991,14 +971,14 @@ mkForeignType FAny = return objectType

991mkForeignType FUnit = Nothing

971mkForeignType FUnit = Nothing

992

972

993mkForeignVarAccess :: FType -> LVar -> CodeGeneration Exp

973mkForeignVarAccess :: FType -> LVar -> CodeGeneration Exp

994−mkForeignVarAccess (FInt ty) var =

974+mkForeignVarAccess FInt var =

995− (\ var -> MethodInv $ PrimaryMethodCall var

975+ (\ var -> MethodInv $ PrimaryMethodCall (var)

996 []

976 []

997− (Ident (intTyToMethod ty))

977+ (Ident "intValue")

998 []

978 []

999 )

979 )

1000 <$> mkVarAccess (Just integerType) var

980 <$> mkVarAccess (Just integerType) var

1001−mkForeignVarAccess FChar var = Cast (PrimType CharT) <$> mkForeignVarAccess (FInt IT32) var

981+mkForeignVarAccess FChar var = Cast (PrimType CharT) <$> mkForeignVarAccess FInt var

1002mkForeignVarAccess FDouble var =

982mkForeignVarAccess FDouble var =

1003 (\ var -> MethodInv $ PrimaryMethodCall (var)

983 (\ var -> MethodInv $ PrimaryMethodCall (var)

1004 []

984 []

@@ -1009,12 +989,12 @@ mkForeignVarAccess FDouble var =

1009mkForeignVarAccess otherType var = mkVarAccess (mkForeignType otherType) var

989mkForeignVarAccess otherType var = mkVarAccess (mkForeignType otherType) var

1010

990

1011mkFromForeignType :: FType -> Exp -> Exp

991mkFromForeignType :: FType -> Exp -> Exp

1012−mkFromForeignType (FInt ty) from =

992+mkFromForeignType FInt from =

1013− MethodInv $ TypeMethodCall (J.Name [intTyToIdent ty])

993+ MethodInv $ TypeMethodCall (J.Name [Ident "Integer"])

1014 []

994 []

1015 (Ident "valueOf")

995 (Ident "valueOf")

1016 [from]

996 [from]

1017−mkFromForeignType FChar from = mkFromForeignType (FInt IT32) from

997+mkFromForeignType FChar from = mkFromForeignType FInt from

1018mkFromForeignType FDouble from =

998mkFromForeignType FDouble from =

1019 MethodInv $ TypeMethodCall (J.Name [Ident "Double"])

999 MethodInv $ TypeMethodCall (J.Name [Ident "Double"])

1020 []

1000 []

@@ -1271,22 +1251,24 @@ mkExp (SConst (PtrType)) = return $ mkClass objectType

1271mkExp (SConst (VoidType)) = return $ mkClass voidType

1251mkExp (SConst (VoidType)) = return $ mkClass voidType

1272mkExp (SConst (Forgot)) = return $ mkClass objectType

1252mkExp (SConst (Forgot)) = return $ mkClass objectType

1273mkExp (SForeign _ fType meth args) = mkForeignInvoke fType meth args

1253mkExp (SForeign _ fType meth args) = mkForeignInvoke fType meth args

1274−mkExp (SOp (LPlus ITNative) args) = mkExp (SOp (LPlus IT32) args)

1254+mkExp (SOp LPlus args) = mkBinOpExp integerType Add args

1275−mkExp (SOp (LMinus ITNative) args) = mkExp (SOp (LMinus IT32) args)

1255+mkExp (SOp LMinus args) = mkBinOpExp integerType Sub args

1276−mkExp (SOp (LTimes ITNative) args) = mkExp (SOp (LTimes IT32) args)

1256+mkExp (SOp LTimes args) = mkBinOpExp integerType Mult args

1277−mkExp (SOp (LSDiv ITNative) args) = mkExp (SOp (LSDiv IT32) args)

1257+mkExp (SOp LDiv args) = mkBinOpExp integerType Div args

1278−mkExp (SOp (LSRem ITNative) args) = mkExp (SOp (LSRem IT32) args)

1258+mkExp (SOp LMod args) = mkBinOpExp integerType Rem args

1279−mkExp (SOp (LAnd ITNative) args) = mkExp (SOp (LAnd IT32) args)

1259+mkExp (SOp LAnd args) = mkBinOpExp integerType And args

1280−mkExp (SOp (LOr ITNative) args) = mkExp (SOp (LOr IT32) args)

1260+mkExp (SOp LOr args) = mkBinOpExp integerType Or args

1281−mkExp (SOp (LXOr ITNative) args) = mkExp (SOp (LXOr IT32) args)

1261+mkExp (SOp LXOr args) = mkBinOpExp integerType Xor args

1282−mkExp (SOp (LCompl ITNative) args) = mkExp (SOp (LCompl IT32) args)

1262+mkExp (SOp LCompl [var]) =

1263+ PreBitCompl <$> mkVarAccess (Just $ integerType) var

1283−mkExp (SOp (LSHL ITNative) args) = mkExp (SOp (LSHL IT32) args)

1264+mkExp (SOp LSHL args) = mkBinOpExp integerType LShift args

1284−mkExp (SOp (LASHR ITNative) args) = mkExp (SOp (LASHR IT32) args)

1265+mkExp (SOp LSHR args) = mkBinOpExp integerType RShift args

1285−mkExp (SOp (LEq ITNative) args) = mkExp (SOp (LEq IT32) args)

1266+mkExp (SOp LEq args) =

1267+ mkMethodOpChain1 (mkBoolToNumber integerType) objectType "equals" args

1286−mkExp (SOp (LLt ITNative) args) = mkExp (SOp (LLt IT32) args)

1268+mkExp (SOp LLt args) = mkLogicalBinOpExp integerType LThan args

1287−mkExp (SOp (LLe ITNative) args) = mkExp (SOp (LLe IT32) args)

1269+mkExp (SOp LLe args) = mkLogicalBinOpExp integerType LThanE args

1288−mkExp (SOp (LGt ITNative) args) = mkExp (SOp (LGt IT32) args)

1270+mkExp (SOp LGt args) = mkLogicalBinOpExp integerType GThan args

1289−mkExp (SOp (LGe ITNative) args) = mkExp (SOp (LGe IT32) args)

1271+mkExp (SOp LGe args) = mkLogicalBinOpExp integerType GThanE args

1290mkExp (SOp LFPlus args) = mkBinOpExp doubleType Add args

1272mkExp (SOp LFPlus args) = mkBinOpExp doubleType Add args

1291mkExp (SOp LFMinus args) = mkBinOpExp doubleType Sub args

1273mkExp (SOp LFMinus args) = mkBinOpExp doubleType Sub args

1292mkExp (SOp LFTimes args) = mkBinOpExp doubleType Mult args

1274mkExp (SOp LFTimes args) = mkBinOpExp doubleType Mult args

@@ -1387,46 +1369,203 @@ mkExp (SOp LPrintNum [arg]) =

1387mkExp (SOp LPrintStr [arg]) =

1369mkExp (SOp LPrintStr [arg]) =

1388 mkSystemOutPrint <$> (mkVarAccess (Just stringType) arg)

1370 mkSystemOutPrint <$> (mkVarAccess (Just stringType) arg)

1389mkExp (SOp LReadStr [arg]) = mkExp (SForeign LANG_C FString "idris_readStr" [(FPtr, arg)])

1371mkExp (SOp LReadStr [arg]) = mkExp (SForeign LANG_C FString "idris_readStr" [(FPtr, arg)])

1390−mkExp (SOp (LLt ty) args) = mkLogicalBinOpExp (intTyToClass ty) LThan args

1372+mkExp (SOp LB8Lt args) = mkLogicalBinOpExp byteType LThan args

1391−mkExp (SOp (LLe ty) args) = mkLogicalBinOpExp (intTyToClass ty) LThanE args

1373+mkExp (SOp LB8Lte args) = mkLogicalBinOpExp byteType LThanE args

1392−mkExp (SOp (LEq ty) args) =

1374+mkExp (SOp LB8Eq args) =

1393− mkMethodOpChain1 (mkBoolToNumber (intTyToClass ty)) (intTyToClass ty) "equals" args

1375+ mkMethodOpChain1 (mkBoolToNumber byteType) byteType "equals" args

1394−mkExp (SOp (LGt ty) args) = mkLogicalBinOpExp (intTyToClass ty) GThan args

1376+mkExp (SOp LB8Gt args) = mkLogicalBinOpExp byteType GThan args

1395−mkExp (SOp (LGe ty) args) = mkLogicalBinOpExp (intTyToClass ty) GThanE args

1377+mkExp (SOp LB8Gte args) = mkLogicalBinOpExp byteType GThanE args

1396−mkExp (SOp (LPlus ty) args) = mkBinOpExp (intTyToClass ty) Add args

1378+mkExp (SOp LB8Plus args) = mkBinOpExp byteType Add args

1397−mkExp (SOp (LMinus ty) args) = mkBinOpExp (intTyToClass ty) Sub args

1379+mkExp (SOp LB8Minus args) = mkBinOpExp byteType Sub args

1398−mkExp (SOp (LTimes ty) args) = mkBinOpExp (intTyToClass ty) Mult args

1380+mkExp (SOp LB8Times args) = mkBinOpExp byteType Mult args

1399−mkExp (SOp (LUDiv ty) args) = mkBinOpExpConv (intTyToMethod ty) (intTyToPrimTy ty) (intTyToClass ty) Div args

1381+mkExp (SOp LB8UDiv args) = mkBinOpExpConv "shortValue" ShortT byteType Div args

1400−mkExp (SOp (LSDiv ty) args) = mkBinOpExp (intTyToClass ty) Div args

1382+mkExp (SOp LB8SDiv args) = mkBinOpExp byteType Div args

1401−mkExp (SOp (LURem ty) args) = mkBinOpExpConv (intTyToMethod ty) (intTyToPrimTy ty) (intTyToClass ty) Rem args

1383+mkExp (SOp LB8URem args) = mkBinOpExpConv "shortValue" ShortT byteType Rem args

1402−mkExp (SOp (LSRem ty) args) = mkBinOpExp (intTyToClass ty) Rem args

1384+mkExp (SOp LB8SRem args) = mkBinOpExp byteType Rem args

1403−mkExp (SOp (LSHL ty) args) = mkBinOpExp (intTyToClass ty) LShift args

1385+mkExp (SOp LB8Shl args) = mkBinOpExp byteType LShift args

1404−mkExp (SOp (LLSHR ty) args) = mkBinOpExp (intTyToClass ty) RRShift args

1386+mkExp (SOp LB8LShr args) = mkBinOpExp byteType RRShift args

1405−mkExp (SOp (LASHR ty) args) = mkBinOpExp (intTyToClass ty) RShift args

1387+mkExp (SOp LB8AShr args) = mkBinOpExp byteType RShift args

1406−mkExp (SOp (LAnd ty) args) = mkBinOpExp (intTyToClass ty) And args

1388+mkExp (SOp LB8And args) = mkBinOpExp byteType And args

1407−mkExp (SOp (LOr ty) args) = mkBinOpExp (intTyToClass ty) Or args

1389+mkExp (SOp LB8Or args) = mkBinOpExp byteType Or args

1408−mkExp (SOp (LXOr ty) args) = mkBinOpExp (intTyToClass ty) Xor args

1390+mkExp (SOp LB8Xor args) = mkBinOpExp byteType Xor args

1391+mkExp (SOp LB8Compl [var]) =

1409−mkExp (SOp (LCompl ty) [var]) = PreBitCompl <$> mkVarAccess (Just $ intTyToClass ty) var

1392+ PreBitCompl <$> mkVarAccess (Just $ byteType) var

1410−mkExp (SOp (LZExt from to) [var])

1393+mkExp (SOp LB8Z16 [var]) = mkZeroExt "shortValue" 8 byteType shortType var

1411− | intTyWidth from < intTyWidth to

1394+mkExp (SOp LB8Z32 [var]) = mkZeroExt "intValue" 8 byteType integerType var

1412− = mkZeroExt (intTyToMethod to) (intTyWidth from) (intTyToClass from) (intTyToClass to) var

1395+mkExp (SOp LB8Z64 [var]) = mkZeroExt "longValue" 8 byteType longType var

1413−mkExp (SOp (LSExt from to) [var])

1396+mkExp (SOp LB8S16 [var]) = mkSignedExt "shortValue" byteType shortType var

1414− | intTyWidth from < intTyWidth to

1397+mkExp (SOp LB8S32 [var]) = mkSignedExt "intValue" byteType integerType var

1415− = mkSignedExt (intTyToMethod to) (intTyToClass from) (intTyToClass to) var

1398+mkExp (SOp LB8S64 [var]) = mkSignedExt "longValue" byteType longType var

1416−mkExp (SOp (LTrunc from to) [var])

1399+mkExp (SOp LB16Lt args) = mkLogicalBinOpExp shortType LThan args

1417− | intTyWidth from > intTyWidth to

1400+mkExp (SOp LB16Lte args) = mkLogicalBinOpExp shortType LThanE args

1401+mkExp (SOp LB16Eq args) =

1402+ mkMethodOpChain1 (mkBoolToNumber shortType) shortType "equals" args

1403+mkExp (SOp LB16Gt args) = mkLogicalBinOpExp shortType GThan args

1404+mkExp (SOp LB16Gte args) = mkLogicalBinOpExp shortType GThanE args

1405+mkExp (SOp LB16Plus args) = mkBinOpExp shortType Add args

1406+mkExp (SOp LB16Minus args) = mkBinOpExp shortType Sub args

1407+mkExp (SOp LB16Times args) = mkBinOpExp shortType Mult args

1408+mkExp (SOp LB16UDiv args) = mkBinOpExpConv "intValue" IntT shortType Div args

1409+mkExp (SOp LB16SDiv args) = mkBinOpExp shortType Div args

1410+mkExp (SOp LB16URem args) = mkBinOpExpConv "intValue" IntT shortType Rem args

1411+mkExp (SOp LB16SRem args) = mkBinOpExp shortType Rem args

1412+mkExp (SOp LB16Shl args) = mkBinOpExp shortType LShift args

1413+mkExp (SOp LB16LShr args) = mkBinOpExp shortType RRShift args

1414+mkExp (SOp LB16AShr args) = mkBinOpExp shortType RShift args

1415+mkExp (SOp LB16And args) = mkBinOpExp shortType And args

1416+mkExp (SOp LB16Or args) = mkBinOpExp shortType Or args

1417+mkExp (SOp LB16Xor args) = mkBinOpExp shortType Xor args

1418+mkExp (SOp LB16Compl [var]) =

1419+ PreBitCompl <$> mkVarAccess (Just $ shortType) var

1420+mkExp (SOp LB16Z32 [var]) = mkZeroExt "intValue" 16 shortType integerType var

1421+mkExp (SOp LB16Z64 [var]) = mkZeroExt "longValue" 16 shortType longType var

1422+mkExp (SOp LB16S32 [var]) = mkSignedExt "intValue" shortType integerType var

1423+mkExp (SOp LB16S64 [var]) = mkSignedExt "longValue" shortType longType var

1424+mkExp (SOp LB16T8 [var]) =

1418− = (\ var -> MethodInv $

1425+ (\ var -> MethodInv $

1419− TypeMethodCall (J.Name [intTyToIdent to])

1426+ TypeMethodCall (J.Name [Ident "Byte"])

1420 []

1427 []

1421 (Ident "valueOf")

1428 (Ident "valueOf")

1422 [ MethodInv

1429 [ MethodInv

1423− $ PrimaryMethodCall var [] (Ident (intTyToMethod to)) [] ]

1430+ $ PrimaryMethodCall var [] (Ident "byteValue") [] ]

1431+ )

1432+ <$> mkVarAccess (Just $ shortType) var

1433+mkExp (SOp LB32Lt args) = mkLogicalBinOpExp integerType LThan args

1434+mkExp (SOp LB32Lte args) = mkLogicalBinOpExp integerType LThanE args

1435+mkExp (SOp LB32Eq args) =

1436+ mkMethodOpChain1 (mkBoolToNumber integerType) integerType "equals" args

1437+mkExp (SOp LB32Gt args) = mkLogicalBinOpExp integerType GThan args

1438+mkExp (SOp LB32Gte args) = mkLogicalBinOpExp integerType GThanE args

1439+mkExp (SOp LB32Plus args) = mkBinOpExp integerType Add args

1440+mkExp (SOp LB32Minus args) = mkBinOpExp integerType Sub args

1441+mkExp (SOp LB32Times args) = mkBinOpExp integerType Mult args

1442+mkExp (SOp LB32UDiv args) = mkBinOpExpConv "longValue" LongT integerType Div args

1443+mkExp (SOp LB32SDiv args) = mkBinOpExp integerType Div args

1444+mkExp (SOp LB32URem args) = mkBinOpExpConv "longValue" LongT integerType Rem args

1445+mkExp (SOp LB32SRem args) = mkBinOpExp integerType Rem args

1446+mkExp (SOp LB32Shl args) = mkBinOpExp integerType LShift args

1447+mkExp (SOp LB32LShr args) = mkBinOpExp integerType RRShift args

1448+mkExp (SOp LB32AShr args) = mkBinOpExp integerType RShift args

1449+mkExp (SOp LB32And args) = mkBinOpExp integerType And args

1450+mkExp (SOp LB32Or args) = mkBinOpExp integerType Or args

1451+mkExp (SOp LB32Xor args) = mkBinOpExp integerType Xor args

1452+mkExp (SOp LB32Compl [var]) =

1453+ PreBitCompl <$> mkVarAccess (Just $ integerType) var

1454+mkExp (SOp LB32Z64 [var]) = mkZeroExt "longValue" 32 integerType longType var

1455+mkExp (SOp LB32S64 [var]) = mkSignedExt "longValue" integerType longType var

1456+mkExp (SOp LB32T8 [var]) =

1457+ (\ var -> MethodInv

1458+ $ TypeMethodCall (J.Name [Ident "Byte"])

1459+ []

1460+ (Ident "valueOf")

1461+ [ MethodInv $ PrimaryMethodCall var [] (Ident "byteValue") [] ]

1462+ )

1463+ <$> mkVarAccess (Just $ integerType) var

1464+mkExp (SOp LB32T16 [var]) =

1465+ (\ var -> MethodInv

1466+ $ TypeMethodCall (J.Name [Ident "Short"])

1467+ []

1468+ (Ident "valueOf")

1469+ [ MethodInv $ PrimaryMethodCall var [] (Ident "shortValue") [] ]

1470+ )

1471+ <$> mkVarAccess (Just $ integerType) var

1472+mkExp (SOp LB64Lt args) = mkLogicalBinOpExp longType LThan args

1473+mkExp (SOp LB64Lte args) = mkLogicalBinOpExp longType LThanE args

1474+mkExp (SOp LB64Eq args) =

1475+ mkMethodOpChain1 (mkBoolToNumber longType) longType "equals" args

1476+mkExp (SOp LB64Gt args) = mkLogicalBinOpExp longType GThan args

1477+mkExp (SOp LB64Gte args) = mkLogicalBinOpExp longType GThanE args

1478+mkExp (SOp LB64Plus args) = mkBinOpExp longType Add args

1479+mkExp (SOp LB64Minus args) = mkBinOpExp longType Sub args

1480+mkExp (SOp LB64Times args) = mkBinOpExp longType Mult args

1481+mkExp (SOp LB64UDiv (arg:args)) = do

1482+ (arg:args) <- mapM (mkVarAccess (Just longType)) (arg:args)

1483+ return $ foldl' (\ exp arg ->

1484+ MethodInv $ PrimaryMethodCall

1485+ ( MethodInv $ PrimaryMethodCall

1486+ ( MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])

1487+ []

1488+ (Ident "valueOf")

1489+ [ exp ]

1490+ )

1491+ []

1492+ (Ident "divide")

1493+ [ MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])

1494+ []

1495+ (Ident "valueOf")

1496+ [ arg ]

1497+ ]

1498+ )

1499+ []

1500+ (Ident "longValue")

1501+ []

1502+ )

1503+ arg

1504+ args

1505+mkExp (SOp LB64SDiv args) = mkBinOpExp longType Div args

1506+mkExp (SOp LB64URem (arg:args)) = do

1507+ (arg:args) <- mapM (mkVarAccess (Just longType)) (arg:args)

1508+ return $ foldl' (\ exp arg ->

1509+ MethodInv $ PrimaryMethodCall

1510+ ( MethodInv $ PrimaryMethodCall

1511+ ( MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])

1512+ []

1513+ (Ident "valueOf")

1514+ [ exp ]

1515+ )

1516+ []

1517+ (Ident "remainder")

1518+ [ MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])

1519+ []

1520+ (Ident "valueOf")

1521+ [ arg ]

1522+ ]

1523+ )

1524+ []

1525+ (Ident "longValue")

1526+ []

1527+ )

1528+ arg

1529+ args

1530+mkExp (SOp LB64SRem args) = mkBinOpExp longType Rem args

1531+mkExp (SOp LB64Shl args) = mkBinOpExp longType LShift args

1532+mkExp (SOp LB64LShr args) = mkBinOpExp longType RRShift args

1533+mkExp (SOp LB64AShr args) = mkBinOpExp longType RShift args

1534+mkExp (SOp LB64And args) = mkBinOpExp longType And args

1535+mkExp (SOp LB64Or args) = mkBinOpExp longType Or args

1536+mkExp (SOp LB64Xor args) = mkBinOpExp longType Xor args

1537+mkExp (SOp LB64Compl [var]) =

1538+ PreBitCompl <$> mkVarAccess (Just $ longType) var

1539+mkExp (SOp LB64T8 [var]) =

1540+ (\ var -> MethodInv

1541+ $ TypeMethodCall (J.Name [Ident "Byte"])

1542+ []

1543+ (Ident "valueOf")

1544+ [ MethodInv

1545+ $ PrimaryMethodCall var [] (Ident "byteValue") []

1546+ ]

1547+ )

1548+ <$> mkVarAccess (Just $ longType) var

1549+mkExp (SOp LB64T16 [var]) =

1550+ (\ var -> MethodInv

1551+ $ TypeMethodCall (J.Name [Ident "Short"])

1552+ []

1553+ (Ident "valueOf")

1554+ [ MethodInv $ PrimaryMethodCall var [] (Ident "shortValue") [] ]

1555+ )

1556+ <$> mkVarAccess (Just $ longType) var

1557+mkExp (SOp LB64T32 [var]) =

1558+ (\ var -> MethodInv

1559+ $ TypeMethodCall (J.Name [Ident "Integer"])

1560+ []

1561+ (Ident "valueOf")

1562+ [ MethodInv $ PrimaryMethodCall var [] (Ident "intValue") [] ]

1424 )

1563 )

1425− <$> mkVarAccess (Just $ intTyToClass from) var

1564+ <$> mkVarAccess (Just $ longType) var

1426−mkExp (SOp LIntB8 [arg]) = mkExp (SOp (LTrunc IT32 IT8) [arg])

1565+mkExp (SOp LIntB8 [arg]) = mkExp (SOp LB32T8 [arg])

1427−mkExp (SOp LIntB16 [arg]) = mkExp (SOp (LTrunc IT32 IT16) [arg])

1566+mkExp (SOp LIntB16 [arg]) = mkExp (SOp LB32T16 [arg])

1428mkExp (SOp LIntB32 [arg]) = mkExp (SV arg)

1567mkExp (SOp LIntB32 [arg]) = mkExp (SV arg)

1429−mkExp (SOp LIntB64 [arg]) = mkExp (SOp (LSExt IT32 IT64) [arg])

1568+mkExp (SOp LIntB64 [arg]) = mkExp (SOp LB32S64 [arg])

1430mkExp (SOp LB32Int [arg]) = mkExp (SV arg)

1569mkExp (SOp LB32Int [arg]) = mkExp (SV arg)

1431mkExp (SOp LFExp [arg]) = mkMathFun "exp" arg

1570mkExp (SOp LFExp [arg]) = mkMathFun "exp" arg

1432mkExp (SOp LFLog [arg]) = mkMathFun "log" arg

1571mkExp (SOp LFLog [arg]) = mkMathFun "log" arg

src/IRTS/CodegenJavaScript.hs+16−16

@@ -203,37 +203,37 @@ translateExpression (SApp True name vars) =

203 ++ ";\n});"

204

205translateExpression (SOp op vars)

206− | (LPlus _) <- op

206+ | LPlus <- op

207 , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs

208− | (LMinus _) <- op

208+ | LMinus <- op

209 , (lhs:rhs:_) <- vars = translateBinaryOp "-" lhs rhs

210− | (LTimes _) <- op

210+ | LTimes <- op

211 , (lhs:rhs:_) <- vars = translateBinaryOp "*" lhs rhs

212− | (LSDiv _) <- op

212+ | LDiv <- op

213 , (lhs:rhs:_) <- vars = translateBinaryOp "/" lhs rhs

214− | (LSRem _) <- op

214+ | LMod <- op

215 , (lhs:rhs:_) <- vars = translateBinaryOp "%" lhs rhs

216− | (LEq _) <- op

216+ | LEq <- op

217 , (lhs:rhs:_) <- vars = translateBinaryOp "==" lhs rhs

218− | (LLt _) <- op

218+ | LLt <- op

219 , (lhs:rhs:_) <- vars = translateBinaryOp "<" lhs rhs

220− | (LLe _) <- op

220+ | LLe <- op

221 , (lhs:rhs:_) <- vars = translateBinaryOp "<=" lhs rhs

222− | (LGt _) <- op

222+ | LGt <- op

223 , (lhs:rhs:_) <- vars = translateBinaryOp ">" lhs rhs

224− | (LGe _) <- op

224+ | LGe <- op

225 , (lhs:rhs:_) <- vars = translateBinaryOp ">=" lhs rhs

226− | (LAnd _) <- op

226+ | LAnd <- op

227 , (lhs:rhs:_) <- vars = translateBinaryOp "&" lhs rhs

228− | (LOr _) <- op

228+ | LOr <- op

229 , (lhs:rhs:_) <- vars = translateBinaryOp "|" lhs rhs

230− | (LXOr _) <- op

230+ | LXOr <- op

231 , (lhs:rhs:_) <- vars = translateBinaryOp "^" lhs rhs

232− | (LSHL _) <- op

232+ | LSHL <- op

233 , (lhs:rhs:_) <- vars = translateBinaryOp "<<" rhs lhs

234− | (LASHR _) <- op

234+ | LSHR <- op

235 , (lhs:rhs:_) <- vars = translateBinaryOp ">>" rhs lhs

236− | (LCompl _) <- op

236+ | LCompl <- op

237 , (arg:_) <- vars = '~' : translateVariableName arg

238

239 | LBPlus <- op

src/IRTS/Compiler.hs+1−7

@@ -284,21 +284,15 @@ getFTypes tm = case unApply tm of

284 _ -> Nothing

285

286mkIty' (P _ (UN ty) _) = mkIty ty

287−mkIty' (App (P _ (UN "FIntT") _) (P _ (UN intTy) _)) = mkIntIty intTy

288mkIty' _ = FAny

287mkIty' _ = FAny

289

288

289+mkIty "FInt" = FInt

290mkIty "FFloat" = FDouble

291mkIty "FChar" = FChar

292mkIty "FString" = FString

293mkIty "FPtr" = FPtr

294mkIty "FUnit" = FUnit

295

296−mkIntIty "ITNative" = FInt ITNative

297−mkIntIty "IT8" = FInt IT8

298−mkIntIty "IT16" = FInt IT16

299−mkIntIty "IT32" = FInt IT32

300−mkIntIty "IT64" = FInt IT64

301−

302zname = NS (UN "O") ["Nat","Prelude"]

296zname = NS (UN "O") ["Nat","Prelude"]

303sname = NS (UN "S") ["Nat","Prelude"]

297sname = NS (UN "S") ["Nat","Prelude"]

304

298

src/IRTS/LParser.hs+10−10

@@ -92,16 +92,16 @@ pLDecl = do reserved "data"

93pLExp = buildExpressionParser optable pLExp'

95−optable = [[binary "*" (\x y -> LOp (LTimes ITNative) [x,y]) AssocLeft,

95+optable = [[binary "*" (\x y -> LOp LTimes [x,y]) AssocLeft,

96− binary "/" (\x y -> LOp (LSDiv ITNative) [x,y]) AssocLeft,

96+ binary "/" (\x y -> LOp LDiv [x,y]) AssocLeft,

97 binary "*." (\x y -> LOp LFTimes [x,y]) AssocLeft,

98 binary "/." (\x y -> LOp LFDiv [x,y]) AssocLeft,

99 binary "*:" (\x y -> LOp LBTimes [x,y]) AssocLeft,

100 binary "/:" (\x y -> LOp LBDiv [x,y]) AssocLeft

101 ],

102 [

103− binary "+" (\x y -> LOp (LPlus ITNative) [x,y]) AssocLeft,

103+ binary "+" (\x y -> LOp LPlus [x,y]) AssocLeft,

104− binary "-" (\x y -> LOp (LMinus ITNative) [x,y]) AssocLeft,

104+ binary "-" (\x y -> LOp LMinus [x,y]) AssocLeft,

105 binary "++" (\x y -> LOp LStrConcat [x,y]) AssocLeft,

106 binary "+." (\x y -> LOp LFPlus [x,y]) AssocLeft,

107 binary "-." (\x y -> LOp LFMinus [x,y]) AssocLeft,

@@ -109,15 +109,15 @@ optable = [[binary "*" (\x y -> LOp (LTimes ITNative) [x,y]) AssocLeft,

109 binary "-:" (\x y -> LOp LBMinus [x,y]) AssocLeft

110 ],

111 [

112− binary "==" (\x y -> LOp (LEq ITNative) [x, y]) AssocNone,

112+ binary "==" (\x y -> LOp LEq [x, y]) AssocNone,

113 binary "==." (\x y -> LOp LFEq [x, y]) AssocNone,

114− binary "<" (\x y -> LOp (LLt ITNative) [x, y]) AssocNone,

114+ binary "<" (\x y -> LOp LLt [x, y]) AssocNone,

115 binary "<." (\x y -> LOp LFLt [x, y]) AssocNone,

116− binary ">" (\x y -> LOp (LGt ITNative) [x, y]) AssocNone,

116+ binary ">" (\x y -> LOp LGt [x, y]) AssocNone,

117 binary ">." (\x y -> LOp LFGt [x, y]) AssocNone,

118− binary "<=" (\x y -> LOp (LLe ITNative) [x, y]) AssocNone,

118+ binary "<=" (\x y -> LOp LLe [x, y]) AssocNone,

119 binary "<=." (\x y -> LOp LFLe [x, y]) AssocNone,

120− binary ">=" (\x y -> LOp (LGe ITNative) [x, y]) AssocNone,

120+ binary ">=" (\x y -> LOp LGe [x, y]) AssocNone,

121 binary ">=." (\x y -> LOp LFGe [x, y]) AssocNone,

122

123 binary "==:" (\x y -> LOp LBEq [x, y]) AssocNone,

@@ -164,7 +164,7 @@ pLExp' = try (do lchar '%'; pCast)

164

165pLang = do reserved "C"; return LANG_C

166

167−pType = do reserved "Int"; return (FInt ITNative)

167+pType = do reserved "Int"; return FInt

168 <|> do reserved "Float"; return FDouble

169 <|> do reserved "String"; return FString

170 <|> do reserved "Unit"; return FUnit

src/IRTS/Lang.hs+20−24

@@ -28,29 +28,9 @@ data LExp = LV LVar

28-- Primitive operators. Backends are not *required* to implement all

29-- of these, but should report an error if they are unable

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

31+data PrimFn = LPlus | LMinus | LTimes | LDiv | LMod

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

33+ | LEq | LLt | LLe | LGt | LGe

53− | LSExt IntTy IntTy | LZExt IntTy IntTy | LTrunc IntTy IntTy

54 | LFPlus | LFMinus | LFTimes | LFDiv

34 | LFPlus | LFMinus | LFTimes | LFDiv

@@ -60,6 +40,22 @@ data PrimFn = LPlus IntTy | LMinus IntTy | LTimes IntTy

61 | LPrintNum | LPrintStr | LReadStr

41 | LPrintNum | LPrintStr | LReadStr

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

50+ | LB16Z32 | LB16Z64 | LB16S32 | LB16S64 | LB16T8 -- and Truncation

54+ | LB32Z64 | LB32S64 | LB32T8 | LB32T16

58+ | LB64T8 | LB64T16 | LB64T32

@@ -80,7 +76,7 @@ data PrimFn = LPlus IntTy | LMinus IntTy | LTimes IntTy

80data FLang = LANG_C

76data FLang = LANG_C

81 deriving (Show, Eq)

77 deriving (Show, Eq)

84 deriving (Show, Eq)

80 deriving (Show, Eq)

86data LAlt = LConCase Int Name [Name] LExp

82data LAlt = LConCase Int Name [Name] LExp

src/Idris/Primitives.hs+345−159

@@ -35,68 +35,247 @@ partial = Partial NotCovering

35primitives =

36 -- operators

37 [Prim (UN "prim__addInt") (ty [IType, IType] IType) 2 (iBin (+))

38− (2, LPlus ITNative) total,

38+ (2, LPlus) total,

39 Prim (UN "prim__subInt") (ty [IType, IType] IType) 2 (iBin (-))

40− (2, LMinus ITNative) total,

40+ (2, LMinus) total,

41 Prim (UN "prim__mulInt") (ty [IType, IType] IType) 2 (iBin (*))

42− (2, LTimes ITNative) total,

42+ (2, LTimes) total,

43 Prim (UN "prim__divInt") (ty [IType, IType] IType) 2 (iBin div)

44− (2, LSDiv ITNative) partial,

44+ (2, LDiv) partial,

45 Prim (UN "prim__modInt") (ty [IType, IType] IType) 2 (iBin mod)

46− (2, LSRem ITNative) partial,

46+ (2, LMod) partial,

47 Prim (UN "prim__andInt") (ty [IType, IType] IType) 2 (iBin (.&.))

48− (2, LAnd ITNative) partial,

48+ (2, LAnd) partial,

49 Prim (UN "prim__orInt") (ty [IType, IType] IType) 2 (iBin (.|.))

50− (2, LOr ITNative) partial,

50+ (2, LOr) partial,

51 Prim (UN "prim__xorInt") (ty [IType, IType] IType) 2 (iBin xor)

52− (2, LXOr ITNative) partial,

52+ (2, LXOr) partial,

53 Prim (UN "prim__shLInt") (ty [IType, IType] IType) 2 (iBin shiftL)

54− (2, LSHL ITNative) partial,

54+ (2, LSHL) partial,

55 Prim (UN "prim__shRInt") (ty [IType, IType] IType) 2 (iBin shiftR)

56− (2, LASHR ITNative) partial,

56+ (2, LSHR) partial,

57 Prim (UN "prim__complInt") (ty [IType] IType) 1 (iUn complement)

58− (1, LCompl ITNative) partial,

58+ (1, LCompl) partial,

59 Prim (UN "prim__eqInt") (ty [IType, IType] IType) 2 (biBin (==))

60− (2, LEq ITNative) total,

60+ (2, LEq) total,

61 Prim (UN "prim__ltInt") (ty [IType, IType] IType) 2 (biBin (<))

62− (2, LLt ITNative) total,

62+ (2, LLt) total,

63 Prim (UN "prim__lteInt") (ty [IType, IType] IType) 2 (biBin (<=))

64− (2, LLe ITNative) total,

64+ (2, LLe) total,

65 Prim (UN "prim__gtInt") (ty [IType, IType] IType) 2 (biBin (>))

66− (2, LGt ITNative) total,

66+ (2, LGt) total,

67 Prim (UN "prim__gteInt") (ty [IType, IType] IType) 2 (biBin (>=))

68− (2, LGe ITNative) total,

68+ (2, LGe) total,

69 Prim (UN "prim__eqChar") (ty [ChType, ChType] IType) 2 (bcBin (==))

70− (2, LEq ITNative) total,

70+ (2, LEq) total,

71 Prim (UN "prim__ltChar") (ty [ChType, ChType] IType) 2 (bcBin (<))

72− (2, LLt ITNative) total,

72+ (2, LLt) total,

73 Prim (UN "prim__lteChar") (ty [ChType, ChType] IType) 2 (bcBin (<=))

74− (2, LLe ITNative) total,

74+ (2, LLe) total,

75 Prim (UN "prim__gtChar") (ty [ChType, ChType] IType) 2 (bcBin (>))

76− (2, LGt ITNative) total,

76+ (2, LGt) total,

77 Prim (UN "prim__gteChar") (ty [ChType, ChType] IType) 2 (bcBin (>=))

78− (2, LGe ITNative) total,

78+ (2, LGe) total,

79−

79+

80− iCoerce IT8 IT16 "zext" zext LZExt,

80+ Prim (UN "prim__ltB8") (ty [B8Type, B8Type] IType) 2 (b8Cmp (<))

81− iCoerce IT8 IT32 "zext" zext LZExt,

81+ (2, LB8Lt) total,

82− iCoerce IT8 IT64 "zext" zext LZExt,

82+ Prim (UN "prim__lteB8") (ty [B8Type, B8Type] IType) 2 (b8Cmp (<=))

83− iCoerce IT16 IT32 "zext" zext LZExt,

83+ (2, LB8Lte) total,

84− iCoerce IT16 IT64 "zext" zext LZExt,

84+ Prim (UN "prim__eqB8") (ty [B8Type, B8Type] IType) 2 (b8Cmp (==))

85− iCoerce IT32 IT64 "zext" zext LZExt,

85+ (2, LB8Eq) total,

86−

86+ Prim (UN "prim__gteB8") (ty [B8Type, B8Type] IType) 2 (b8Cmp (>))

87− iCoerce IT8 IT16 "sext" sext LSExt,

87+ (2, LB8Gte) total,

88− iCoerce IT8 IT32 "sext" sext LSExt,

88+ Prim (UN "prim__gtB8") (ty [B8Type, B8Type] IType) 2 (b8Cmp (>=))

89− iCoerce IT8 IT64 "sext" sext LSExt,

89+ (2, LB8Gt) total,

90− iCoerce IT16 IT32 "sext" sext LSExt,

90+ Prim (UN "prim__addB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (+))

91− iCoerce IT16 IT64 "sext" sext LSExt,

91+ (2, LB8Plus) total,

92− iCoerce IT32 IT64 "sext" sext LSExt,

92+ Prim (UN "prim__subB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (-))

93−

93+ (2, LB8Minus) total,

94− iCoerce IT16 IT8 "trunc" trunc LTrunc,

94+ Prim (UN "prim__mulB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin (*))

95− iCoerce IT32 IT8 "trunc" trunc LTrunc,

95+ (2, LB8Times) total,

96− iCoerce IT64 IT8 "trunc" trunc LTrunc,

96+ Prim (UN "prim__udivB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin div)

97− iCoerce IT32 IT16 "trunc" trunc LTrunc,

97+ (2, LB8UDiv) partial,

98− iCoerce IT64 IT16 "trunc" trunc LTrunc,

98+ Prim (UN "prim__sdivB8") (ty [B8Type, B8Type] B8Type) 2 (b8Bin s8div)

99− iCoerce IT64 IT32 "trunc" trunc LTrunc,

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,

100

279

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

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

102 (1, LIntB8) total,

281 (1, LIntB8) total,

@@ -223,36 +402,7 @@ primitives =

223 (0, LStdIn) partial,

402 (0, LStdIn) partial,

224 Prim (UN "prim__believe_me") believeTy 3 (p_believeMe)

403 Prim (UN "prim__believe_me") believeTy 3 (p_believeMe)

225 (3, LNoOp) partial -- ahem

404 (3, LNoOp) partial -- ahem

226− ] ++ concatMap intOps [IT8, IT16, IT32, IT64]

405+ ]

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

256

406

257p_believeMe [_,_,x] = Just x

407p_believeMe [_,_,x] = Just x

258p_believeMe _ = Nothing

408p_believeMe _ = Nothing

@@ -291,96 +441,132 @@ bsBin _ _ = Nothing

291sBin op [VConstant (Str x), VConstant (Str y)] = Just $ VConstant (Str (op x y))

441sBin op [VConstant (Str x), VConstant (Str y)] = Just $ VConstant (Str (op x y))

292sBin _ _ = Nothing

442sBin _ _ = Nothing

293

443

294−bsrem IT8 [VConstant (B8 x), VConstant (B8 y)]

444+s8div :: Word8 -> Word8 -> Word8

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)))

445+s8div x y = fromIntegral (fromIntegral x `div` fromIntegral y :: Int8)

300−bsrem IT64 [VConstant (B64 x), VConstant (B64 y)]

446+

301− = Just $ VConstant (B64 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int64)))

447+s16div :: Word16 -> Word16 -> Word16

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)))

448+s16div x y = fromIntegral (fromIntegral x `div` fromIntegral y :: Int16)

309−bsdiv IT32 [VConstant (B32 x), VConstant (B32 y)]

449+

310− = Just $ VConstant (B32 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int32)))

450+s32div :: Word32 -> Word32 -> Word32

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)))

451+s32div x y = fromIntegral (fromIntegral x `div` fromIntegral y :: Int32)

318−bashr IT16 [VConstant (B16 x), VConstant (B16 y)]

452+

453+s64div :: Word64 -> Word64 -> Word64

319− = Just $ VConstant (B16 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int16)))

454+s64div x y = fromIntegral (fromIntegral x `div` fromIntegral y :: Int64)

320−bashr IT32 [VConstant (B32 x), VConstant (B32 y)]

455+

456+s8rem :: Word8 -> Word8 -> Word8

321− = Just $ VConstant (B32 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int32)))

457+s8rem x y = fromIntegral (fromIntegral x `rem` fromIntegral y :: Int8)

322−bashr IT64 [VConstant (B64 x), VConstant (B64 y)]

458+

459+s16rem :: Word16 -> Word16 -> Word16

323− = Just $ VConstant (B64 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int64)))

460+s16rem x y = fromIntegral (fromIntegral x `rem` fromIntegral y :: Int16)

324−bashr ITNative [VConstant (I x), VConstant (I y)] = Just $ VConstant (I (x `shiftR` y))

461+

325−bashr _ _ = Nothing

462+s32rem :: Word32 -> Word32 -> Word32

326−

463+s32rem x y = fromIntegral (fromIntegral x `rem` fromIntegral y :: Int32)

327−bUn :: IntTy -> (forall a. Bits a => a -> a) -> [Value] -> Maybe Value

464+

465+s64rem :: Word64 -> Word64 -> Word64

466+s64rem x y = fromIntegral (fromIntegral x `rem` fromIntegral y :: Int64)

467+

328−bUn IT8 op [VConstant (B8 x)] = Just $ VConstant (B8 (op x))

468+b8Bin op [VConstant (B8 x), VConstant (B8 y)] = Just $ VConstant (B8 (op x y))

329−bUn IT16 op [VConstant (B16 x)] = Just $ VConstant (B16 (op x))

469+b8Bin _ _ = Nothing

330−bUn IT32 op [VConstant (B32 x)] = Just $ VConstant (B32 (op x))

470+

331−bUn IT64 op [VConstant (B64 x)] = Just $ VConstant (B64 (op x))

471+b8Un op [VConstant (B8 x)] = Just $ VConstant (B8 (op x))

332−bUn _ _ _ = Nothing

472+b8Un _ _ = Nothing

333−

473+

334−bitBin :: IntTy -> (forall a. (Bits a, Integral a) => a -> a -> a) -> [Value] -> Maybe Value

474+b16Bin op [VConstant (B16 x), VConstant (B16 y)] = Just $ VConstant (B16 (op x y))

475+b16Bin _ _ = Nothing

476+

335−bitBin IT8 op [VConstant (B8 x), VConstant (B8 y)] = Just $ VConstant (B8 (op x y))

477+b16Un op [VConstant (B16 x)] = Just $ VConstant (B16 (op x))

478+b16Un _ _ = Nothing

479+

336−bitBin IT16 op [VConstant (B16 x), VConstant (B16 y)] = Just $ VConstant (B16 (op x y))

480+b32Bin op [VConstant (B32 x), VConstant (B32 y)] = Just $ VConstant (B32 (op x y))

481+b32Bin _ _ = Nothing

482+

337−bitBin IT32 op [VConstant (B32 x), VConstant (B32 y)] = Just $ VConstant (B32 (op x y))

483+b32Un op [VConstant (B32 x)] = Just $ VConstant (B32 (op x))

484+b32Un _ _ = Nothing

485+

338−bitBin IT64 op [VConstant (B64 x), VConstant (B64 y)] = Just $ VConstant (B64 (op x y))

486+b64Bin op [VConstant (B64 x), VConstant (B64 y)] = Just $ VConstant (B64 (op x y))

339−bitBin _ _ _ = Nothing

487+b64Bin _ _ = Nothing

340−

488+

341−bCmp :: IntTy -> (forall a. Ord a => a -> a -> Bool) -> [Value] -> Maybe Value

489+b64Un op [VConstant (B64 x)] = Just $ VConstant (B64 (op x))

490+b64Un _ _ = Nothing

491+

342−bCmp IT8 op [VConstant (B8 x), VConstant (B8 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))

492+b8Cmp op [VConstant (B8 x), VConstant (B8 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))

493+b8Cmp _ _ = Nothing

494+

343−bCmp IT16 op [VConstant (B16 x), VConstant (B16 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))

495+b16Cmp op [VConstant (B16 x), VConstant (B16 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))

496+b16Cmp _ _ = Nothing

497+

344−bCmp IT32 op [VConstant (B32 x), VConstant (B32 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))

498+b32Cmp op [VConstant (B32 x), VConstant (B32 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))

499+b32Cmp _ _ = Nothing

500+

345−bCmp IT64 op [VConstant (B64 x), VConstant (B64 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))

501+b64Cmp op [VConstant (B64 x), VConstant (B64 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))

346−bCmp _ _ _ = Nothing

502+b64Cmp _ _ = Nothing

347−

503+

348−toB IT8 x = VConstant (B8 (fromIntegral x))

504+toB8 x = VConstant (B8 (fromIntegral x))

349−toB IT16 x = VConstant (B16 (fromIntegral x))

505+toB16 x = VConstant (B16 (fromIntegral x))

350−toB IT32 x = VConstant (B32 (fromIntegral x))

506+toB32 x = VConstant (B32 (fromIntegral x))

351−toB IT64 x = VConstant (B64 (fromIntegral x))

507+toB64 x = VConstant (B64 (fromIntegral x))

352−

508+

353−zext IT8 IT16 [VConstant (B8 x)] = Just $ VConstant (B16 (fromIntegral x))

509+zext8_16 [VConstant (B8 x)] = Just $ toB16 x

354−zext IT8 IT32 [VConstant (B8 x)] = Just $ VConstant (B32 (fromIntegral x))

510+zext8_16 _ = Nothing

511+

355−zext IT8 IT64 [VConstant (B8 x)] = Just $ VConstant (B64 (fromIntegral x))

512+zext8_32 [VConstant (B8 x)] = Just $ toB32 x

356−zext IT16 IT32 [VConstant (B16 x)] = Just $ VConstant (B32 (fromIntegral x))

513+zext8_32 _ = Nothing

357−zext IT16 IT64 [VConstant (B16 x)] = Just $ VConstant (B64 (fromIntegral x))

514+

515+zext8_64 [VConstant (B8 x)] = Just $ toB64 x

516+zext8_64 _ = Nothing

517+

358−zext IT32 IT64 [VConstant (B32 x)] = Just $ VConstant (B64 (fromIntegral x))

518+sext8_16 [VConstant (B8 x)] = Just $ toB16 (fromIntegral x :: Int8)

359−zext _ _ _ = Nothing

519+sext8_16 _ = Nothing

360−

520+

361−sext IT8 IT16 [VConstant (B8 x)] = Just $ VConstant (B16 (fromIntegral (fromIntegral x :: Int8)))

521+sext8_32 [VConstant (B8 x)] = Just $ toB32 (fromIntegral x :: Int8)

522+sext8_32 _ = Nothing

523+

362−sext IT8 IT32 [VConstant (B8 x)] = Just $ VConstant (B32 (fromIntegral (fromIntegral x :: Int8)))

524+sext8_64 [VConstant (B8 x)] = Just $ toB64 (fromIntegral x :: Int8)

363−sext IT8 IT64 [VConstant (B8 x)] = Just $ VConstant (B64 (fromIntegral (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+

364−sext IT16 IT32 [VConstant (B16 x)] = Just $ VConstant (B32 (fromIntegral (fromIntegral x :: Int16)))

533+sext16_32 [VConstant (B16 x)] = Just $ toB32 (fromIntegral x :: Int16)

534+sext16_32 _ = Nothing

535+

365−sext IT16 IT64 [VConstant (B16 x)] = Just $ VConstant (B64 (fromIntegral (fromIntegral x :: Int16)))

536+sext16_64 [VConstant (B16 x)] = Just $ toB64 (fromIntegral x :: Int16)

366−sext IT32 IT64 [VConstant (B32 x)] = Just $ VConstant (B64 (fromIntegral (fromIntegral x :: Int32)))

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

367−sext _ _ _ = Nothing

543+zext32_64 _ = Nothing

368−

544+

369−trunc IT16 IT8 [VConstant (B16 x)] = Just $ VConstant (B8 (fromIntegral x))

545+sext32_64 [VConstant (B32 x)] = Just $ toB64 (fromIntegral x :: Int32)

546+sext32_64 _ = Nothing

547+

370−trunc IT32 IT8 [VConstant (B32 x)] = Just $ VConstant (B8 (fromIntegral x))

548+trunc32_8 [VConstant (B32 x)] = Just $ toB8 x

371−trunc IT64 IT8 [VConstant (B64 x)] = Just $ VConstant (B8 (fromIntegral x))

549+trunc32_8 _ = Nothing

372−trunc IT32 IT16 [VConstant (B32 x)] = Just $ VConstant (B16 (fromIntegral x))

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+

373−trunc IT64 IT16 [VConstant (B64 x)] = Just $ VConstant (B16 (fromIntegral x))

557+trunc64_16 [VConstant (B64 x)] = Just $ toB16 x

558+trunc64_16 _ = Nothing

559+

374−trunc IT64 IT32 [VConstant (B64 x)] = Just $ VConstant (B32 (fromIntegral x))

560+trunc64_32 [VConstant (B64 x)] = Just $ toB32 x

375−trunc _ _ _ = Nothing

561+trunc64_32 _ = Nothing

376−

562+

377−intToBits8 [VConstant (I x)] = Just $ toB IT8 x

563+intToBits8 [VConstant (I x)] = Just $ toB8 x

378intToBits8 _ = Nothing

564intToBits8 _ = Nothing

379−intToBits16 [VConstant (I x)] = Just $ toB IT16 x

565+intToBits16 [VConstant (I x)] = Just $ toB16 x

380intToBits16 _ = Nothing

566intToBits16 _ = Nothing

381−intToBits32 [VConstant (I x)] = Just $ toB IT32 x

567+intToBits32 [VConstant (I x)] = Just $ toB32 x

382intToBits32 _ = Nothing

568intToBits32 _ = Nothing

383−intToBits64 [VConstant (I x)] = Just $ toB IT64 x

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

384intToBits64 _ = Nothing

570intToBits64 _ = Nothing

385

571

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

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