8a0e9d4 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Merge pull request #435 from JanBessai/SignedIntegerComparison

8a0e9d4Edwin Brady13 years ago

java/executable_pom_template.xml+1−1

compare with master

unifiedsplit

@@ -15,7 +15,7 @@

15 <dependency>

16 <groupId>org.idris-lang</groupId>

17 <artifactId>idris</artifactId>

18− <version>0.9.9</version>

18+ <version>0.9.10-alpha-1</version>

19 </dependency>

20$DEPENDENCIES$

21 </dependencies>

lib/Builtins.idr+4−4

@@ -191,25 +191,25 @@ class Eq a => Ord a where

191

192instance Ord Int where

193 compare x y = if (x == y) then EQ else

194− if (boolOp prim__ltInt x y) then LT else

194+ if (boolOp prim__sltInt x y) then LT else

195 GT

196

197

198instance Ord Integer where

199 compare x y = if (x == y) then EQ else

200− if (boolOp prim__ltBigInt x y) then LT else

200+ if (boolOp prim__sltBigInt x y) then LT else

201 GT

202

203

204instance Ord Float where

205 compare x y = if (x == y) then EQ else

206− if (boolOp prim__ltFloat x y) then LT else

206+ if (boolOp prim__sltFloat x y) then LT else

207 GT

208

209

210instance Ord Char where

211 compare x y = if (x == y) then EQ else

212− if (boolOp prim__ltChar x y) then LT else

212+ if (boolOp prim__sltChar x y) then LT else

213 GT

214

215

src/IRTS/CodegenC.hs+32−20

@@ -272,10 +272,14 @@ doOp v (LLSHR ITNative) [l, r] = v ++ "UINTOP(>>," ++ creg l ++ ", " ++ creg r +

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

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

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

275+doOp v (LSLt (ATInt ITNative)) [l, r] = v ++ "INTOP(<," ++ creg l ++ ", " ++ creg r ++ ")"

276+doOp v (LSLe (ATInt ITNative)) [l, r] = v ++ "INTOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"

277+doOp v (LSGt (ATInt ITNative)) [l, r] = v ++ "INTOP(>," ++ creg l ++ ", " ++ creg r ++ ")"

278+doOp v (LSGe (ATInt ITNative)) [l, r] = v ++ "INTOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"

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

279+doOp v (LLt ITNative) [l, r] = v ++ "UINTOP(<," ++ creg l ++ ", " ++ creg r ++ ")"

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

280+doOp v (LLe ITNative) [l, r] = v ++ "UINTOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"

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

281+doOp v (LGt ITNative) [l, r] = v ++ "UINTOP(>," ++ creg l ++ ", " ++ creg r ++ ")"

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

282+doOp v (LGe ITNative) [l, r] = v ++ "UINTOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"

279

283

280doOp v (LPlus (ATInt ITChar)) [l, r] = doOp v (LPlus (ATInt ITNative)) [l, r]

284doOp v (LPlus (ATInt ITChar)) [l, r] = doOp v (LPlus (ATInt ITNative)) [l, r]

281doOp v (LMinus (ATInt ITChar)) [l, r] = doOp v (LMinus (ATInt ITNative)) [l, r]

285doOp v (LMinus (ATInt ITChar)) [l, r] = doOp v (LMinus (ATInt ITNative)) [l, r]

@@ -292,20 +296,24 @@ doOp v (LLSHR ITChar) [l, r] = doOp v (LLSHR ITNative) [l, r]

292doOp v (LASHR ITChar) [l, r] = doOp v (LASHR ITNative) [l, r]

296doOp v (LASHR ITChar) [l, r] = doOp v (LASHR ITNative) [l, r]

293doOp v (LCompl ITChar) [x] = doOp v (LCompl ITNative) [x]

297doOp v (LCompl ITChar) [x] = doOp v (LCompl ITNative) [x]

294doOp v (LEq (ATInt ITChar)) [l, r] = doOp v (LEq (ATInt ITNative)) [l, r]

298doOp v (LEq (ATInt ITChar)) [l, r] = doOp v (LEq (ATInt ITNative)) [l, r]

295−doOp v (LLt (ATInt ITChar)) [l, r] = doOp v (LLt (ATInt ITNative)) [l, r]

299+doOp v (LSLt (ATInt ITChar)) [l, r] = doOp v (LSLt (ATInt ITNative)) [l, r]

296−doOp v (LLe (ATInt ITChar)) [l, r] = doOp v (LLe (ATInt ITNative)) [l, r]

