779f7aa · elk · git.iko.soy

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

compare with master

unifiedsplit

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

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

54 | Data String [Expr ann def var typ]

55 | Access (Expr ann def var typ) String

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

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

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

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

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

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

60 -- for type checking and code gen only

58 -- for type checking and code gen only

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

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

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

215 Access record field ->

213 Access record field ->

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

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

217

215

218− Remove record field ->

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

220−

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

222− P.braces $

223− P.hsep

224− [ P.pretty dealiaser False record

225− , P.text "-"

226− , P.text oldField

227− , P.text "|"

228− , P.text newField

229− , P.equals

230− , P.pretty dealiaser False expr

231− ]

232−

233− Insert record field expr ->

234− P.braces $

235− P.pretty dealiaser False record

236− <+> P.text "|"

237− <+> P.text field

238− <+> P.equals

239− <+> P.pretty dealiaser False expr

240−

241− Modify record fields ->

216+ Update record fields ->

242 P.braces $

217 P.braces $

243 P.hang

218 P.hang

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

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

src/Canonicalize.hs+2−8

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

337 Access record field ->

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

339

340− Remove record field ->

341− flip Remove field <$> go record

342−

343− Insert record field expr ->

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

345−

346− Modify record fields ->

340+ Update record fields ->

347− Modify

341+ Update

348 <$> go record

342 <$> go record

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

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

350

344

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

@@ -79,14 +79,8 @@ reorder (A.A ann expression) =

79 Access record field ->

80 Access <$> reorder record <*> return field

81

82− Remove record field ->

83− Remove <$> reorder record <*> return field

84−

85− Insert record field expr ->

86− Insert <$> reorder record <*> return field <*> reorder expr

87−

88− Modify record fields ->

82+ Update record fields ->

89− Modify

83+ Update

90 <$> reorder record

84 <$> reorder record

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

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

92

86

src/Generate/JavaScript.hs+1−10

@@ -77,16 +77,7 @@ expression (A.A region expr) =

77 do e' <- expression e

78 return $ DotRef () e' (var (Var.varName field))

79

80− Remove e field ->

81− do e' <- expression e

82− return $ _Utils "remove" `call` [ string (Var.varName field), e' ]

83−

84− Insert e field value ->

85− do value' <- expression value

86− e' <- expression e

87− return $ _Utils "insert" `call` [ string (Var.varName field), value', e' ]

88−

89− Modify e fields ->

80+ Update e fields ->

90 do e' <- expression e

81 do e' <- expression e

91 fields' <-

82 fields' <-

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

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

src/Generate/Substitute.hs+2−8

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

72 Access record field ->

73 Access (f record) field

74

75− Remove record field ->

75+ Update record fields ->

76− Remove (f record) field

77−

78− Insert record field value ->

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

80−

81− Modify record fields ->

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

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

83

77

84 Record fields ->

78 Record fields ->

85 Record (map (second f) fields)

79 Record (map (second f) fields)

src/Parse/Expression.hs+25−50

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

134

135recordTerm :: IParser Source.Expr

136recordTerm =

137− addLocation $

137+ addLocation $ brackets $ choice $

138− brackets (choice [ misc, record ])

139− where

140− record =

141− E.Record <$> commaSep field

142−

143− field =

144− do label <- rLabel

145− patterns <- spacePrefix Pattern.term

146− padded equals

147− body <- expr

148− return (label, makeFunction patterns body)

149−

150− misc =

151− do nextParser <- try miscStarter

152− whitespace

153− nextParser

154−

155− miscStarter =

156− do start <- getMyPosition

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

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

158 whitespace

139 whitespace

159 choice

140 choice

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

141+ [ update starter

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

142+ , literal starter

162 ]

143 ]

144+ , return (E.Record [])

145+ ]

146+ where

147+ update (A.A ann starter) =

148+ do try (string "|")

149+ whitespace

150+ fields <- commaSep1 field

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

163

152

164− afterMinus start record =

153+ literal (A.A _ starter) =

165− do field <- rLabel

154+ do try (string "<-")

166− end <- getMyPosition

167− let subRecord' = E.Remove record field

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

169− case maybe of

170− Nothing ->

171− return subRecord'

172− Just _ ->

173− do whitespace

155+ whitespace

174− field <- rLabel

156+ value <- expr

175− padded equals

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

177−

178− afterBar record =

179− do field <- rLabel

180 whitespace

157 whitespace

181 choice

158 choice

182− [ do equals

159+ [ do try comma

183− whitespace

184− E.Insert record field <$> expr

185− , do leftArrow

186 whitespace

160 whitespace

187− value <- expr

161+ fields <- commaSep field

188− updates <- spaceyPrefixBy comma update

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

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

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

190 ]

164 ]

191

165

192− update =

166+ field =

193− do lbl <- rLabel

167+ do key <- rLabel

194− padded leftArrow

168+ padded (string "<-")

195− (,) lbl <$> expr

169+ value <- expr

170+ return (key, value)

196

171

197

172

198term :: IParser Source.Expr

173term :: IParser Source.Expr

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

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

117 exists $ \t ->

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

119

120− E.Remove expr label ->

121− exists $ \t ->

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

123−

124− E.Insert expr label value ->

125− exists $ \valueType ->

126− exists $ \recordType ->

127− do valueCon <- constrain env value valueType

128− recordCon <- constrain env expr recordType

129− let newRecordType =

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

131− return $ CAnd

132− [ valueCon

133− , recordCon

134− , CEqual Error.Record region tipe newRecordType

135− ]

136−

137− E.Modify expr fields ->

120+ E.Update expr fields ->

138 exists $ \t ->

121 exists $ \t ->

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

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

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

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

src/Validate.hs+2−13

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

221 <$> expression record

222 <*> return field

223

224− Remove record field ->

225− Remove

226− <$> expression record

227− <*> return field

228−

229− Insert record field expr ->

230− Insert

231− <$> expression record

232− <*> return field

233− <*> expression expr

234−

235− Modify record fields ->

224+ Update record fields ->

236− Modify

225+ Update

237 <$> expression record

226 <$> expression record

238 <*> T.traverse second fields

227 <*> T.traverse second fields

239

228