75ccf81 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Give nicer errors for bad function defs and for duplicate variables in patterns

75ccf81Evan Czaplicki11 years ago

src/Parse/Expression.hs+6−24

compare with master

unifiedsplit

@@ -296,7 +296,7 @@ definition :: IParser Source.Def

296definition =

297 addLocation $

298 withPos $

299− do (name:args) <- defStart

299+ do (name, args) <- defStart

300 padded equals

301 body <- expr

302 return . Source.Definition name $ makeFunction args body

@@ -307,27 +307,9 @@ makeFunction args body@(A.A ann _) =

307 foldr (\arg body' -> A.A ann $ E.Lambda arg body') body args

308

309

310−defStart :: IParser [P.RawPattern]

310+defStart :: IParser (P.RawPattern, [P.RawPattern])

311defStart =

312− choice

312+ expecting "the definition of a value (x = ...)" $

313− [ do pattern <- try Pattern.term

314− infics pattern <|> func pattern

315− , do opPattern <- addLocation (P.Var <$> parens symOp)

313+ do starter <- try Pattern.term <|> addLocation (P.Var <$> parens symOp)

316− func opPattern

317− ]

318− <?> "the definition of a variable (x = ...)"

319− where

320− func pattern =

321− case pattern of

322− A.A _ (P.Var _) ->

323− (pattern:) <$> spacePrefix Pattern.term

314+ args <- spacePrefix Pattern.term

324−

325− _ ->

326− return [pattern]

315+ return (starter, args)

327−

328− infics p1 =

329− do (start, o:p, end) <- try (whitespace >> located anyOp)

330− p2 <- (whitespace >> Pattern.term)

331− let opName =

332− if o == '`' then takeWhile (/='`') p else o:p

333− return [ A.at start end (P.Var opName), p1, p2 ]

src/Reporting/Error/Syntax.hs+22

@@ -15,6 +15,8 @@ import qualified Reporting.Report as Report

16data Error

17 = Parse [Parsec.Message]

18+ | BadFunctionName Int

19+ | BadPattern String

18 | InfixDuplicate String

20 | InfixDuplicate String

19 | TypeWithoutDefinition String

21 | TypeWithoutDefinition String

20 | PortWithoutAnnotation String

22 | PortWithoutAnnotation String

@@ -34,6 +36,26 @@ toReport dealiaser err =

34 Parse messages ->

36 Parse messages ->

35 parseErrorReport messages

37 parseErrorReport messages

39+ BadFunctionName arity ->

40+ Report.simple

41+ "BAD FUNCTION DEFINITION"

42+ "Complex patterns cannot be used as function names."

43+ ( "This function definition has " ++ show arity ++ " arguments, but instead of a normal name like\n"

44+ ++ "`add` or `reverse` it has a pattern. There is no way to \"deconstruct\" a\n"

45+ ++ "function with pattern matching, so this needs to be changed to a normal name."

46+ )

47+

48+ BadPattern name ->

49+ Report.simple

50+ "BAD PATTERN"

51+ ("The free variable `" ++ name ++ "` appears more than once in this pattern.")

52+ ( "Rename the variables so there are no duplicates.\n\n"

53+ ++ "In Elm, pattern matching works by binding these free variables to subsections\n"

54+ ++ "of the matching value. It does not make sense to have the same name for two\n"

55+ ++ "different subsections though! When you say `" ++ name ++ "` in some code, there\n"

56+ ++ "is no way for me to know which subsection you mean!"

57+ )

58+

37 InfixDuplicate opName ->

59 InfixDuplicate opName ->

38 Report.simple

60 Report.simple

39 "INFIX OVERLAP"

61 "INFIX OVERLAP"

src/Validate.hs+39−6

@@ -7,7 +7,7 @@ import qualified Data.Set as Set

7import qualified Data.Foldable as F

8import qualified Data.Traversable as T

10−import AST.Expression.General

10+import AST.Expression.General as Expr

11import qualified AST.Expression.Source as Source

12import qualified AST.Expression.Valid as Valid

13import qualified AST.Declaration as D

@@ -92,8 +92,9 @@ defHelp comment (A.A region def) decls =

92 in

93 case def of

94 Source.Definition pat expr ->

95− do expr' <- Validate.expression expr

95+ do expr' <- expression expr

96 let def' = Valid.Definition pat expr' Nothing

97+ checkDefinition def'

97 addRest def' decls

98 addRest def' decls

99 Source.TypeAnnotation name tipe ->

100 Source.TypeAnnotation name tipe ->

@@ -101,8 +102,9 @@ defHelp comment (A.A region def) decls =

