8564250 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Allow pattern matching on BitX constants

commit85642503343807c8be63ab6c5fd2d7741d7db390 authorNiklas Larsson <niklas@mm.st> dateMon 7 Sep 2015, 21:59 (11 years ago) parentf08e412

3 files changed+25−1

compare with master

unifiedsplit

rts/idris_rts.h+5 src/IRTS/CodegenC.hs+16−1 src/IRTS/Compiler.hs+4

rts/idris_rts.h+5

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

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

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

147147

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+

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

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

150155

src/IRTS/CodegenC.hs+16−1

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

259259 where

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

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

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

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

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

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

262266 intConsts _ = False

263267

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

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

279283 iCase v (Ch b, bc) =

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

281285 ++ 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"

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

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

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

src/IRTS/Compiler.hs+4

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

685685 matchable (BI _) = True

686686 matchable (Ch _) = True

687687 matchable (Str _) = True

688+ matchable (B8 _) = True

689+ matchable (B16 _) = True

690+ matchable (B32 _) = True

691+ matchable (B64 _) = True

688692 matchable _ = False

689693

690694 matchableTy (AType (ATInt ITNative)) = True