c5efca9 · elk · git.iko.soy

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

compare with master

unifiedsplit

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

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

55 | Data String [Expr ann def var typ]

56 | 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)]

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

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

61 -- for type checking and code gen only

59 -- for type checking and code gen only

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

60 | 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

228 Access record field ->

226 Access record field ->

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

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

230

228

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

255 P.braces $

230 P.braces $

256 P.hang

231 P.hang

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

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

src/Canonicalize.hs+2−8

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

393 Access record field ->

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

395

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

396+ Update record fields ->

403− Modify

397+ Update

404 <$> go record

398 <$> go record

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

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

406

400

src/Canonicalize/Declaration.hs+5−13

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

38 in

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

40

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

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

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

43 where

44 result =

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

46

47 args =

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

48+ map snd fields

49

50− var = loc . E.localVar

50+ vars =

51− vars = take (length args) infiniteArgs

51+ take (length args) infiniteArgs

52−

53− efields =

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

55

52

56 record =

53 record =

57− case ext of

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

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

63

55

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

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

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

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

src/Canonicalize/Sort.hs+2−13

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

84 <$> reorder record

85 <*> return field

86

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

87+ Update record fields ->

99− Modify

88+ Update

100 <$> reorder record

89 <$> reorder record

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

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

102

91

src/Generate/JavaScript.hs+1−10

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

161 do record' <- toJsExpr record

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

163

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

174 do record' <- toJsExpr record

165 do record' <- toJsExpr record

175 fields' <-

166 fields' <-

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

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

src/Nitpick/PatternMatches.hs+1−7

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

159 E.Access record _field ->

160 go record

161

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

169 go record

163 go record

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

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

171

165

src/Optimize/Substitute.hs+2−8

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

75 Access record field ->

76 Access (f record) field

77

78− Remove record field ->

78+ Update record fields ->

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)

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

86

80

87 Record fields ->

81 Record fields ->

88 Record (map (second f) fields)

82 Record (map (second f) fields)

src/Optimize/TailCalls.hs+2−13

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

179 <$> justConvert record

180 <*> pure field

181

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

182+ Update record fields ->

194− Modify

183+ Update

195 <$> justConvert record

184 <$> justConvert record

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

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

197

186

src/Parse/Expression.hs+25−50

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

136

137recordTerm :: IParser Source.Expr

138recordTerm =

139− addLocation $

139+ addLocation $ brackets $ choice $

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)

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

160 whitespace

141 whitespace

161 choice

142 choice

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

143+ [ update starter

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

144+ , literal starter

164 ]

145 ]

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)

165

154

166− afterMinus start record =

155+ literal (A.A _ starter) =

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

156+ do try equals

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

157+ whitespace

179−

158+ value <- expr

180− afterBar record =

181− do field <- rLabel

182 whitespace

159 whitespace

183 choice

160 choice

184− [ do equals

161+ [ do try comma

185 whitespace

162 whitespace

186− E.Insert record field <$> expr

163+ fields <- commaSep field

187− , do leftArrow

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

188− whitespace

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

189− value <- expr

190− updates <- spaceyPrefixBy comma update

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

192 ]

166 ]

193

167

194− update =

168+ field =

195− do lbl <- rLabel

169+ do key <- rLabel

196− padded leftArrow

170+ padded equals

197− (,) lbl <$> expr

171+ value <- expr

172+ return (key, value)

198

173

199

174

200term :: IParser Source.Expr

175term :: IParser Source.Expr

src/Parse/Helpers.hs+1−6

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

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

138

139

140−leftArrow :: IParser String

141−leftArrow =

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

143−

144−

145hasType :: IParser String

140hasType :: IParser String

146hasType =

141hasType =

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

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

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

628 , T.opStart = undefined

623 , T.opStart = undefined

629 , T.opLetter = undefined

624 , T.opLetter = undefined

630 , T.reservedNames = reserveds

625 , T.reservedNames = reserveds

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

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

632 , T.caseSensitive = True

627 , T.caseSensitive = True

633 }

628 }

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

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

118 exists $ \t ->

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

120

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

139 exists $ \t ->

122 exists $ \t ->

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

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

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

124 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) =

223 <$> expression record

224 <*> return field

225

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

226+ Update record fields ->

238− Modify

227+ Update

239 <$> expression record

228 <$> expression record

240 <*> T.traverse second fields

229 <*> T.traverse second fields

241

230