8564250 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Allow pattern matching on BitX constants

8564250Niklas Larsson11 years ago

rts/idris_rts.h+5

compare with master

unifiedsplit

@@ -145,6 +145,11 @@ typedef void(*func)(VM*, VAL*);

145#define GETMPTR(x) (((VAL)(x))->info.mptr->data)

146#define GETFLOAT(x) (((VAL)(x))->info.f)

147

148+#define GETBITS8(x) (((VAL)(x))->info.bits8)

149+#define GETBITS16(x) (((VAL)(x))->info.bits16)

150+#define GETBITS32(x) (((VAL)(x))->info.bits32)

151+#define GETBITS64(x) (((VAL)(x))->info.bits64)

152+

148#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CON ? (x)->info.c.tag_arity >> 8 : (-1)) )

153#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CON ? (x)->info.c.tag_arity >> 8 : (-1)) )

149#define ARITY(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CON ? (x)->info.c.tag_arity & 0x000000ff : (-1)) )

154#define ARITY(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CON ? (x)->info.c.tag_arity & 0x000000ff : (-1)) )

150

155

src/IRTS/CodegenC.hs+16−1

@@ -259,6 +259,10 @@ bcc i (CONSTCASE r code def)

259 where

260 intConsts ((I _, _ ) : _) = True

261 intConsts ((Ch _, _ ) : _) = True

262+ intConsts ((B8 _, _ ) : _) = True

263+ intConsts ((B16 _, _ ) : _) = True

264+ intConsts ((B32 _, _ ) : _) = True

265+ intConsts ((B64 _, _ ) : _) = True

262 intConsts _ = False

266 intConsts _ = False

263

267

264 bigintConsts ((BI _, _ ) : _) = True

268 bigintConsts ((BI _, _ ) : _) = True

@@ -279,7 +283,18 @@ bcc i (CONSTCASE r code def)

279 iCase v (Ch b, bc) =

283 iCase v (Ch b, bc) =

280 indent i ++ "if (GETINT(" ++ v ++ ") == " ++ show (fromEnum b) ++ ") {\n"

284 indent i ++ "if (GETINT(" ++ v ++ ") == " ++ show (fromEnum b) ++ ") {\n"

281 ++ concatMap (bcc (i+1)) bc ++ indent i ++ "} else\n"

285 ++ concatMap (bcc (i+1)) bc ++ indent i ++ "} else\n"

282−

286+ iCase v (B8 w, bc) =

287+ indent i ++ "if (GETBITS8(" ++ v ++ ") == " ++ show (fromEnum w) ++ ") {\n"

288+ ++ concatMap (bcc (i+1)) bc ++ indent i ++ "} else\n"

289+ iCase v (B16 w, bc) =

290+ indent i ++ "if (GETBITS16(" ++ v ++ ") == " ++ show (fromEnum w) ++ ") {\n"

291+ ++ concatMap (bcc (i+1)) bc ++ indent i ++ "} else\n"

292+ iCase v (B32 w, bc) =

293+ indent i ++ "if (GETBITS32(" ++ v ++ ") == " ++ show (fromEnum w) ++ ") {\n"

294+ ++ concatMap (bcc (i+1)) bc ++ indent i ++ "} else\n"

295+ iCase v (B64 w, bc) =

296+ indent i ++ "if (GETBITS64(" ++ v ++ ") == " ++ show (fromEnum w) ++ ") {\n"

297+ ++ concatMap (bcc (i+1)) bc ++ indent i ++ "} else\n"

283 showCase i (t, bc) = indent i ++ "case " ++ show t ++ ":\n"

298 showCase i (t, bc) = indent i ++ "case " ++ show t ++ ":\n"

284 ++ concatMap (bcc (i+1)) bc ++

299 ++ concatMap (bcc (i+1)) bc ++

285 indent (i + 1) ++ "break;\n"

300 indent (i + 1) ++ "break;\n"

src/IRTS/Compiler.hs+4

@@ -685,6 +685,10 @@ irAlt vs _ (ConstCase x rhs)

685 matchable (BI _) = True

686 matchable (Ch _) = True

687 matchable (Str _) = True

688+ matchable (B8 _) = True

689+ matchable (B16 _) = True

690+ matchable (B32 _) = True

691+ matchable (B64 _) = True

688 matchable _ = False

692 matchable _ = False

689

693

690 matchableTy (AType (ATInt ITNative)) = True

694 matchableTy (AType (ATInt ITNative)) = True