git.iko.soy/elk
on master help sign in
Keep the record name around for record updates
612fc2eEvan Czaplicki
compiler/src/AST/Canonical.hs+1−1
compare with master
unifiedsplit
@@ -97,7 +97,7 @@ data Expr_
97 | Case Expr [CaseBranch]
97 | Case Expr [CaseBranch]
98 | Accessor N.Name
98 | Accessor N.Name
99 | Access Expr N.Name
99 | Access Expr N.Name
100− | Update Expr (Map.Map N.Name Expr)
100+ | Update N.Name Expr (Map.Map N.Name Expr)
101 | Record (Map.Map N.Name Expr)
101 | Record (Map.Map N.Name Expr)
102 | Unit
102 | Unit
103 | Tuple Expr Expr (Maybe Expr)
103 | Tuple Expr Expr (Maybe Expr)
compiler/src/Canonicalize/Expression.hs+1−1
@@ -140,7 +140,7 @@ canonicalize env (A.At region expression) =
140 Valid.Update (A.At reg name) fields ->
140 Valid.Update (A.At reg name) fields ->
141 do fieldDict <- Dups.checkFields fields
141 do fieldDict <- Dups.checkFields fields
142 name_ <- findVar reg env name
142 name_ <- findVar reg env name
143− Can.Update (A.At reg name_)
143+ Can.Update name (A.At reg name_)
144 <$> traverse (canonicalize env) fieldDict
144 <$> traverse (canonicalize env) fieldDict
145
145
146 Valid.Record fields ->
146 Valid.Record fields ->
compiler/src/Nitpick/PatternMatches.hs+1−1
@@ -329,7 +329,7 @@ checkExpr (A.At region expression) errors =
329 Can.Access record _ ->
329 Can.Access record _ ->
330 checkExpr record errors
330 checkExpr record errors
331
331
332− Can.Update record fields ->
332+ Can.Update _ record fields ->
333 checkExpr record $ Map.foldr checkExpr errors fields
333 checkExpr record $ Map.foldr checkExpr errors fields
334
334
335 Can.Record fields ->
335 Can.Record fields ->
compiler/src/Optimize/Expression.hs+1−1
@@ -150,7 +150,7 @@ optimize cycle (A.At region expression) =
150 do optRecord <- optimize cycle record
150 do optRecord <- optimize cycle record
151 Names.registerField field (Opt.Access optRecord field)
151 Names.registerField field (Opt.Access optRecord field)
152
152
153− Can.Update record updates ->
153+ Can.Update _ record updates ->
154 Names.registerFieldDict updates Opt.Update
154 Names.registerFieldDict updates Opt.Update
155 <*> optimize cycle record
155 <*> optimize cycle record
156 <*> traverse (optimize cycle) updates
156 <*> traverse (optimize cycle) updates
compiler/src/Type/Constrain/Expression.hs+6−7
@@ -137,8 +137,8 @@ constrain rtv (A.At region expression) expected =
137 , CEqual region (Access field) fieldType expected
137 , CEqual region (Access field) fieldType expected
138 ]
138 ]
139
139
140− Can.Update expr fields ->
140+ Can.Update name expr fields ->
141− constrainUpdate rtv region expr fields expected
141+ constrainUpdate rtv region name expr fields expected
142
142
143 Can.Record fields ->
143 Can.Record fields ->
144 constrainRecord rtv region fields expected
144 constrainRecord rtv region fields expected
@@ -406,20 +406,19 @@ constrainField rtv expr =
406-- CONSTRAIN RECORD UPDATE
406-- CONSTRAIN RECORD UPDATE
407
407
408
408
409−constrainUpdate :: RTV -> R.Region -> Can.Expr -> Map.Map N.Name Can.Expr -> Expected Type -> IO Constraint
409+constrainUpdate :: RTV -> R.Region -> N.Name -> Can.Expr -> Map.Map N.Name Can.Expr -> Expected Type -> IO Constraint
410−constrainUpdate rtv region expr fields expected =
410+constrainUpdate rtv region name expr fields expected =
411 do sharedVar <- mkFlexVar
411 do sharedVar <- mkFlexVar
412 let sharedType = VarN sharedVar
412 let sharedType = VarN sharedVar
413
413
414 oldVars <- traverse (\_ -> mkFlexVar) fields
414 oldVars <- traverse (\_ -> mkFlexVar) fields
415 let oldTypes = Map.map VarN oldVars
415 let oldTypes = Map.map VarN oldVars
416 let oldRecordType = RecordN oldTypes sharedType
416 let oldRecordType = RecordN oldTypes sharedType
417− oldCon <- constrain rtv expr (FromContext region RecordUpdate oldRecordType)
417+ oldCon <- constrain rtv expr (FromContext region (RecordUpdate name fields) oldRecordType)
418
418
419 newDict <- traverse (constrainField rtv) fields
419 newDict <- traverse (constrainField rtv) fields
420
420
421− let getType (_, t, _) = t
422− let newRecordType = RecordN (Map.map getType newDict) sharedType
421+ let newRecordType = RecordN (Map.map (\(_,t,_) -> t) newDict) sharedType
423 let newCon = CEqual region Record newRecordType expected
422 let newCon = CEqual region Record newRecordType expected
424
423
425 let vars = Map.foldr (\(v,_,_) vs -> v:vs) (sharedVar : Map.elems oldVars) newDict
424 let vars = Map.foldr (\(v,_,_) vs -> v:vs) (sharedVar : Map.elems oldVars) newDict