101 D.Decl (A.A _ (D.Definition (A.A _

102 D.Decl (A.A _ (D.Definition (A.A _

102 (Source.Definition pat@(A.A _ (Pattern.Var name')) expr)))) : rest

103 (Source.Definition pat@(A.A _ (Pattern.Var name')) expr)))) : rest

103 | name == name' ->

104 | name == name' ->

104− do expr' <- Validate.expression expr

105+ do expr' <- expression expr

105 let def' = Valid.Definition pat expr' (Just tipe)

106 let def' = Valid.Definition pat expr' (Just tipe)

107+ checkDefinition def'

106 addRest def' rest

108 addRest def' rest

107

109

108 _ ->

110 _ ->

@@ -130,7 +132,7 @@ portHelp comment region port decls =

130 case decls of

132 case decls of

131 D.Decl (A.A _ (D.Port (D.PortDefinition name' expr))) : rest

133 D.Decl (A.A _ (D.Port (D.PortDefinition name' expr))) : rest

132 | name == name' ->

134 | name == name' ->

133− do expr' <- Validate.expression expr

135+ do expr' <- expression expr

134 let port' = D.Out name expr' tipe

136 let port' = D.Out name expr' tipe

135 addRest port' rest

137 addRest port' rest

136

138

@@ -157,6 +159,7 @@ definitionsHelp sourceDefs =

157 A.A _ (Source.Definition pat expr) : rest ->

159 A.A _ (Source.Definition pat expr) : rest ->

158 do expr' <- expression expr

160 do expr' <- expression expr

159 let def = Valid.Definition pat expr' Nothing

161 let def = Valid.Definition pat expr' Nothing

162+ checkDefinition def

160 (:) def <$> definitionsHelp rest

163 (:) def <$> definitionsHelp rest

161

164

162 A.A region (Source.TypeAnnotation name tipe) : rest ->

165 A.A region (Source.TypeAnnotation name tipe) : rest ->

@@ -165,12 +168,32 @@ definitionsHelp sourceDefs =

165 | name == name' ->

168 | name == name' ->

166 do expr' <- expression expr

169 do expr' <- expression expr

167 let def = Valid.Definition pat expr' (Just tipe)

170 let def = Valid.Definition pat expr' (Just tipe)

171+ checkDefinition def

168 (:) def <$> definitionsHelp rest'

172 (:) def <$> definitionsHelp rest'

169

173

170 _ ->

174 _ ->

171 Result.throw region (Error.TypeWithoutDefinition name)

175 Result.throw region (Error.TypeWithoutDefinition name)

172

176

173

177

178+checkDefinition :: Valid.Def -> Result.Result wrn Error.Error ()

179+checkDefinition (Valid.Definition pattern body _) =

180+ case fst (Expr.collectLambdas body) of

181+ [] ->

182+ return ()

183+

184+ args ->

185+ case pattern of

186+ A.A _ (Pattern.Var _) ->

187+ return ()

188+

189+ _ ->

190+ let

191+ (A.A start _) = pattern

192+ (A.A end _) = last args

193+ in

194+ Result.throw (R.merge start end) (Error.BadFunctionName (length args))

195+

196+

174-- VALIDATE EXPRESSIONS

197-- VALIDATE EXPRESSIONS

175

198

176expression :: Source.Expr -> Result.Result wrn Error.Error Valid.Expr

199expression :: Source.Expr -> Result.Result wrn Error.Error Valid.Expr

@@ -181,7 +204,9 @@ expression (A.A ann sourceExpression) =

181 return (Var x)

204 return (Var x)

182

205

183 Lambda pattern body ->

206 Lambda pattern body ->

207+ Lambda

208+ <$> validatePattern pattern

184− Lambda pattern <$> expression body

209+ <*> expression body

185

210

186 Binop op leftExpr rightExpr ->

211 Binop op leftExpr rightExpr ->

187 Binop op

212 Binop op

@@ -191,7 +216,7 @@ expression (A.A ann sourceExpression) =

191 Case e branches ->

216 Case e branches ->

192 Case

217 Case

193 <$> expression e

218 <$> expression e

194− <*> T.traverse second branches

219+ <*> T.traverse (\(p,b) -> (,) <$> validatePattern p <*> expression b) branches

195

220

196 Data name args ->

221 Data name args ->

197 Data name <$> T.traverse expression args

222 Data name <$> T.traverse expression args

@@ -267,6 +292,14 @@ both (expr1, expr2) =

267 (,) <$> expression expr1 <*> expression expr2

292 (,) <$> expression expr1 <*> expression expr2

268

293

269

294

295+-- VALIDATE PATTERNS

296+

297+validatePattern :: Pattern.RawPattern -> Result.Result wrn Error.Error Pattern.RawPattern

298+validatePattern pattern =

299+ do detectDuplicates Error.BadPattern (Pattern.boundVars pattern)

300+ return pattern

301+

302+

270-- DETECT DUPLICATES

303-- DETECT DUPLICATES

271

304

272detectDuplicates

305detectDuplicates