c5efca9 · elk · git.iko.soy

git.iko.soy/elk

Merge branch 'simpler-records'

Conflicts: src/Canonicalize/Sort.hs src/Generate/JavaScript.hs

commitc5efca9ab11b3acfe279b306e96f63f1a822da51 authorEvan Czaplicki <info@elm-lang.org> dateThu 27 Aug 2015, 17:21 (11 years ago) parentc643514 446c784

12 files changed+46−186

compare with master

unifiedsplit

src/AST/Expression/General.hs+2−27 src/Canonicalize.hs+2−8 src/Canonicalize/Declaration.hs+5−13 src/Canonicalize/Sort.hs+2−13 src/Generate/JavaScript.hs+1−10 src/Nitpick/PatternMatches.hs+1−7 src/Optimize/Substitute.hs+2−8 src/Optimize/TailCalls.hs+2−13 src/Parse/Expression.hs+25−50 src/Parse/Helpers.hs+1−6 src/Type/Constrain/Expression.hs+1−18 src/Validate.hs+2−13

src/AST/Expression/General.hs+2−27

@@ -54,9 +54,7 @@ data Expr' ann def var typ

5454 | Case (Expr ann def var typ) [(Pattern.Pattern ann var, Expr ann def var typ)]

5555 | Data String [Expr ann def var typ]

5656 | Access (Expr ann def var typ) String

57− | Remove (Expr ann def var typ) String

58− | Insert (Expr ann def var typ) String (Expr ann def var typ)

59− | Modify (Expr ann def var typ) [(String, Expr ann def var typ)]

57+ | Update (Expr ann def var typ) [(String, Expr ann def var typ)]

6058 | Record [(String, Expr ann def var typ)]

6159 -- for type checking and code gen only

6260 | Port (PortImpl (Expr ann def var typ) typ)

