@@ -1,4 +1,4 @@
1−{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
1+{-# LANGUAGE RankNTypes, ScopedTypeVariables, PatternGuards #-}
22
33module Idris.Primitives(elabPrims) where
44
@@ -34,280 +34,73 @@ partial = Partial NotCovering
3434
3535primitives =
3636 -- operators
37− [Prim (UN "prim__addInt") (ty [IType, IType] IType) 2 (iBin (+))
38− (2, LPlus) total,
39− Prim (UN "prim__subInt") (ty [IType, IType] IType) 2 (iBin (-))
40− (2, LMinus) total,
41− Prim (UN "prim__mulInt") (ty [IType, IType] IType) 2 (iBin (*))
42− (2, LTimes) total,
43− Prim (UN "prim__divInt") (ty [IType, IType] IType) 2 (iBin div)
44− (2, LDiv) partial,
45− Prim (UN "prim__modInt") (ty [IType, IType] IType) 2 (iBin mod)
46− (2, LMod) partial,
47− Prim (UN "prim__andInt") (ty [IType, IType] IType) 2 (iBin (.&.))
48− (2, LAnd) partial,
49− Prim (UN "prim__orInt") (ty [IType, IType] IType) 2 (iBin (.|.))
50− (2, LOr) partial,
51− Prim (UN "prim__xorInt") (ty [IType, IType] IType) 2 (iBin xor)
52− (2, LXOr) partial,
53− Prim (UN "prim__shLInt") (ty [IType, IType] IType) 2 (iBin shiftL)
54− (2, LSHL) partial,
55− Prim (UN "prim__shRInt") (ty [IType, IType] IType) 2 (iBin shiftR)
56− (2, LSHR) partial,
57− Prim (UN "prim__complInt") (ty [IType] IType) 1 (iUn complement)
58− (1, LCompl) partial,
59− Prim (UN "prim__eqInt") (ty [IType, IType] IType) 2 (biBin (==))
60− (2, LEq) total,
61− Prim (UN "prim__ltInt") (ty [IType, IType] IType) 2 (biBin (<))
62− (2, LLt) total,
63− Prim (UN "prim__lteInt") (ty [IType, IType] IType) 2 (biBin (<=))
64− (2, LLe) total,
65− Prim (UN "prim__gtInt") (ty [IType, IType] IType) 2 (biBin (>))
66− (2, LGt) total,
67− Prim (UN "prim__gteInt") (ty [IType, IType] IType) 2 (biBin (>=))
68− (2, LGe) total,
69− Prim (UN "prim__eqChar") (ty [ChType, ChType] IType) 2 (bcBin (==))
70− (2, LEq) total,
37+ [Prim (UN "prim__eqChar") (ty [ChType, ChType] IType) 2 (bcBin (==))
38+ (2, LEq ITNative) total,
7139 Prim (UN "prim__ltChar") (ty [ChType, ChType] IType) 2 (bcBin (<))
72− (2, LLt) total,
40+ (2, LLt ITNative) total,
7341 Prim (UN "prim__lteChar") (ty [ChType, ChType] IType) 2 (bcBin (<=))
74− (2, LLe) total,
42+ (2, LLe ITNative) total,
7543 Prim (UN "prim__gtChar") (ty [ChType, ChType] IType) 2 (bcBin (>))
76− (2, LGt) total,
44+ (2, LGt ITNative) total,
7745 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,
279−
280− Prim (UN "prim__intToB8") (ty [IType] B8Type) 1 intToBits8
281− (1, LIntB8) total,
282− Prim (UN "prim__intToB16") (ty [IType] B16Type) 1 intToBits16
283− (1, LIntB16) total,
284− Prim (UN "prim__intToB32") (ty [IType] B32Type) 1 intToBits32
285− (1, LIntB32) total,
286− Prim (UN "prim__intToB64") (ty [IType] B64Type) 1 intToBits64
287− (1, LIntB64) total,
288− Prim (UN "prim__B32ToInt") (ty [B32Type] IType) 1 bits32ToInt
289− (1, LB32Int) total,
290−
291− Prim (UN "prim__addBigInt") (ty [BIType, BIType] BIType) 2 (bBin (+))
292− (2, LBPlus) total,
293− Prim (UN "prim__subBigInt") (ty [BIType, BIType] BIType) 2 (bBin (-))
294− (2, LBMinus) total,
295− Prim (UN "prim__mulBigInt") (ty [BIType, BIType] BIType) 2 (bBin (*))
296− (2, LBTimes) total,
297− Prim (UN "prim__divBigInt") (ty [BIType, BIType] BIType) 2 (bBin div)
298− (2, LBDiv) partial,
299− Prim (UN "prim__modBigInt") (ty [BIType, BIType] BIType) 2 (bBin mod)
300− (2, LBMod) partial,
301− Prim (UN "prim__eqBigInt") (ty [BIType, BIType] IType) 2 (bbBin (==))
302− (2, LBEq) total,
303− Prim (UN "prim__ltBigInt") (ty [BIType, BIType] IType) 2 (bbBin (<))
304− (2, LBLt) total,
305− Prim (UN "prim__lteBigInt") (ty [BIType, BIType] IType) 2 (bbBin (<=))
306− (2, LBLe) total,
307− Prim (UN "prim__gtBigInt") (ty [BIType, BIType] IType) 2 (bbBin (>))
308− (2, LBGt) total,
309− Prim (UN "prim__gtBigInt") (ty [BIType, BIType] IType) 2 (bbBin (>=))
310− (2, LBGe) total,
46+ (2, LGe ITNative) total,
47+
48+ iCoerce IT8 IT16 "zext" zext LZExt,
49+ iCoerce IT8 IT32 "zext" zext LZExt,
50+ iCoerce IT8 IT64 "zext" zext LZExt,
51+ iCoerce IT8 ITBig "zext" zext LZExt,
52+ iCoerce IT8 ITNative "zext" zext LZExt,
53+ iCoerce IT16 IT32 "zext" zext LZExt,
54+ iCoerce IT16 IT64 "zext" zext LZExt,
55+ iCoerce IT16 ITBig "zext" zext LZExt,
56+ iCoerce IT16 ITNative "zext" zext LZExt,
57+ iCoerce IT32 IT64 "zext" zext LZExt,
58+ iCoerce IT32 ITBig "zext" zext LZExt,
59+ iCoerce IT32 ITNative "zext" zext LZExt,
60+ iCoerce IT64 ITBig "zext" zext LZExt,
61+ iCoerce ITNative ITBig "zext" zext LZExt,
62+ iCoerce ITNative IT64 "zext" zext LZExt,
63+ iCoerce ITNative IT32 "zext" zext LZExt,
64+ iCoerce ITNative IT16 "zext" zext LZExt,
65+
66+ iCoerce IT8 IT16 "sext" sext LSExt,
67+ iCoerce IT8 IT32 "sext" sext LSExt,
68+ iCoerce IT8 IT64 "sext" sext LSExt,
69+ iCoerce IT8 ITBig "sext" sext LSExt,
70+ iCoerce IT8 ITNative "sext" sext LSExt,
71+ iCoerce IT16 IT32 "sext" sext LSExt,
72+ iCoerce IT16 IT64 "sext" sext LSExt,
73+ iCoerce IT16 ITBig "sext" sext LSExt,
74+ iCoerce IT16 ITNative "sext" sext LSExt,
75+ iCoerce IT32 IT64 "sext" sext LSExt,
76+ iCoerce IT32 ITBig "sext" sext LSExt,
77+ iCoerce IT32 ITNative "sext" sext LSExt,
78+ iCoerce IT64 ITBig "sext" sext LSExt,
79+ iCoerce ITNative ITBig "sext" sext LSExt,
80+ iCoerce ITNative ITBig "sext" sext LSExt,
81+ iCoerce ITNative IT64 "sext" sext LSExt,
82+ iCoerce ITNative IT32 "sext" sext LSExt,
83+ iCoerce ITNative IT16 "sext" sext LSExt,
84+
85+ iCoerce IT16 IT8 "trunc" trunc LTrunc,
86+ iCoerce IT32 IT8 "trunc" trunc LTrunc,
87+ iCoerce IT64 IT8 "trunc" trunc LTrunc,
88+ iCoerce ITBig IT8 "trunc" trunc LTrunc,
89+ iCoerce ITNative IT8 "trunc" trunc LTrunc,
90+ iCoerce IT32 IT16 "trunc" trunc LTrunc,
91+ iCoerce IT64 IT16 "trunc" trunc LTrunc,
92+ iCoerce ITBig IT16 "trunc" trunc LTrunc,
93+ iCoerce ITNative IT16 "trunc" trunc LTrunc,
94+ iCoerce IT64 IT32 "trunc" trunc LTrunc,
95+ iCoerce ITBig IT32 "trunc" trunc LTrunc,
96+ iCoerce ITNative IT32 "trunc" trunc LTrunc,
97+ iCoerce ITBig IT64 "trunc" trunc LTrunc,
98+ iCoerce IT16 ITNative "trunc" trunc LTrunc,
99+ iCoerce IT32 ITNative "trunc" trunc LTrunc,
100+ iCoerce IT64 ITNative "trunc" trunc LTrunc,
101+ iCoerce ITBig ITNative "trunc" trunc LTrunc,
102+ iCoerce ITNative IT64 "trunc" trunc LTrunc,
103+
311104 Prim (UN "prim__addFloat") (ty [FlType, FlType] FlType) 2 (fBin (+))
312105 (2, LFPlus) total,
313106 Prim (UN "prim__subFloat") (ty [FlType, FlType] FlType) 2 (fBin (-))
@@ -335,30 +128,14 @@ primitives =
335128 Prim (UN "prim_lenString") (ty [StrType] IType) 1 (p_strLen)
336129 (1, LStrLen) total,
337130 -- Conversions
338− Prim (UN "prim__strToInt") (ty [StrType] IType) 1 (c_strToInt)
339− (1, LStrInt) total,
340− Prim (UN "prim__intToStr") (ty [IType] StrType) 1 (c_intToStr)
341− (1, LIntStr) total,
342131 Prim (UN "prim__charToInt") (ty [ChType] IType) 1 (c_charToInt)
343− (1, LChInt) total,
132+ (1, LChInt ITNative) total,
344133 Prim (UN "prim__intToChar") (ty [IType] ChType) 1 (c_intToChar)
345− (1, LIntCh) total,
346− Prim (UN "prim__intToBigInt") (ty [IType] BIType) 1 (c_intToBigInt)
347− (1, LIntBig) total,
348− Prim (UN "prim__bigIntToInt") (ty [BIType] IType) 1 (c_bigIntToInt)
349− (1, LBigInt) total,
350− Prim (UN "prim__strToBigInt") (ty [StrType] BIType) 1 (c_strToBigInt)
351− (1, LStrBig) total,
352− Prim (UN "prim__bigIntToStr") (ty [BIType] StrType) 1 (c_bigIntToStr)
353− (1, LBigStr) total,
134+ (1, LIntCh ITNative) total,
354135 Prim (UN "prim__strToFloat") (ty [StrType] FlType) 1 (c_strToFloat)
355136 (1, LStrFloat) total,
356137 Prim (UN "prim__floatToStr") (ty [FlType] StrType) 1 (c_floatToStr)
357138 (1, LFloatStr) total,
358− Prim (UN "prim__intToFloat") (ty [IType] FlType) 1 (c_intToFloat)
359− (1, LIntFloat) total,
360− Prim (UN "prim__floatToInt") (ty [FlType] IType) 1 (c_floatToInt)
361− (1, LFloatInt) total,
362139
363140 Prim (UN "prim__floatExp") (ty [FlType] FlType) 1 (p_floatExp)
364141 (1, LFExp) total,
@@ -402,7 +179,49 @@ primitives =
402179 (0, LStdIn) partial,
403180 Prim (UN "prim__believe_me") believeTy 3 (p_believeMe)
404181 (3, LNoOp) partial -- ahem
405− ]
182+ ] ++ concatMap intOps [IT8, IT16, IT32, IT64, ITBig, ITNative]
183+
184+intOps ity =
185+ [ iCmp ity "lt" (bCmp ity (<)) LLt total
186+ , iCmp ity "lte" (bCmp ity (<=)) LLe total
187+ , iCmp ity "eq" (bCmp ity (==)) LEq total
188+ , iCmp ity "gte" (bCmp ity (>=)) LGe total
189+ , iCmp ity "gt" (bCmp ity (>)) LGt total
190+ , iBinOp ity "add" (bitBin ity (+)) LPlus total
191+ , iBinOp ity "sub" (bitBin ity (-)) LMinus total
192+ , iBinOp ity "mul" (bitBin ity (*)) LTimes total
193+ , iBinOp ity "udiv" (bitBin ity div) LUDiv partial
194+ , iBinOp ity "sdiv" (bsdiv ity) LSDiv partial
195+ , iBinOp ity "urem" (bitBin ity rem) LURem partial
196+ , iBinOp ity "srem" (bsrem ity) LSRem partial
197+ , iBinOp ity "shl" (bitBin ity (\x y -> shiftL x (fromIntegral y))) LSHL total
198+ , iBinOp ity "lshr" (bitBin ity (\x y -> shiftR x (fromIntegral y))) LLSHR total
199+ , iBinOp ity "ashr" (bashr ity) LASHR total
200+ , iBinOp ity "and" (bitBin ity (.&.)) LAnd total
201+ , iBinOp ity "or" (bitBin ity (.|.)) LOr total
202+ , iBinOp ity "xor" (bitBin ity (xor)) LXOr total
203+ , iUnOp ity "compl" (bUn ity complement) LCompl total
204+ , Prim (UN $ "prim__toStr" ++ intTyName ity) (ty [intTyToConst ity] StrType) 1 intToStr
205+ (1, LIntStr ity) total
206+ , Prim (UN $ "prim__fromStr" ++ intTyName ity) (ty [StrType] (intTyToConst ity)) 1 (strToInt ity)
207+ (1, LStrInt ity) total
208+ , Prim (UN $ "prim__toFloat" ++ intTyName ity) (ty [intTyToConst ity] FlType) 1 intToFloat
209+ (1, LIntFloat ity) total
210+ , Prim (UN $ "prim__fromFloat" ++ intTyName ity) (ty [FlType] (intTyToConst ity)) 1 (floatToInt ity)
211+ (1, LFloatInt ity) total
212+ ]
213+
214+intTyName :: IntTy -> String
215+intTyName ITNative = "Int"
216+intTyName ITBig = "BigInt"
217+intTyName sized = "B" ++ show (intTyWidth sized)
218+
219+iCmp ity op impl irop totality = Prim (UN $ "prim__" ++ op ++ intTyName ity) (ty (replicate 2 $ intTyToConst ity) IType) 2 impl (2, irop ity) totality
220+iBinOp ity op impl irop totality = Prim (UN $ "prim__" ++ op ++ intTyName ity) (ty (replicate 2 $ intTyToConst ity) (intTyToConst ity)) 2 impl (2, irop ity) totality
221+iUnOp ity op impl irop totality = Prim (UN $ "prim__" ++ op ++ intTyName ity) (ty [intTyToConst ity] (intTyToConst ity)) 1 impl (1, irop ity) totality
222+iCoerce from to op impl irop =
223+ Prim (UN $ "prim__" ++ op ++ intTyName from ++ "_" ++ intTyName to)
224+ (ty [intTyToConst from] (intTyToConst to)) 1 (impl from to) (1, irop from to) total
406225
407226p_believeMe [_,_,x] = Just x
408227p_believeMe _ = Nothing
@@ -441,161 +260,127 @@ bsBin _ _ = Nothing
441260sBin op [VConstant (Str x), VConstant (Str y)] = Just $ VConstant (Str (op x y))
442261sBin _ _ = Nothing
443262
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
564−intToBits8 _ = Nothing
565−intToBits16 [VConstant (I x)] = Just $ toB16 x
566−intToBits16 _ = Nothing
567−intToBits32 [VConstant (I x)] = Just $ toB32 x
568−intToBits32 _ = Nothing
569−intToBits64 [VConstant (I x)] = Just $ toB64 x
570−intToBits64 _ = Nothing
571−
572−bits32ToInt [VConstant (B32 x)] = Just $ VConstant (I (fromIntegral x))
573−bits32ToInt _ = Nothing
574−
575−c_intToStr [VConstant (I x)] = Just $ VConstant (Str (show x))
576−c_intToStr _ = Nothing
577−c_strToInt [VConstant (Str x)] = case reads x of
578− [(n,"")] -> Just $ VConstant (I n)
579− _ -> Just $ VConstant (I 0)
580−c_strToInt _ = Nothing
263+bsrem IT8 [VConstant (B8 x), VConstant (B8 y)]
264+ = Just $ VConstant (B8 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int8)))
265+bsrem IT16 [VConstant (B16 x), VConstant (B16 y)]
266+ = Just $ VConstant (B16 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int16)))
267+bsrem IT32 [VConstant (B32 x), VConstant (B32 y)]
268+ = Just $ VConstant (B32 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int32)))
269+bsrem IT64 [VConstant (B64 x), VConstant (B64 y)]
270+ = Just $ VConstant (B64 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int64)))
271+bsrem ITNative [VConstant (I x), VConstant (I y)] = Just $ VConstant (I (x `rem` y))
272+bsrem _ _ = Nothing
273+
274+bsdiv IT8 [VConstant (B8 x), VConstant (B8 y)]
275+ = Just $ VConstant (B8 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int8)))
276+bsdiv IT16 [VConstant (B16 x), VConstant (B16 y)]
277+ = Just $ VConstant (B16 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int16)))
278+bsdiv IT32 [VConstant (B32 x), VConstant (B32 y)]
279+ = Just $ VConstant (B32 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int32)))
280+bsdiv IT64 [VConstant (B64 x), VConstant (B64 y)]
281+ = Just $ VConstant (B64 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int64)))
282+bsdiv ITNative [VConstant (I x), VConstant (I y)] = Just $ VConstant (I (x `div` y))
283+bsdiv _ _ = Nothing
284+
285+bashr IT8 [VConstant (B8 x), VConstant (B8 y)]
286+ = Just $ VConstant (B8 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int8)))
287+bashr IT16 [VConstant (B16 x), VConstant (B16 y)]
288+ = Just $ VConstant (B16 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int16)))
289+bashr IT32 [VConstant (B32 x), VConstant (B32 y)]
290+ = Just $ VConstant (B32 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int32)))
291+bashr IT64 [VConstant (B64 x), VConstant (B64 y)]
292+ = Just $ VConstant (B64 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int64)))
293+bashr ITNative [VConstant (I x), VConstant (I y)] = Just $ VConstant (I (x `shiftR` y))
294+bashr _ _ = Nothing
295+
296+bUn :: IntTy -> (forall a. Bits a => a -> a) -> [Value] -> Maybe Value
297+bUn IT8 op [VConstant (B8 x)] = Just $ VConstant (B8 (op x))
298+bUn IT16 op [VConstant (B16 x)] = Just $ VConstant (B16 (op x))
299+bUn IT32 op [VConstant (B32 x)] = Just $ VConstant (B32 (op x))
300+bUn IT64 op [VConstant (B64 x)] = Just $ VConstant (B64 (op x))
301+bUn ITBig op [VConstant (BI x)] = Just $ VConstant (BI (op x))
302+bUn ITNative op [VConstant (I x)] = Just $ VConstant (I (op x))
303+bUn _ _ _ = Nothing
304+
305+bitBin :: IntTy -> (forall a. (Bits a, Integral a) => a -> a -> a) -> [Value] -> Maybe Value
306+bitBin IT8 op [VConstant (B8 x), VConstant (B8 y)] = Just $ VConstant (B8 (op x y))
307+bitBin IT16 op [VConstant (B16 x), VConstant (B16 y)] = Just $ VConstant (B16 (op x y))
308+bitBin IT32 op [VConstant (B32 x), VConstant (B32 y)] = Just $ VConstant (B32 (op x y))
309+bitBin IT64 op [VConstant (B64 x), VConstant (B64 y)] = Just $ VConstant (B64 (op x y))
310+bitBin ITBig op [VConstant (BI x), VConstant (BI y)] = Just $ VConstant (BI (op x y))
311+bitBin ITNative op [VConstant (I x), VConstant (I y)] = Just $ VConstant (I (op x y))
312+bitBin _ _ _ = Nothing
313+
314+bCmp :: IntTy -> (forall a. Ord a => a -> a -> Bool) -> [Value] -> Maybe Value
315+bCmp IT8 op [VConstant (B8 x), VConstant (B8 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
316+bCmp IT16 op [VConstant (B16 x), VConstant (B16 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
317+bCmp IT32 op [VConstant (B32 x), VConstant (B32 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
318+bCmp IT64 op [VConstant (B64 x), VConstant (B64 y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
319+bCmp ITBig op [VConstant (BI x), VConstant (BI y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
320+bCmp ITNative op [VConstant (I x), VConstant (I y)] = Just $ VConstant (I (if (op x y) then 1 else 0))
321+bCmp _ _ _ = Nothing
322+
323+toInt IT8 x = VConstant (B8 (fromIntegral x))
324+toInt IT16 x = VConstant (B16 (fromIntegral x))
325+toInt IT32 x = VConstant (B32 (fromIntegral x))
326+toInt IT64 x = VConstant (B64 (fromIntegral x))
327+toInt ITBig x = VConstant (BI (fromIntegral x))
328+toInt ITNative x = VConstant (I (fromIntegral x))
329+
330+intToInt IT8 out [VConstant (B8 x)] = Just $ toInt out x
331+intToInt IT16 out [VConstant (B16 x)] = Just $ toInt out x
332+intToInt IT32 out [VConstant (B32 x)] = Just $ toInt out x
333+intToInt IT64 out [VConstant (B64 x)] = Just $ toInt out x
334+intToInt ITBig out [VConstant (BI x)] = Just $ toInt out x
335+intToInt ITNative out [VConstant (I x)] = Just $ toInt out x
336+intToInt _ _ _ = Nothing
337+
338+zext from ITBig val = intToInt from ITBig val
339+zext ITBig _ _ = Nothing
340+zext from to val
341+ | intTyWidth from < intTyWidth to = intToInt from to val
342+zext _ _ _ = Nothing
343+
344+sext IT8 out [VConstant (B8 x)] = Just $ toInt out (fromIntegral x :: Int8)
345+sext IT16 out [VConstant (B16 x)] = Just $ toInt out (fromIntegral x :: Int16)
346+sext IT32 out [VConstant (B32 x)] = Just $ toInt out (fromIntegral x :: Int32)
347+sext IT64 out [VConstant (B64 x)] = Just $ toInt out (fromIntegral x :: Int64)
348+sext ITBig _ _ = Nothing
349+sext from to val = intToInt from to val
350+
351+trunc ITBig to val = intToInt ITBig to val
352+trunc _ ITBig _ = Nothing
353+trunc from to val | intTyWidth from > intTyWidth to = intToInt from to val
354+trunc _ _ _ = Nothing
355+
356+getInt :: [Value] -> Maybe Integer
357+getInt [VConstant (B8 x)] = Just . toInteger $ x
358+getInt [VConstant (B16 x)] = Just . toInteger $ x
359+getInt [VConstant (B32 x)] = Just . toInteger $ x
360+getInt [VConstant (B64 x)] = Just . toInteger $ x
361+getInt [VConstant (I x)] = Just . toInteger $ x
362+getInt [VConstant (BI x)] = Just x
363+getInt _ = Nothing
364+
365+intToStr val | Just i <- getInt val = Just $ VConstant (Str (show i))
366+intToStr _ = Nothing
367+
368+strToInt ity [VConstant (Str x)] = case reads x of
369+ [(n,"")] -> Just $ toInt ity (n :: Integer)
370+ _ -> Just $ VConstant (I 0)
371+strToInt _ _ = Nothing
372+
373+intToFloat val | Just i <- getInt val = Just $ VConstant (Fl (fromIntegral i))
374+intToFloat _ = Nothing
375+
376+floatToInt ity [VConstant (Fl x)] = Just $ toInt ity (truncate x :: Integer)
377+floatToInt _ _ = Nothing
581378
582379c_intToChar [VConstant (I x)] = Just $ VConstant (Ch (toEnum x))
583380c_intToChar _ = Nothing
584381c_charToInt [VConstant (Ch x)] = Just $ VConstant (I (fromEnum x))
585382c_charToInt _ = Nothing
586383
587−c_intToBigInt [VConstant (I x)] = Just $ VConstant (BI (fromIntegral x))
588−c_intToBigInt _ = Nothing
589−c_bigIntToInt [VConstant (BI x)] = Just $ VConstant (I (fromInteger x))
590−c_bigIntToInt _ = Nothing
591−
592−c_bigIntToStr [VConstant (BI x)] = Just $ VConstant (Str (show x))
593−c_bigIntToStr _ = Nothing
594−c_strToBigInt [VConstant (Str x)] = case reads x of
595− [(n,"")] -> Just $ VConstant (BI n)
596− _ -> Just $ VConstant (BI 0)
597−c_strToBigInt _ = Nothing
598−
599384c_floatToStr [VConstant (Fl x)] = Just $ VConstant (Str (show x))
600385c_floatToStr _ = Nothing
601386c_strToFloat [VConstant (Str x)] = case reads x of
@@ -603,12 +388,6 @@ c_strToFloat [VConstant (Str x)] = case reads x of
603388 _ -> Just $ VConstant (Fl 0)
604389c_strToFloat _ = Nothing
605390
606−c_floatToInt [VConstant (Fl x)] = Just $ VConstant (I (truncate x))
607−c_floatToInt _ = Nothing
608−
609−c_intToFloat [VConstant (I x)] = Just $ VConstant (Fl (fromIntegral x))
610−c_intToFloat _ = Nothing
611−
612391p_fPrim f [VConstant (Fl x)] = Just $ VConstant (Fl (f x))
613392p_fPrim f _ = Nothing
614393