300+doOp v (LSLe (ATInt ITChar)) [l, r] = doOp v (LSLe (ATInt ITNative)) [l, r]

297−doOp v (LGt (ATInt ITChar)) [l, r] = doOp v (LGt (ATInt ITNative)) [l, r]

301+doOp v (LSGt (ATInt ITChar)) [l, r] = doOp v (LSGt (ATInt ITNative)) [l, r]

298−doOp v (LGe (ATInt ITChar)) [l, r] = doOp v (LGe (ATInt ITNative)) [l, r]

302+doOp v (LSGe (ATInt ITChar)) [l, r] = doOp v (LSGe (ATInt ITNative)) [l, r]

303+doOp v (LLt ITChar) [l, r] = doOp v (LLt ITNative) [l, r]

304+doOp v (LLe ITChar) [l, r] = doOp v (LLe ITNative) [l, r]

305+doOp v (LGt ITChar) [l, r] = doOp v (LGt ITNative) [l, r]

306+doOp v (LGe ITChar) [l, r] = doOp v (LGe ITNative) [l, r]

299

307

300doOp v (LPlus ATFloat) [l, r] = v ++ "FLOATOP(+," ++ creg l ++ ", " ++ creg r ++ ")"

308doOp v (LPlus ATFloat) [l, r] = v ++ "FLOATOP(+," ++ creg l ++ ", " ++ creg r ++ ")"

301doOp v (LMinus ATFloat) [l, r] = v ++ "FLOATOP(-," ++ creg l ++ ", " ++ creg r ++ ")"

309doOp v (LMinus ATFloat) [l, r] = v ++ "FLOATOP(-," ++ creg l ++ ", " ++ creg r ++ ")"

302doOp v (LTimes ATFloat) [l, r] = v ++ "FLOATOP(*," ++ creg l ++ ", " ++ creg r ++ ")"

310doOp v (LTimes ATFloat) [l, r] = v ++ "FLOATOP(*," ++ creg l ++ ", " ++ creg r ++ ")"

303doOp v (LSDiv ATFloat) [l, r] = v ++ "FLOATOP(/," ++ creg l ++ ", " ++ creg r ++ ")"

311doOp v (LSDiv ATFloat) [l, r] = v ++ "FLOATOP(/," ++ creg l ++ ", " ++ creg r ++ ")"

304doOp v (LEq ATFloat) [l, r] = v ++ "FLOATBOP(==," ++ creg l ++ ", " ++ creg r ++ ")"

312doOp v (LEq ATFloat) [l, r] = v ++ "FLOATBOP(==," ++ creg l ++ ", " ++ creg r ++ ")"

305−doOp v (LLt ATFloat) [l, r] = v ++ "FLOATBOP(<," ++ creg l ++ ", " ++ creg r ++ ")"

313+doOp v (LSLt ATFloat) [l, r] = v ++ "FLOATBOP(<," ++ creg l ++ ", " ++ creg r ++ ")"

306−doOp v (LLe ATFloat) [l, r] = v ++ "FLOATBOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"

314+doOp v (LSLe ATFloat) [l, r] = v ++ "FLOATBOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"

307−doOp v (LGt ATFloat) [l, r] = v ++ "FLOATBOP(>," ++ creg l ++ ", " ++ creg r ++ ")"

315+doOp v (LSGt ATFloat) [l, r] = v ++ "FLOATBOP(>," ++ creg l ++ ", " ++ creg r ++ ")"

308−doOp v (LGe ATFloat) [l, r] = v ++ "FLOATBOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"

316+doOp v (LSGe ATFloat) [l, r] = v ++ "FLOATBOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"

309

317

310doOp v (LIntFloat ITBig) [x] = v ++ "idris_castBigFloat(vm, " ++ creg x ++ ")"

318doOp v (LIntFloat ITBig) [x] = v ++ "idris_castBigFloat(vm, " ++ creg x ++ ")"

311doOp v (LFloatInt ITBig) [x] = v ++ "idris_castFloatBig(vm, " ++ creg x ++ ")"

319doOp v (LFloatInt ITBig) [x] = v ++ "idris_castFloatBig(vm, " ++ creg x ++ ")"

@@ -315,10 +323,10 @@ doOp v (LTimes (ATInt ITBig)) [l, r] = v ++ "idris_bigTimes(vm, " ++ creg l ++ "

315doOp v (LSDiv (ATInt ITBig)) [l, r] = v ++ "idris_bigDivide(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

323doOp v (LSDiv (ATInt ITBig)) [l, r] = v ++ "idris_bigDivide(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

