29c67e9 · Idris-dev · git.iko.soy

CHANGELOG+5

compare with master

unifiedsplit

@@ -9,8 +9,13 @@ User visible changes:

9 elaborating their definitions

10* Implicit arguments will be added automatically only if their initial

11 letter is lower case, or they are in a using declaration

12+* Pattern matching on strings, big integers and characters

12* Added System.Concurrency modules

13* Added System.Concurrency modules

13

14

15+Internal changes:

16+

17+* Separate inlining methods at compile-time and run-time

18+

14New in 0.9.5:

19New in 0.9.5:

15-------------

20-------------

16

21

rts/idris_gmp.c+5

@@ -174,6 +174,11 @@ VAL idris_bigDivide(VM* vm, VAL x, VAL y) {

174 }

175}

176

177+int bigEqConst(VAL x, int c) {

178+ if (ISINT(x)) { return (GETINT(x) == c); }

179+ else { return mpz_cmp_si(GETMPZ(x), c); }

180+}

181+

177VAL bigEq(VM* vm, VAL x, VAL y) {

182VAL bigEq(VM* vm, VAL x, VAL y) {

178 return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) == 0));

183 return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) == 0));

179}

184}

rts/idris_gmp.h+2

@@ -11,6 +11,8 @@ VAL idris_bigMinus(VM*, VAL x, VAL y);

11VAL idris_bigTimes(VM*, VAL x, VAL y);

12VAL idris_bigDivide(VM*, VAL x, VAL y);

13

14+int bigEqConst(VAL x, int c);

15+

14VAL idris_bigEq(VM*, VAL x, VAL y);

16VAL idris_bigEq(VM*, VAL x, VAL y);

15VAL idris_bigLt(VM*, VAL x, VAL y);

17VAL idris_bigLt(VM*, VAL x, VAL y);

16VAL idris_bigLe(VM*, VAL x, VAL y);

18VAL idris_bigLe(VM*, VAL x, VAL y);

src/Core/CaseTree.hs+1−1

