7c3a3fd · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Merge pull request #1070 from elm-lang/dev

7c3a3fdEvan Czaplicki11 years ago

src/Elm/Package.hs+24−20

compare with master

unifiedsplit

@@ -164,26 +164,28 @@ versionToString (Version major minor patch) =

164 show major ++ "." ++ show minor ++ "." ++ show patch

165

166

167−versionFromString :: String -> Maybe Version

167+versionFromString :: String -> Either String Version

168versionFromString string =

169− case splitNumbers string of

169+ case splitNumbers string of

170− Just [major, minor, patch] ->

170+ Just [major, minor, patch] ->

171− Just (Version major minor patch)

171+ Right (Version major minor patch)

172− _ -> Nothing

172+ _ ->

173+ Left "Must have format MAJOR.MINOR.PATCH (e.g. 1.0.2)"

173− where

174+ where

174− splitNumbers :: String -> Maybe [Int]

175+ splitNumbers :: String -> Maybe [Int]

175− splitNumbers ns =

176+ splitNumbers ns =

176− case span Char.isDigit ns of

177+ case span Char.isDigit ns of

177− ("", _) ->

178+ ("", _) ->

178− Nothing

179+ Nothing

179

180

180− (numbers, []) ->

181+ (numbers, []) ->

181− Just [ read numbers ]

182+ Just [ read numbers ]

182

183

183− (numbers, '.':rest) ->

184+ (numbers, '.':rest) ->

184− (read numbers :) <$> splitNumbers rest

185+ (read numbers :) <$> splitNumbers rest

185

186

187+ _ ->

186− _ -> Nothing

188+ Nothing

187

189

188

190

189instance Binary Version where

191instance Binary Version where

@@ -198,11 +200,13 @@ instance FromJSON Version where

198 parseJSON (String text) =

200 parseJSON (String text) =

199 let string = T.unpack text in

201 let string = T.unpack text in

200 case versionFromString string of

202 case versionFromString string of

203+ Right v ->

201− Just v -> return v

204+ return v

202− Nothing ->

205+

206+ Left problem ->

203 fail $ unlines

207 fail $ unlines

204− [ "Dependency file has an invalid version number: " ++ string

208+ [ "Ran into an invalid version number: " ++ string

205− , "Must have format MAJOR.MINOR.PATCH (e.g. 0.1.2)"

209+ , problem

206 ]

210 ]

207

211

208 parseJSON _ =

212 parseJSON _ =

src/Parse/Expression.hs+8−32

@@ -103,7 +103,7 @@ parensTerm =

103 A.at start end (E.rawVar x)

104

105 opFn =

106− do (start, op, end) <- located anyOp

106+ do (start, op, end) <- located symOp

107 return $

108 lambda start end "x" $

109 lambda start end "y" $

@@ -249,19 +249,13 @@ caseExpr =

249 e <- padded expr

250 reserved "of"

251 whitespace

252− E.Case e <$> (with <|> without)

252+ E.Case e <$> block (do c <- case_ ; whitespace ; return c)

253 where

254 case_ =

255 do p <- Pattern.expr

256 padded rightArrow

257 (,) p <$> expr

258

259− with =

260− brackets (semiSep1 (case_ <?> "cases { x -> ... }"))

261−

262− without =

263− block (do c <- case_ ; whitespace ; return c)

264−

265

259

266-- LET

260-- LET

267

261

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

296definition =

290definition =

297 addLocation $

291 addLocation $

298 withPos $

292 withPos $

299− do (name:args) <- defStart

293+ do (name, args) <- defStart

300 padded equals

294 padded equals

301 body <- expr

295 body <- expr

302 return . Source.Definition name $ makeFunction args body

296 return . Source.Definition name $ makeFunction args body

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

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

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

308

302

309

303

310−defStart :: IParser [P.RawPattern]

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

311defStart =

305defStart =

312− choice

306+ 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)

307+ 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

308+ args <- spacePrefix Pattern.term

324−

325− _ ->

326− return [pattern]

309+ 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/Parse/Helpers.hs+3−3

@@ -119,7 +119,7 @@ anyOp =

119symOp :: IParser String

120symOp =

121 do op <- many1 (satisfy Help.isSymbol)

122− guard (op `notElem` [ "=", "..", "->", "--", "|", "\8594", ":" ])

122+ guard (op `notElem` [ "=", "..", "->", "--", "|", ":" ])

123 case op of

124 "." -> notFollowedBy lower >> return op

125 _ -> return op

@@ -129,12 +129,12 @@ symOp =

129

130equals :: IParser String

131equals =

132− string "=" <?> "="

132+ string "=" <?> "an equals sign '='"

133

134

135rightArrow :: IParser String

136rightArrow =

137− string "->" <|> string "\8594" <?> "->"

137+ string "->" <?> "an arrow '->'"

138

139

140hasType :: IParser String

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