316doOp v (LSRem (ATInt ITBig)) [l, r] = v ++ "idris_bigMod(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

324doOp v (LSRem (ATInt ITBig)) [l, r] = v ++ "idris_bigMod(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

317doOp v (LEq (ATInt ITBig)) [l, r] = v ++ "idris_bigEq(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

325doOp v (LEq (ATInt ITBig)) [l, r] = v ++ "idris_bigEq(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

318−doOp v (LLt (ATInt ITBig)) [l, r] = v ++ "idris_bigLt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

326+doOp v (LSLt (ATInt ITBig)) [l, r] = v ++ "idris_bigLt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

319−doOp v (LLe (ATInt ITBig)) [l, r] = v ++ "idris_bigLe(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

327+doOp v (LSLe (ATInt ITBig)) [l, r] = v ++ "idris_bigLe(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

320−doOp v (LGt (ATInt ITBig)) [l, r] = v ++ "idris_bigGt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

328+doOp v (LSGt (ATInt ITBig)) [l, r] = v ++ "idris_bigGt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

321−doOp v (LGe (ATInt ITBig)) [l, r] = v ++ "idris_bigGe(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

329+doOp v (LSGe (ATInt ITBig)) [l, r] = v ++ "idris_bigGe(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

322

330

323doOp v LStrConcat [l,r] = v ++ "idris_concat(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

331doOp v LStrConcat [l,r] = v ++ "idris_concat(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

324doOp v LStrLt [l,r] = v ++ "idris_strlt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

332doOp v LStrLt [l,r] = v ++ "idris_strlt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

@@ -340,11 +348,15 @@ doOp v LReadStr [x] = v ++ "idris_readStr(vm, GETPTR(" ++ creg x ++ "))"

340doOp _ LPrintNum [x] = "printf(\"%ld\\n\", GETINT(" ++ creg x ++ "))"

348doOp _ LPrintNum [x] = "printf(\"%ld\\n\", GETINT(" ++ creg x ++ "))"

341doOp _ LPrintStr [x] = "fputs(GETSTR(" ++ creg x ++ "), stdout)"

349doOp _ LPrintStr [x] = "fputs(GETSTR(" ++ creg x ++ "), stdout)"

342

350

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

351+doOp v (LSLt (ATInt (ITFixed ty))) [x, y] = bitOp v "SLt" ty [x, y]

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

352+doOp v (LSLe (ATInt (ITFixed ty))) [x, y] = bitOp v "SLte" ty [x, y]

345doOp v (LEq (ATInt (ITFixed ty))) [x, y] = bitOp v "Eq" ty [x, y]

353doOp v (LEq (ATInt (ITFixed ty))) [x, y] = bitOp v "Eq" ty [x, y]

354+doOp v (LSGe (ATInt (ITFixed ty))) [x, y] = bitOp v "SGte" ty [x, y]

355+doOp v (LSGt (ATInt (ITFixed ty))) [x, y] = bitOp v "SGt" ty [x, y]

356+doOp v (LLt (ITFixed ty)) [x, y] = bitOp v "Lt" ty [x, y]

357+doOp v (LLe (ITFixed ty)) [x, y] = bitOp v "Lte" ty [x, y]

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

358+doOp v (LGe (ITFixed ty)) [x, y] = bitOp v "Gte" ty [x, y]

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

359+doOp v (LGt (ITFixed ty)) [x, y] = bitOp v "Gt" ty [x, y]

348

360

349doOp v (LSHL (ITFixed ty)) [x, y] = bitOp v "Shl" ty [x, y]

361doOp v (LSHL (ITFixed ty)) [x, y] = bitOp v "Shl" ty [x, y]

350doOp v (LLSHR (ITFixed ty)) [x, y] = bitOp v "LShr" ty [x, y]

362doOp v (LLSHR (ITFixed ty)) [x, y] = bitOp v "LShr" ty [x, y]

src/IRTS/CodegenJavaScript.hs+12−12

@@ -220,13 +220,13 @@ translateExpression (SOp op vars)

220 , (lhs:rhs:_) <- vars = translateBinaryOp ".mod(" lhs rhs ++ ")"

221 | (LEq (ATInt ITBig)) <- op

222 , (lhs:rhs:_) <- vars = translateBinaryOp ".equals(" lhs rhs ++ ")"

223− | (LLt (ATInt ITBig)) <- op

223+ | (LSLt (ATInt ITBig)) <- op

224 , (lhs:rhs:_) <- vars = translateBinaryOp ".lesser(" lhs rhs ++ ")"