@@ -217,7 +217,7 @@ toPat tc tms = evalState (mapM (\x -> toPat' x []) tms) []

217 else do put (n : ns)

218 return (PV n)

219 toPat' (App f a) args = toPat' f (a : args)

220− toPat' (Constant x@(I _)) [] = return $ PConst x

220+ toPat' (Constant x) [] = return $ PConst x

221 toPat' _ _ = return PAny

222

223

src/IRTS/CodegenC.hs+38−7

@@ -54,7 +54,8 @@ codegenC dump defs out exec incs objs libs dbg

54 when (exit /= ExitSuccess) $

55 putStrLn ("FAILURE: " ++ gcc)

56

57−headers [] = "#include <idris_rts.h>\n#include <idris_stdfgn.h>\n#include <assert.h>\n"

57+headers [] = "#include <idris_rts.h>\n#include <idris_stdfgn.h>\n" ++

58+ "#include <gmp.h>\n#include <assert.h>\n"

58headers (x : xs) = "#include <" ++ x ++ ">\n" ++ headers xs

59headers (x : xs) = "#include <" ++ x ++ ">\n" ++ headers xs

59

60

60debug TRACE = "#define IDRIS_TRACE\n\n"

61debug TRACE = "#define IDRIS_TRACE\n\n"

@@ -127,16 +128,46 @@ bcc i (CASE r code def)

127 showDef i (Just c) = indent i ++ "default:\n"

128 showDef i (Just c) = indent i ++ "default:\n"

128 ++ concatMap (bcc (i+1)) c ++ indent (i + 1) ++ "break;\n"

129 ++ concatMap (bcc (i+1)) c ++ indent (i + 1) ++ "break;\n"

129bcc i (CONSTCASE r code def)

130bcc i (CONSTCASE r code def)

131+ | intConsts code

130− = indent i ++ "switch(GETINT(" ++ creg r ++ ")) {\n" ++

132+ = indent i ++ "switch(GETINT(" ++ creg r ++ ")) {\n" ++

131− concatMap (showCase i) code ++

133+ concatMap (showCase i) code ++

132− showDef i def ++

134+ showDef i def ++

135+ indent i ++ "}\n"

136+ | strConsts code

137+ = concatMap (strCase ("GETSTR(" ++ creg r ++ ")")) code ++

138+ indent i ++ "{\n" ++ showDefS i def ++ indent i ++ "}\n"

139+ | bigintConsts code

140+ = concatMap (biCase (creg r)) code ++

133− indent i ++ "}\n"

141+ indent i ++ "{\n" ++ showDefS i def ++ indent i ++ "}\n"

142+ | otherwise = error $ "Can't happen: Can't compile const case " ++ show code

134 where

143 where

144+ intConsts ((I _, _ ) : _) = True

145+ intConsts ((Ch _, _ ) : _) = True

146+ intConsts _ = False

147+

148+ bigintConsts ((BI _, _ ) : _) = True

149+ bigintConsts _ = False

150+

151+ strConsts ((Str _, _ ) : _) = True

152+ strConsts _ = False

153+

154+ strCase sv (s, bc) =

155+ indent i ++ "if (strcmp(" ++ sv ++ ", " ++ show s ++ ") == 0) {\n" ++

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

157+ biCase bv (BI b, bc) =

158+ indent i ++ "if (bigEqConst(" ++ bv ++ ", " ++ show b ++ ")) {\n"

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

160+

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

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

136− ++ concatMap (bcc (i+1)) bc ++ indent (i + 1) ++ "break;\n"

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

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

137 showDef i Nothing = ""

164 showDef i Nothing = ""

138 showDef i (Just c) = indent i ++ "default:\n"

165 showDef i (Just c) = indent i ++ "default:\n"

139− ++ concatMap (bcc (i+1)) c ++ indent (i + 1) ++ "break;\n"

166+ ++ concatMap (bcc (i+1)) c ++

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

168+ showDefS i Nothing = ""

169+ showDefS i (Just c) = concatMap (bcc (i+1)) c

170+

140bcc i (CALL n) = indent i ++ "CALL(" ++ cname n ++ ");\n"

171bcc i (CALL n) = indent i ++ "CALL(" ++ cname n ++ ");\n"

141bcc i (TAILCALL n) = indent i ++ "TAILCALL(" ++ cname n ++ ");\n"

172bcc i (TAILCALL n) = indent i ++ "TAILCALL(" ++ cname n ++ ");\n"

142bcc i (SLIDE n) = indent i ++ "SLIDE(vm, " ++ show n ++ ");\n"

173bcc i (SLIDE n) = indent i ++ "SLIDE(vm, " ++ show n ++ ");\n"

src/IRTS/Compiler.hs+17−4

@@ -268,15 +268,28 @@ instance ToIR SC where

268 mkIRAlt (ConCase n t args rhs)

269 = do rhs' <- ir rhs

270 return $ LConCase (-1) n args rhs'

271− mkIRAlt (ConstCase (I i) rhs)

271+ mkIRAlt (ConstCase x rhs)

272+ | matchable x

272 = do rhs' <- ir rhs

273 = do rhs' <- ir rhs

273− return $ LConstCase (I i) rhs'

274+ return $ LConstCase x rhs'

274− mkIRAlt (ConstCase IType rhs)

275+ | matchableTy x

275 = do rhs' <- ir rhs

276 = do rhs' <- ir rhs

276 return $ LDefaultCase rhs'

277 return $ LDefaultCase rhs'

277 mkIRAlt (ConstCase c rhs)

278 mkIRAlt (ConstCase c rhs)

278− = fail $ "Can only pattern match on integer constants (" ++ show c ++ ")"

279+ = fail $ "Can't match on (" ++ show c ++ ")"

279 mkIRAlt (DefaultCase rhs)

280 mkIRAlt (DefaultCase rhs)

280 = do rhs' <- ir rhs

281 = do rhs' <- ir rhs

281 return $ LDefaultCase rhs'

282 return $ LDefaultCase rhs'

282

283

284+ matchable (I _) = True

285+ matchable (BI _) = True

286+ matchable (Ch _) = True

287+ matchable (Str _) = True

288+ matchable _ = False

289+

290+ matchableTy IType = True

291+ matchableTy BIType = True

292+ matchableTy ChType = True

293+ matchableTy StrType = True

294+ matchableTy _ = False

295+

src/Idris/Parser.hs+2−1

@@ -751,7 +751,8 @@ modifyConst :: SyntaxInfo -> FC -> PTerm -> PTerm

751modifyConst syn fc (PConstant (I x))

752 | not (inPattern syn)

753 = PApp fc (PRef fc (UN "fromInteger")) [pexp (PConstant (I x))]

754+ | otherwise = PAlternative False

754− | otherwise = PConstant (I x)

755+ [PConstant (I x), PConstant (BI (toEnum x))]

755modifyConst syn fc x = x

756modifyConst syn fc x = x

756

757

757pList syn = do lchar '['; fc <- pfc; xs <- sepBy (pExpr syn) (lchar ','); lchar ']'

758pList syn = do lchar '['; fc <- pfc; xs <- sepBy (pExpr syn) (lchar ','); lchar ']'