@@ -228,30 +226,7 @@ instance (P.Pretty def, P.Pretty var, Var.ToString var) => P.Pretty (Expr' ann d

228226 Access record field ->

229227 P.pretty dealiaser True record <> P.text "." <> P.text field

230228

231− Remove record field ->

232− P.braces (P.pretty dealiaser False record <+> P.text "-" <+> P.text field)

233−

234− Insert (A.A _ (Remove record oldField)) newField expr ->

235− P.braces $

236− P.hsep

237− [ P.pretty dealiaser False record

238− , P.text "-"

239− , P.text oldField

240− , P.text "|"

241− , P.text newField

242− , P.equals

243− , P.pretty dealiaser False expr

244− ]

245−

246− Insert record field expr ->

247− P.braces $

248− P.pretty dealiaser False record

249− <+> P.text "|"

250− <+> P.text field

251− <+> P.equals

252− <+> P.pretty dealiaser False expr

253−

254− Modify record fields ->

229+ Update record fields ->

255230 P.braces $

256231 P.hang

257232 (P.pretty dealiaser False record <+> P.text "|")

src/Canonicalize.hs+2−8

@@ -393,14 +393,8 @@ expression env (A.A region validExpr) =

393393 Access record field ->

394394 Access <$> go record <*> Result.ok field

395395

396− Remove record field ->

397− flip Remove field <$> go record

398−

399− Insert record field expr ->

400− flip Insert field <$> go record <*> go expr

401−

402− Modify record fields ->

403− Modify

396+ Update record fields ->

397+ Update

404398 <$> go record

405399 <*> T.traverse (\(field,expr) -> (,) field <$> go expr) fields

406400

src/Canonicalize/Declaration.hs+5−13

@@ -38,28 +38,20 @@ toDefs moduleName (A.A (region,_) decl) =

3838 in

3939 [ definition ctor (buildFunction body vars) region (foldr T.Lambda tbody tipes) ]

4040

41− D.TypeAlias name tvars tipe@(T.Record fields ext) ->

41+ D.TypeAlias name tvars tipe@(T.Record fields Nothing) ->

4242 [ definition name (buildFunction record vars) region (foldr T.Lambda result args) ]

4343 where

4444 result =

4545 T.Aliased (typeVar name) (zip tvars (map T.Var tvars)) (T.Holey tipe)

4646

4747 args =

48− map snd fields ++ maybe [] (:[]) ext

48+ map snd fields

4949

50− var = loc . E.localVar

51− vars = take (length args) infiniteArgs

52−

53− efields =

54− zip (map fst fields) (map var vars)

50+ vars =

51+ take (length args) infiniteArgs

5552

5653 record =

57− case ext of

58− Nothing ->

59− loc (E.Record efields)

60−

61− Just _ ->

62− foldl (\r (f,v) -> loc (E.Insert r f v)) (var (last vars)) efields

54+ loc (E.Record (zip (map fst fields) (map (loc . E.localVar) vars)))

6355

6456 -- Type aliases must be added to an extended equality dictionary,

6557 -- but they do not require any basic constraints.

src/Canonicalize/Sort.hs+2−13

@@ -84,19 +84,8 @@ reorder (A.A ann expression) =

8484 <$> reorder record

8585 <*> return field

8686

87− Remove record field ->

88− Remove

89− <$> reorder record

90− <*> return field

91−

92− Insert record field expr ->

93− Insert

94− <$> reorder record

95− <*> return field

96− <*> reorder expr

97−

98− Modify record fields ->

99− Modify

87+ Update record fields ->

88+ Update

10089 <$> reorder record

10190 <*> mapM (\(field,expr) -> (,) field <$> reorder expr) fields

10291

src/Generate/JavaScript.hs+1−10

@@ -161,16 +161,7 @@ exprToCode tcc annotatedExpr@(A.A _ expr) =

161161 do record' <- toJsExpr record

162162 jsExpr $ DotRef () record' (var (Var.varName field))

163163

164− Remove record field ->

165− do record' <- toJsExpr record

166− jsExpr $ _Utils "remove" `call` [ string (Var.varName field), record' ]

167−

168− Insert record field value ->

169− do value' <- toJsExpr value

170− record' <- toJsExpr record

171− jsExpr $ _Utils "insert" `call` [ string (Var.varName field), value', record' ]

172−

173− Modify record fields ->

164+ Update record fields ->

174165 do record' <- toJsExpr record

175166 fields' <-

176167 forM fields $ \(field, value) ->

src/Nitpick/PatternMatches.hs+1−7

@@ -159,13 +159,7 @@ checkExpression tagDict (A.A region expression) =

159159 E.Access record _field ->

160160 go record

161161

162− E.Remove record _field ->

163− go record

164−

165− E.Insert record _field value ->

166− go2 record value

167−

168− E.Modify record fields ->

162+ E.Update record fields ->

169163 go record

170164 <* F.traverse_ (go . snd) fields

171165

src/Optimize/Substitute.hs+2−8

@@ -75,14 +75,8 @@ subst old new expression =

7575 Access record field ->

7676 Access (f record) field

7777

78− Remove record field ->

79− Remove (f record) field

80−

81− Insert record field value ->

82− Insert (f record) field (f value)

83−

84− Modify record fields ->

85− Modify (f record) (map (second f) fields)

78+ Update record fields ->

79+ Update (f record) (map (second f) fields)

8680

8781 Record fields ->

8882 Record (map (second f) fields)

src/Optimize/TailCalls.hs+2−13

@@ -179,19 +179,8 @@ findTailCalls context annExpr@(A.A _ expression) =

179179 <$> justConvert record

180180 <*> pure field

181181

182− Remove record field ->

183− Remove

184− <$> justConvert record

185− <*> pure field

186−

187− Insert record field expr ->

188− Insert

189− <$> justConvert record

190− <*> pure field

191− <*> justConvert expr

192−

193− Modify record fields ->

194− Modify

182+ Update record fields ->

183+ Update

195184 <$> justConvert record

196185 <*> T.traverse (mapSnd justConvert) fields

197186

src/Parse/Expression.hs+25−50

@@ -136,65 +136,40 @@ parensTerm =

136136

137137recordTerm :: IParser Source.Expr

138138recordTerm =

139− addLocation $

140− brackets (choice [ misc, record ])

141− where

142− record =

143− E.Record <$> commaSep field

144−

145− field =

146− do label <- rLabel

147− patterns <- spacePrefix Pattern.term

148− padded equals

149− body <- expr

150− return (label, makeFunction patterns body)

151−

152− misc =

153− do nextParser <- try miscStarter

154− whitespace

155− nextParser

156−

157− miscStarter =

158− do start <- getMyPosition

159− record <- addLocation (E.rawVar <$> rLabel)

139+ addLocation $ brackets $ choice $

140+ [ do starter <- try (addLocation rLabel)

160141 whitespace

161142 choice

162− [ string "-" >> return (afterMinus start record)

163− , string "|" >> return (afterBar record)

143+ [ update starter

144+ , literal starter

164145 ]

146+ , return (E.Record [])

147+ ]

148+ where

149+ update (A.A ann starter) =

150+ do try (string "|")

151+ whitespace

152+ fields <- commaSep1 field

153+ return (E.Update (A.A ann (E.rawVar starter)) fields)

165154

166− afterMinus start record =

167− do field <- rLabel

168− end <- getMyPosition

169− let subRecord' = E.Remove record field

170− maybe <- optionMaybe (try (whitespace >> string "|"))

171− case maybe of

172− Nothing ->

173− return subRecord'

174− Just _ ->

175− do whitespace

176− field <- rLabel

177− padded equals

178− E.Insert (A.at start end subRecord') field <$> expr

179−

180− afterBar record =

181− do field <- rLabel

155+ literal (A.A _ starter) =

156+ do try equals

157+ whitespace

158+ value <- expr

182159 whitespace

183160 choice

184− [ do equals

161+ [ do try comma

185162 whitespace

186− E.Insert record field <$> expr

187− , do leftArrow

188− whitespace

189− value <- expr

190− updates <- spaceyPrefixBy comma update

191− return (E.Modify record ((field,value) : updates))

163+ fields <- commaSep field

164+ return (E.Record ((starter, value) : fields))

165+ , return (E.Record [(starter, value)])

192166 ]

193167

194− update =

195− do lbl <- rLabel

196− padded leftArrow

197− (,) lbl <$> expr

168+ field =

169+ do key <- rLabel

170+ padded equals

171+ value <- expr

172+ return (key, value)

198173

199174

200175term :: IParser Source.Expr

src/Parse/Helpers.hs+1−6

@@ -137,11 +137,6 @@ rightArrow =

137137 string "->" <|> string "\8594" <?> "->"

138138

139139

140−leftArrow :: IParser String

141−leftArrow =

142− string "<-" <?> "<- for a record update"

143−

144−

145140hasType :: IParser String

146141hasType =

147142 string ":" <?> "the \"has type\" symbol ':'"

@@ -628,6 +623,6 @@ processAs processor s =

628623 , T.opStart = undefined

629624 , T.opLetter = undefined

630625 , T.reservedNames = reserveds

631− , T.reservedOpNames = [":", "->", "<-", "|"]

626+ , T.reservedOpNames = [":", "->", "|"]

632627 , T.caseSensitive = True

633628 }

src/Type/Constrain/Expression.hs+1−18

@@ -118,24 +118,7 @@ constrain env annotatedExpr@(A.A region expression) tipe =

118118 exists $ \t ->

119119 constrain env expr (record (Map.singleton label [tipe]) t)

120120

121− E.Remove expr label ->

122− exists $ \t ->

123− constrain env expr (record (Map.singleton label [t]) tipe)

124−

125− E.Insert expr label value ->

126− exists $ \valueType ->

127− exists $ \recordType ->

128− do valueCon <- constrain env value valueType

129− recordCon <- constrain env expr recordType

130− let newRecordType =

131− record (Map.singleton label [valueType]) recordType

132− return $ CAnd

133− [ valueCon

134− , recordCon

135− , CEqual Error.Record region tipe newRecordType

136− ]

137−

138− E.Modify expr fields ->

121+ E.Update expr fields ->

139122 exists $ \t ->

140123 do oldVars <- Monad.forM fields $ \_ -> variable Flexible

141124 let oldFields = ST.fieldMap (zip (map fst fields) (map varN oldVars))

src/Validate.hs+2−13

@@ -223,19 +223,8 @@ expression (A.A ann sourceExpression) =

223223 <$> expression record

224224 <*> return field

225225

226− Remove record field ->

227− Remove

228− <$> expression record

229− <*> return field

230−

231− Insert record field expr ->

232− Insert

233− <$> expression record

234− <*> return field

235− <*> expression expr

236−

237− Modify record fields ->

238− Modify

226+ Update record fields ->

227+ Update

239228 <$> expression record

240229 <*> T.traverse second fields

241230