225− | (LLe (ATInt ITBig)) <- op

225+ | (LSLe (ATInt ITBig)) <- op

226 , (lhs:rhs:_) <- vars = translateBinaryOp ".lesserOrEquals(" lhs rhs ++ ")"

227− | (LGt (ATInt ITBig)) <- op

227+ | (LSGt (ATInt ITBig)) <- op

228 , (lhs:rhs:_) <- vars = translateBinaryOp ".greater(" lhs rhs ++ ")"

229− | (LGe (ATInt ITBig)) <- op

229+ | (LSGe (ATInt ITBig)) <- op

230 , (lhs:rhs:_) <- vars = translateBinaryOp ".greaterOrEquals(" lhs rhs ++ ")"

231

232 | (LPlus ATFloat) <- op

@@ -239,13 +239,13 @@ translateExpression (SOp op vars)

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

240 | (LEq ATFloat) <- op

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

242− | (LLt ATFloat) <- op

242+ | (LSLt ATFloat) <- op

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

244− | (LLe ATFloat) <- op

244+ | (LSLe ATFloat) <- op

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

246− | (LGt ATFloat) <- op

246+ | (LSGt ATFloat) <- op

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

248− | (LGe ATFloat) <- op

248+ | (LSGe ATFloat) <- op

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

250

251 | (LPlus _) <- op

@@ -260,13 +260,13 @@ translateExpression (SOp op vars)

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

261 | (LEq _) <- op

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

263− | (LLt _) <- op

263+ | (LSLt _) <- op

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

265− | (LLe _) <- op

265+ | (LSLe _) <- op

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

267− | (LGt _) <- op

267+ | (LSGt _) <- op

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

269− | (LGe _) <- op

269+ | (LSGe _) <- op

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

271 | (LAnd _) <- op

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

src/IRTS/CodegenLLVM.hs+12−8

@@ -860,11 +860,11 @@ cgOp (LSExt from ITBig) [x] = do

860cgOp (LChInt ITNative) [x] = return x

861cgOp (LIntCh ITNative) [x] = return x

862

863−cgOp (LLt (ATInt ITBig)) [x,y] = mpzCmp IPred.SLT x y

863+cgOp (LSLt (ATInt ITBig)) [x,y] = mpzCmp IPred.SLT x y

864−cgOp (LLe (ATInt ITBig)) [x,y] = mpzCmp IPred.SLE x y

864+cgOp (LSLe (ATInt ITBig)) [x,y] = mpzCmp IPred.SLE x y

865cgOp (LEq (ATInt ITBig)) [x,y] = mpzCmp IPred.EQ x y

866−cgOp (LGe (ATInt ITBig)) [x,y] = mpzCmp IPred.SGE x y

866+cgOp (LSGe (ATInt ITBig)) [x,y] = mpzCmp IPred.SGE x y

867−cgOp (LGt (ATInt ITBig)) [x,y] = mpzCmp IPred.SGT x y

867+cgOp (LSGt (ATInt ITBig)) [x,y] = mpzCmp IPred.SGT x y

868cgOp (LPlus (ATInt ITBig)) [x,y] = mpzBin "add" x y

869cgOp (LMinus (ATInt ITBig)) [x,y] = mpzBin "sub" x y

870cgOp (LTimes (ATInt ITBig)) [x,y] = mpzBin "mul" x y

@@ -898,11 +898,15 @@ cgOp (LZExt (ITFixed from) (ITFixed to)) [x]

898cgOp (LSExt (ITFixed from) (ITFixed to)) [x]

899 | nativeTyWidth from < nativeTyWidth to = iCoerce SExt from to x

900

901+cgOp (LSLt (ATInt ity)) [x,y] = iCmp ity IPred.SLT x y

902+cgOp (LSLe (ATInt ity)) [x,y] = iCmp ity IPred.SLE x y

901−cgOp (LLt (ATInt ity)) [x,y] = iCmp ity IPred.ULT x y

903+cgOp (LLt ity) [x,y] = iCmp ity IPred.ULT x y

902−cgOp (LLe (ATInt ity)) [x,y] = iCmp ity IPred.ULE x y

904+cgOp (LLe ity) [x,y] = iCmp ity IPred.ULE x y

903cgOp (LEq (ATInt ity)) [x,y] = iCmp ity IPred.EQ x y

905cgOp (LEq (ATInt ity)) [x,y] = iCmp ity IPred.EQ x y

906+cgOp (LSGe (ATInt ity)) [x,y] = iCmp ity IPred.SGE x y

