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

git.iko.soy/Idris-dev

Merge pull request #435 from JanBessai/SignedIntegerComparison

Signed integer comparison

commit8a0e9d4d7205ca0614b6d1cc2a525077f6ad7ca3 authorEdwin Brady <edwin.brady@gmail.com> dateSat 3 Aug 2013, 09:48 (13 years ago) parent67739f0 5b5c19c

9 files changed+136−86

compare with master

unifiedsplit

java/executable_pom_template.xml+1−1 lib/Builtins.idr+4−4 src/IRTS/CodegenC.hs+32−20 src/IRTS/CodegenJavaScript.hs+12−12 src/IRTS/CodegenLLVM.hs+12−8 src/IRTS/Java/JTypes.hs+8−4 src/IRTS/LParser.hs+16−16 src/IRTS/Lang.hs+2−1 src/Idris/Primitives.hs+49−20

java/executable_pom_template.xml+1−1

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

1515 <dependency>

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

1717 <artifactId>idris</artifactId>

18− <version>0.9.9</version>

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

1919 </dependency>

2020$DEPENDENCIES$

2121 </dependencies>

lib/Builtins.idr+4−4

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

191191

192192instance Ord Int where

193193 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

195195 GT

196196

197197

198198instance Ord Integer where

199199 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

201201 GT

202202

203203

204204instance Ord Float where

205205 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

207207 GT

208208

209209

210210instance Ord Char where

211211 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

213213 GT

214214

215215

src/IRTS/CodegenC.hs+32−20

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

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

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

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

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

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

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

278−doOp v (LGe (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 ++ ")"

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

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

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

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

279283

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

281285doOp 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]

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

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

294298doOp 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]

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

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

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

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

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

301+doOp v (LSGt (ATInt ITChar)) [l, r] = doOp v (LSGt (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]

299307

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

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

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

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

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

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

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

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

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

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

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

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

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

309317

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

311319doOp 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 ++ "

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

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

317325doOp 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 ++ ")"

319−doOp v (LLe (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 ++ ")"

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

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

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

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

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

322330

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

324332doOp 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 ++ "))"

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

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

342350

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

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

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

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

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

346−doOp v (LGe (ATInt (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]

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]

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

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

348360

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

231231

232232 | (LPlus ATFloat) <- op

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

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

240240 | (LEq ATFloat) <- op

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

242− | (LLt ATFloat) <- op

242+ | (LSLt ATFloat) <- op

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

244− | (LLe ATFloat) <- op

244+ | (LSLe ATFloat) <- op

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

246− | (LGt ATFloat) <- op

246+ | (LSGt ATFloat) <- op

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

248− | (LGe ATFloat) <- op

248+ | (LSGe ATFloat) <- op

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

250250

251251 | (LPlus _) <- op

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

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

261261 | (LEq _) <- op

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

263− | (LLt _) <- op

263+ | (LSLt _) <- op

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

265− | (LLe _) <- op

265+ | (LSLe _) <- op

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

267− | (LGt _) <- op

267+ | (LSGt _) <- op

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

269− | (LGe _) <- op

269+ | (LSGe _) <- op

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

271271 | (LAnd _) <- op

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

src/IRTS/CodegenLLVM.hs+12−8

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

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

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

862862

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

900900

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

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

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

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

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

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

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

905−cgOp (LGt (ATInt ity)) [x,y] = iCmp ity IPred.UGT 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

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

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

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

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

908912cgOp (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]

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

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

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

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

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

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

248−sourceTypes (LGe 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]

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

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

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

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

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

251255sourceTypes (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,

115115 [

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

126126

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

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

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

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

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

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

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

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

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

132132

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

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

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

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

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

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

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

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

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

138138 ]]

139139

140140binary 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

3232 | LUDiv IntTy | LSDiv ArithTy | LURem IntTy | LSRem ArithTy

3333 | LAnd IntTy | LOr IntTy | LXOr IntTy | LCompl IntTy

3434 | LSHL IntTy | LLSHR IntTy | LASHR IntTy

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

3637 | LSExt IntTy IntTy | LZExt IntTy IntTy | LTrunc IntTy IntTy

3738 | LStrConcat | LStrLt | LStrEq | LStrLen

3839 | LIntFloat IntTy | LFloatInt IntTy | LIntStr IntTy | LStrInt IntTy

src/Idris/Primitives.hs+49−20

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

1212import Data.Word

1313import Data.Int

1414import Data.Char

15+import Data.Function (on)

1516import Data.Vector.Unboxed (Vector)

1617import qualified Data.Vector.Unboxed as V

1718

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

103104 (2, LSDiv ATFloat) total,

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

105106 (2, LEq ATFloat) total,

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

107− (2, LLt ATFloat) total,

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

109− (2, LLe ATFloat) total,

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

111− (2, LGt ATFloat) total,

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

113− (2, LGe ATFloat) total,

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

108+ (2, LSLt ATFloat) total,

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

110+ (2, LSLe ATFloat) total,

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

112+ (2, LSGt ATFloat) total,

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

114+ (2, LSGe ATFloat) total,

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

115116 (2, LStrConcat) total,

116117 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]

179180intOps :: IntTy -> [Prim]

180181intOps ity = intCmps ity ++ intArith ity ++ intConv ity

181182

182−intCmps :: IntTy -> [Prim]

183−intCmps ity =

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

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

183+intSCmps :: IntTy -> [Prim]

184+intSCmps ity =

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

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

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

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

188− , iCmp ity "gt" False (bCmp ity (>)) (LGt . 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

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

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

189200 ]

190201

191202intArith :: IntTy -> [Prim]

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

220231

221232vecCmps :: IntTy -> [Prim]

222233vecCmps ity =

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

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

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

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

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

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

227− , iCmp ity "gt" True (bCmp ity (>)) (LGt . 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

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

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

228243 ]

229244

230245vecOps :: IntTy -> [Prim]

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

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

510525bitBin _ _ _ = Nothing

511526

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

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

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

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

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

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

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

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

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

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

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

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

528543bCmp _ _ _ = Nothing

529544

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+

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

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

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