git.iko.soy/elk
on master help sign in
Keep the record name around for record updates

Makes it easier to produce nice type error messages

commit612fc2e8327a997e7e3e549ada5164535566b66e authorEvan Czaplicki <evancz@users.noreply.github.com> dateMon 23 Apr 2018, 00:26 (9 years ago) parent2410b83
5 files changed+10−11
compare with master
unifiedsplit
compiler/src/AST/Canonical.hs+1−1 compiler/src/Canonicalize/Expression.hs+1−1 compiler/src/Nitpick/PatternMatches.hs+1−1 compiler/src/Optimize/Expression.hs+1−1 compiler/src/Type/Constrain/Expression.hs+6−7
compiler/src/AST/Canonical.hs+1−1
@@ -97,7 +97,7 @@ data Expr_
9797 | Case Expr [CaseBranch]
9898 | Accessor N.Name
9999 | Access Expr N.Name
100− | Update Expr (Map.Map N.Name Expr)
100+ | Update N.Name Expr (Map.Map N.Name Expr)
101101 | Record (Map.Map N.Name Expr)
102102 | Unit
103103 | Tuple Expr Expr (Maybe Expr)
compiler/src/Canonicalize/Expression.hs+1−1
@@ -140,7 +140,7 @@ canonicalize env (A.At region expression) =
140140 Valid.Update (A.At reg name) fields ->
141141 do fieldDict <- Dups.checkFields fields
142142 name_ <- findVar reg env name
143− Can.Update (A.At reg name_)
143+ Can.Update name (A.At reg name_)
144144 <$> traverse (canonicalize env) fieldDict
145145
146146 Valid.Record fields ->
compiler/src/Nitpick/PatternMatches.hs+1−1
@@ -329,7 +329,7 @@ checkExpr (A.At region expression) errors =
329329 Can.Access record _ ->
330330 checkExpr record errors
331331
332− Can.Update record fields ->
332+ Can.Update _ record fields ->
333333 checkExpr record $ Map.foldr checkExpr errors fields
334334
335335 Can.Record fields ->
compiler/src/Optimize/Expression.hs+1−1
@@ -150,7 +150,7 @@ optimize cycle (A.At region expression) =
150150 do optRecord <- optimize cycle record
151151 Names.registerField field (Opt.Access optRecord field)
152152
153− Can.Update record updates ->
153+ Can.Update _ record updates ->
154154 Names.registerFieldDict updates Opt.Update
155155 <*> optimize cycle record
156156 <*> traverse (optimize cycle) updates
compiler/src/Type/Constrain/Expression.hs+6−7
@@ -137,8 +137,8 @@ constrain rtv (A.At region expression) expected =
137137 , CEqual region (Access field) fieldType expected
138138 ]
139139
140− Can.Update expr fields ->
141− constrainUpdate rtv region expr fields expected
140+ Can.Update name expr fields ->
141+ constrainUpdate rtv region name expr fields expected
142142
143143 Can.Record fields ->
144144 constrainRecord rtv region fields expected
@@ -406,20 +406,19 @@ constrainField rtv expr =
406406-- CONSTRAIN RECORD UPDATE
407407
408408
409−constrainUpdate :: RTV -> R.Region -> Can.Expr -> Map.Map N.Name Can.Expr -> Expected Type -> IO Constraint
410−constrainUpdate rtv region expr fields expected =
409+constrainUpdate :: RTV -> R.Region -> N.Name -> Can.Expr -> Map.Map N.Name Can.Expr -> Expected Type -> IO Constraint
410+constrainUpdate rtv region name expr fields expected =
411411 do sharedVar <- mkFlexVar
412412 let sharedType = VarN sharedVar
413413
414414 oldVars <- traverse (\_ -> mkFlexVar) fields
415415 let oldTypes = Map.map VarN oldVars
416416 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)
418418
419419 newDict <- traverse (constrainField rtv) fields
420420
421− let getType (_, t, _) = t
422− let newRecordType = RecordN (Map.map getType newDict) sharedType
421+ let newRecordType = RecordN (Map.map (\(_,t,_) -> t) newDict) sharedType
423422 let newCon = CEqual region Record newRecordType expected
424423
425424 let vars = Map.foldr (\(v,_,_) vs -> v:vs) (sharedVar : Map.elems oldVars) newDict