907+cgOp (LSGt (ATInt ity)) [x,y] = iCmp ity IPred.SGT x y

904−cgOp (LGe (ATInt ity)) [x,y] = iCmp ity IPred.UGE x y

908+cgOp (LGe ity) [x,y] = iCmp ity IPred.UGE x y

905−cgOp (LGt (ATInt ity)) [x,y] = iCmp ity IPred.UGT x y

909+cgOp (LGt ity) [x,y] = iCmp ity IPred.UGT x y

906cgOp (LPlus (ATInt ity)) [x,y] = ibin ity x y (Add False False)

910cgOp (LPlus (ATInt ity)) [x,y] = ibin ity x y (Add False False)

907cgOp (LMinus (ATInt ity)) [x,y] = ibin ity x y (Sub False False)

911cgOp (LMinus (ATInt ity)) [x,y] = ibin ity x y (Sub False False)

908cgOp (LTimes (ATInt ity)) [x,y] = ibin ity x y (Mul False False)

912cgOp (LTimes (ATInt ity)) [x,y] = ibin ity x y (Mul False False)

src/IRTS/Java/JTypes.hs+8−4

@@ -242,10 +242,14 @@ sourceTypes (LSHL from) = [intTyToJType from, intTyToJType from]

242sourceTypes (LLSHR from) = [intTyToJType from, intTyToJType from]

243sourceTypes (LASHR from) = [intTyToJType from, intTyToJType from]

244sourceTypes (LEq from) = [arithTyToJType from, arithTyToJType from]

245−sourceTypes (LLt from) = [arithTyToJType from, arithTyToJType from]

245+sourceTypes (LSLt from) = [arithTyToJType from, arithTyToJType from]

246+sourceTypes (LSLe from) = [arithTyToJType from, arithTyToJType from]

247+sourceTypes (LSGt from) = [arithTyToJType from, arithTyToJType from]

248+sourceTypes (LSGe from) = [arithTyToJType from, arithTyToJType from]

249+sourceTypes (LLt from) = [intTyToJType from, intTyToJType from]

246−sourceTypes (LLe from) = [arithTyToJType from, arithTyToJType from]

250+sourceTypes (LLe from) = [intTyToJType from, intTyToJType from]

247−sourceTypes (LGt from) = [arithTyToJType from, arithTyToJType from]

251+sourceTypes (LGt from) = [intTyToJType from, intTyToJType from]

248−sourceTypes (LGe from) = [arithTyToJType from, arithTyToJType from]

252+sourceTypes (LGe from) = [intTyToJType from, intTyToJType from]

249sourceTypes (LSExt from _) = [intTyToJType from]

253sourceTypes (LSExt from _) = [intTyToJType from]

250sourceTypes (LZExt from _) = [intTyToJType from]

254sourceTypes (LZExt from _) = [intTyToJType from]

251sourceTypes (LTrunc from _) = [intTyToJType from]

255sourceTypes (LTrunc from _) = [intTyToJType from]

src/IRTS/LParser.hs+16−16

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

115 [

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

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

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

118+ binary "<" (\x y -> LOp (LSLt (ATInt ITNative)) [x, y]) AssocNone,

119− binary "<." (\x y -> LOp (LLt ATFloat) [x, y]) AssocNone,

119+ binary "<." (\x y -> LOp (LSLt ATFloat) [x, y]) AssocNone,

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

120+ binary ">" (\x y -> LOp (LSGt (ATInt ITNative)) [x, y]) AssocNone,

121− binary ">." (\x y -> LOp (LGt ATFloat) [x, y]) AssocNone,

121+ binary ">." (\x y -> LOp (LSGt ATFloat) [x, y]) AssocNone,

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

122+ binary "<=" (\x y -> LOp (LSLe (ATInt ITNative)) [x, y]) AssocNone,

123− binary "<=." (\x y -> LOp (LLe ATFloat) [x, y]) AssocNone,

123+ binary "<=." (\x y -> LOp (LSLe ATFloat) [x, y]) AssocNone,

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

124+ binary ">=" (\x y -> LOp (LSGe (ATInt ITNative)) [x, y]) AssocNone,

125− binary ">=." (\x y -> LOp (LGe ATFloat) [x, y]) AssocNone,

125+ binary ">=." (\x y -> LOp (LSGe ATFloat) [x, y]) AssocNone,

126

127 binary "==:" (\x y -> LOp (LEq (ATInt ITBig)) [x, y]) AssocNone,

128− binary "<:" (\x y -> LOp (LLt (ATInt ITBig)) [x, y]) AssocNone,

128+ binary "<:" (\x y -> LOp (LSLt (ATInt ITBig)) [x, y]) AssocNone,

129− binary ">:" (\x y -> LOp (LGt (ATInt ITBig)) [x, y]) AssocNone,

129+ binary ">:" (\x y -> LOp (LSGt (ATInt ITBig)) [x, y]) AssocNone,

130− binary "<=:" (\x y -> LOp (LLe (ATInt ITBig)) [x, y]) AssocNone,

130+ binary "<=:" (\x y -> LOp (LSLe (ATInt ITBig)) [x, y]) AssocNone,

131− binary ">=:" (\x y -> LOp (LGe (ATInt ITBig)) [x, y]) AssocNone,

131+ binary ">=:" (\x y -> LOp (LSGe (ATInt ITBig)) [x, y]) AssocNone,

132

133 binary "==," (\x y -> LOp (LEq (ATInt ITChar)) [x, y]) AssocNone,

134− binary "<," (\x y -> LOp (LLt (ATInt ITChar)) [x, y]) AssocNone,

134+ binary "<," (\x y -> LOp (LSLt (ATInt ITChar)) [x, y]) AssocNone,

135− binary ">," (\x y -> LOp (LGt (ATInt ITChar)) [x, y]) AssocNone,

135+ binary ">," (\x y -> LOp (LSGt (ATInt ITChar)) [x, y]) AssocNone,

136− binary "<=," (\x y -> LOp (LLe (ATInt ITChar)) [x, y]) AssocNone,

136+ binary "<=," (\x y -> LOp (LSLe (ATInt ITChar)) [x, y]) AssocNone,

137− binary ">=," (\x y -> LOp (LGe (ATInt ITChar)) [x, y]) AssocNone

137+ binary ">=," (\x y -> LOp (LSGe (ATInt ITChar)) [x, y]) AssocNone

138 ]]

139

140binary name f assoc = Infix (do reservedOp name; return f) assoc

src/IRTS/Lang.hs+2−1

@@ -32,7 +32,8 @@ data PrimFn = LPlus ArithTy | LMinus ArithTy | LTimes ArithTy

32 | LUDiv IntTy | LSDiv ArithTy | LURem IntTy | LSRem ArithTy

33 | LAnd IntTy | LOr IntTy | LXOr IntTy | LCompl IntTy

34 | LSHL IntTy | LLSHR IntTy | LASHR IntTy

36+ | LSLt ArithTy | LSLe ArithTy | LSGt ArithTy | LSGe ArithTy

36 | LSExt IntTy IntTy | LZExt IntTy IntTy | LTrunc IntTy IntTy

37 | LSExt IntTy IntTy | LZExt IntTy IntTy | LTrunc IntTy IntTy

37 | LStrConcat | LStrLt | LStrEq | LStrLen

38 | LStrConcat | LStrLt | LStrEq | LStrLen

38 | LIntFloat IntTy | LFloatInt IntTy | LIntStr IntTy | LStrInt IntTy

39 | LIntFloat IntTy | LFloatInt IntTy | LIntStr IntTy | LStrInt IntTy

src/Idris/Primitives.hs+49−20

@@ -12,6 +12,7 @@ import Data.Bits

12import Data.Word

13import Data.Int

14import Data.Char

15+import Data.Function (on)

15import Data.Vector.Unboxed (Vector)

16import Data.Vector.Unboxed (Vector)

16import qualified Data.Vector.Unboxed as V

17import qualified Data.Vector.Unboxed as V

@@ -103,14 +104,14 @@ primitives =

103 (2, LSDiv ATFloat) total,

104 (2, LSDiv ATFloat) total,

104 Prim (UN "prim__eqFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType (ATInt ITNative))) 2 (bfBin (==))

105 Prim (UN "prim__eqFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType (ATInt ITNative))) 2 (bfBin (==))

105 (2, LEq ATFloat) total,

106 (2, LEq ATFloat) total,

106− Prim (UN "prim__ltFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType (ATInt ITNative))) 2 (bfBin (<))

107+ Prim (UN "prim__sltFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType (ATInt ITNative))) 2 (bfBin (<))

107− (2, LLt ATFloat) total,

108+ (2, LSLt ATFloat) total,

108− Prim (UN "prim__lteFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType (ATInt ITNative))) 2 (bfBin (<=))

109+ Prim (UN "prim__slteFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType (ATInt ITNative))) 2 (bfBin (<=))

109− (2, LLe ATFloat) total,

110+ (2, LSLe ATFloat) total,

110− Prim (UN "prim__gtFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType (ATInt ITNative))) 2 (bfBin (>))

111+ Prim (UN "prim__sgtFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType (ATInt ITNative))) 2 (bfBin (>))

111− (2, LGt ATFloat) total,

112+ (2, LSGt ATFloat) total,

112− Prim (UN "prim__gteFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType (ATInt ITNative))) 2 (bfBin (>=))

113+ Prim (UN "prim__sgteFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType (ATInt ITNative))) 2 (bfBin (>=))

113− (2, LGe ATFloat) total,

114+ (2, LSGe ATFloat) total,

114 Prim (UN "prim__concat") (ty [StrType, StrType] StrType) 2 (sBin (++))

115 Prim (UN "prim__concat") (ty [StrType, StrType] StrType) 2 (sBin (++))

115 (2, LStrConcat) total,

116 (2, LStrConcat) total,

116 Prim (UN "prim__eqString") (ty [StrType, StrType] (AType (ATInt ITNative))) 2 (bsBin (==))

117 Prim (UN "prim__eqString") (ty [StrType, StrType] (AType (ATInt ITNative))) 2 (bsBin (==))

@@ -179,13 +180,23 @@ vecTypes = [ITVec IT8 16, ITVec IT16 8, ITVec IT32 4, ITVec IT64 2]

179intOps :: IntTy -> [Prim]

180intOps :: IntTy -> [Prim]

180intOps ity = intCmps ity ++ intArith ity ++ intConv ity

181intOps ity = intCmps ity ++ intArith ity ++ intConv ity

181

182

182−intCmps :: IntTy -> [Prim]

183+intSCmps :: IntTy -> [Prim]

183−intCmps ity =

184+intSCmps ity =

184− [ iCmp ity "lt" False (bCmp ity (<)) (LLt . ATInt) total

185+ [ iCmp ity "slt" False (bCmp ity (sCmpOp ity (<))) (LSLt . ATInt) total

185− , iCmp ity "lte" False (bCmp ity (<=)) (LLe . ATInt) total

186+ , iCmp ity "slte" False (bCmp ity (sCmpOp ity (<=))) (LSLe . ATInt) total

186 , iCmp ity "eq" False (bCmp ity (==)) (LEq . ATInt) total

187 , iCmp ity "eq" False (bCmp ity (==)) (LEq . ATInt) total

188+ , iCmp ity "sgte" False (bCmp ity (sCmpOp ity (>=))) (LSGe . ATInt) total

189+ , iCmp ity "sgt" False (bCmp ity (sCmpOp ity (>))) (LSGt . ATInt) total

190+ ]

191+

192+intCmps :: IntTy -> [Prim]

193+intCmps ITNative = intSCmps ITNative

194+intCmps ity =

195+ intSCmps ity ++

196+ [ iCmp ity "lt" False (bCmp ity (cmpOp ity (<))) LLt total

197+ , iCmp ity "lte" False (bCmp ity (cmpOp ity (<=))) LLe total

187− , iCmp ity "gte" False (bCmp ity (>=)) (LGe . ATInt) total

198+ , iCmp ity "gte" False (bCmp ity (cmpOp ity (>=))) LGe total

188− , iCmp ity "gt" False (bCmp ity (>)) (LGt . ATInt) total

199+ , iCmp ity "gt" False (bCmp ity (cmpOp ity (>))) LGt total

189 ]

200 ]

190

201

191intArith :: IntTy -> [Prim]

202intArith :: IntTy -> [Prim]

@@ -220,11 +231,15 @@ intConv ity =

220

231

221vecCmps :: IntTy -> [Prim]

232vecCmps :: IntTy -> [Prim]

222vecCmps ity =

233vecCmps ity =

223− [ iCmp ity "lt" True (bCmp ity (<)) (LLt . ATInt) total

234+ [ iCmp ity "slt" True (bCmp ity (<)) (LSLt . ATInt) total

224− , iCmp ity "lte" True (bCmp ity (<=)) (LLe . ATInt) total

235+ , iCmp ity "slte" True (bCmp ity (<=)) (LSLe . ATInt) total

225 , iCmp ity "eq" True (bCmp ity (==)) (LEq . ATInt) total

236 , iCmp ity "eq" True (bCmp ity (==)) (LEq . ATInt) total

237+ , iCmp ity "sgte" True (bCmp ity (>=)) (LSGe . ATInt) total

238+ , iCmp ity "sgt" True (bCmp ity (>)) (LSGt . ATInt) total

239+ , iCmp ity "lt" True (bCmp ity (<)) LLt total

240+ , iCmp ity "lte" True (bCmp ity (<=)) LLe total

226− , iCmp ity "gte" True (bCmp ity (>=)) (LGe . ATInt) total

241+ , iCmp ity "gte" True (bCmp ity (>=)) LGe total

227− , iCmp ity "gt" True (bCmp ity (>)) (LGt . ATInt) total

242+ , iCmp ity "gt" True (bCmp ity (>)) LGt total

228 ]

243 ]

229

244

230vecOps :: IntTy -> [Prim]

245vecOps :: IntTy -> [Prim]

@@ -509,14 +524,14 @@ bitBin (ITVec IT32 _) op [B32V x, B32V y] = Just . B32V $ V.zipWith op x y

509bitBin (ITVec IT64 _) op [B64V x, B64V y] = Just . B64V $ V.zipWith op x y

524bitBin (ITVec IT64 _) op [B64V x, B64V y] = Just . B64V $ V.zipWith op x y

510bitBin _ _ _ = Nothing

525bitBin _ _ _ = Nothing

511

526

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

527+bCmp :: IntTy -> (forall a. (Integral a, Ord a) => a -> a -> Bool) -> [Const] -> Maybe Const

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

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

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

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

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

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

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

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

517bCmp ITBig op [BI x, BI y] = Just $ I (if (op x y) then 1 else 0)

532bCmp ITBig op [BI x, BI y] = Just $ I (if (op x y) then 1 else 0)

518bCmp ITNative op [I x, I y] = Just $ I (if (op x y) then 1 else 0)

533bCmp ITNative op [I x, I y] = Just $ I (if (op x y) then 1 else 0)

519−bCmp ITChar op [Ch x, Ch y] = Just $ I (if (op x y) then 1 else 0)

534+bCmp ITChar op [Ch x, Ch y] = Just $ I (if (op (ord x) (ord y)) then 1 else 0)

520bCmp (ITVec IT8 _) op [B8V x, B8V y]

535bCmp (ITVec IT8 _) op [B8V x, B8V y]

521 = Just . B8V . V.map (\b -> if b then -1 else 0) $ V.zipWith op x y

536 = Just . B8V . V.map (\b -> if b then -1 else 0) $ V.zipWith op x y

522bCmp (ITVec IT16 _) op [B16V x, B16V y]

537bCmp (ITVec IT16 _) op [B16V x, B16V y]

@@ -527,6 +542,20 @@ bCmp (ITVec IT64 _) op [B64V x, B64V y]

527 = Just . B64V . V.map (\b -> if b then -1 else 0) $ V.zipWith op x y

542 = Just . B64V . V.map (\b -> if b then -1 else 0) $ V.zipWith op x y

528bCmp _ _ _ = Nothing

543bCmp _ _ _ = Nothing

529

544

545+

546+cmpOp :: (Ord a, Integral a) => IntTy -> (forall b. Ord b => b -> b -> Bool) -> a -> a -> Bool

547+cmpOp (ITFixed _) f = f

548+cmpOp (ITNative) f = f `on` (fromIntegral :: Integral a => a -> Word)

549+cmpOp (ITChar) f = f `on` ((fromIntegral :: Integral a => a -> Word))

550+cmpOp _ f = let xor = (/=) in (\ x y -> (f x y) `xor` (x < 0) `xor` (y < 0))

551+

552+sCmpOp :: (Ord a, Integral a) => IntTy -> (forall b. Ord b => b -> b -> Bool) -> a -> a -> Bool

553+sCmpOp (ITFixed IT8) f = f `on` (fromIntegral :: Integral a => a -> Int8)

554+sCmpOp (ITFixed IT16) f = f `on` (fromIntegral :: Integral a => a -> Int16)

555+sCmpOp (ITFixed IT32) f = f `on` (fromIntegral :: Integral a => a -> Int32)

556+sCmpOp (ITFixed IT64) f = f `on` (fromIntegral :: Integral a => a -> Int64)

557+sCmpOp _ f = f

558+

530toInt :: Integral a => IntTy -> a -> Const

559toInt :: Integral a => IntTy -> a -> Const

531toInt (ITFixed IT8) x = B8 (fromIntegral x)

560toInt (ITFixed IT8) x = B8 (fromIntegral x)

532toInt (ITFixed IT16) x = B16 (fromIntegral x)

561toInt (ITFixed IT16) x = B16 (fromIntegral x)