git.iko.soy/elk
on master help sign in
Make it so record update syntax cannot change field types

This allows much more specific error messages for record updates. Say I have an expression { r | x = v } and I know the type of r for some reason: 1) I can detect if x exists and underline it if not with some nice hints 2) I can detect if (v : t1) matches (r.x : t2) and underline v directly if not I still need to do work on getting record types to show up in reasonable ways when they do not match. What to highlight? What to leave out? Etc. I also need to work on generating suggestions in a nice way.

commitf91c6d0b43a3c95ec42fe441ae8df4273c01085e authorEvan Czaplicki <evancz@users.noreply.github.com> dateMon 23 Apr 2018, 15:49 (9 years ago) parent2b526d3
8 files changed+110−52
compare with master
unifiedsplit
compiler/src/AST/Canonical.hs+6−1 compiler/src/Canonicalize/Environment/Dups.hs+11 compiler/src/Canonicalize/Expression.hs+7−4 compiler/src/Nitpick/PatternMatches.hs+10−1 compiler/src/Optimize/Expression.hs+10−1 compiler/src/Reporting/Error/Type.hs+48−30 compiler/src/Type/Constrain/Expression.hs+16−13 compiler/src/Type/Error.hs+2−2
compiler/src/AST/Canonical.hs+6−1
@@ -3,6 +3,7 @@
33module AST.Canonical
44 ( Expr, Expr_(..)
55 , CaseBranch(..)
6+ , FieldUpdate(..)
67 , CtorOpts(..)
78 -- definitions
89 , Def(..)
@@ -97,7 +98,7 @@ data Expr_
9798 | Case Expr [CaseBranch]
9899 | Accessor N.Name
99100 | Access Expr N.Name
100− | Update N.Name Expr (Map.Map N.Name Expr)
101+ | Update N.Name Expr (Map.Map N.Name FieldUpdate)
101102 | Record (Map.Map N.Name Expr)
102103 | Unit
103104 | Tuple Expr Expr (Maybe Expr)
@@ -108,6 +109,10 @@ data CaseBranch =
108109 CaseBranch Pattern Expr
109110
110111
112+data FieldUpdate =
113+ FieldUpdate R.Region Expr
114+
115+
111116
112117-- DEFS
113118
compiler/src/Canonicalize/Environment/Dups.hs+11
@@ -3,6 +3,7 @@
33module Canonicalize.Environment.Dups
44 ( detect
55 , checkFields
6+ , checkFields'
67 , Dict
78 , none
89 , one
@@ -76,6 +77,16 @@ addField (A.At region name, value) dups =
7677 Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dups
7778
7879
80+checkFields' :: (R.Region -> a -> b) -> [(A.Located N.Name, a)] -> Result.Result i w Error.Error (Map.Map N.Name b)
81+checkFields' toValue fields =
82+ detect Error.DuplicateField (foldr (addField' toValue) none fields)
83+
84+
85+addField' :: (R.Region -> a -> b) -> (A.Located N.Name, a) -> Dict b -> Dict b
86+addField' toValue (A.At region name, value) dups =
87+ Map.insertWith OneOrMore.more name (OneOrMore.one (Info region (toValue region value))) dups
88+
89+
7990
8091-- BUILDING DICTIONARIES
8192
compiler/src/Canonicalize/Expression.hs+7−4
@@ -138,10 +138,13 @@ canonicalize env (A.At region expression) =
138138 <*> Result.ok field
139139
140140 Valid.Update (A.At reg name) fields ->
141− do fieldDict <- Dups.checkFields fields
142− name_ <- findVar reg env name
143− Can.Update name (A.At reg name_)
144− <$> traverse (canonicalize env) fieldDict
141+ let
142+ makeCanFields =
143+ Dups.checkFields' (\r t -> Can.FieldUpdate r <$> canonicalize env t) fields
144+ in
145+ Can.Update name
146+ <$> (A.At reg <$> findVar reg env name)
147+ <*> (sequenceA =<< makeCanFields)
145148
146149 Valid.Record fields ->
147150 do fieldDict <- Dups.checkFields fields
compiler/src/Nitpick/PatternMatches.hs+10−1
@@ -330,7 +330,7 @@ checkExpr (A.At region expression) errors =
330330 checkExpr record errors
331331
332332 Can.Update _ record fields ->
333− checkExpr record $ Map.foldr checkExpr errors fields
333+ checkExpr record $ Map.foldr checkField errors fields
334334
335335 Can.Record fields ->
336336 Map.foldr checkExpr errors fields
@@ -353,6 +353,15 @@ checkExpr (A.At region expression) errors =
353353
354354
355355
356+-- CHECK FIELD
357+
358+
359+checkField :: Can.FieldUpdate -> [Error] -> [Error]
360+checkField (Can.FieldUpdate _ expr) errors =
361+ checkExpr expr errors
362+
363+
364+
356365-- CHECK IF BRANCH
357366
358367
compiler/src/Optimize/Expression.hs+10−1
@@ -153,7 +153,7 @@ optimize cycle (A.At region expression) =
153153 Can.Update _ record updates ->
154154 Names.registerFieldDict updates Opt.Update
155155 <*> optimize cycle record
156− <*> traverse (optimize cycle) updates
156+ <*> traverse (optimizeUpdate cycle) updates
157157
158158 Can.Record fields ->
159159 Names.registerFieldDict fields Opt.Record
@@ -173,6 +173,15 @@ optimize cycle (A.At region expression) =
173173
174174
175175
176+-- UPDATE
177+
178+
179+optimizeUpdate :: Cycle -> Can.FieldUpdate -> Names.Tracker Opt.Expr
180+optimizeUpdate cycle (Can.FieldUpdate _ expr) =
181+ optimize cycle expr
182+
183+
184+
176185-- DEFINITION
177186
178187
compiler/src/Reporting/Error/Type.hs+48−30
@@ -26,6 +26,7 @@ import Data.Monoid ((<>))
2626import qualified AST.Canonical as Can
2727import qualified Data.Index as Index
2828import qualified Elm.Name as N
29+import qualified Reporting.Annotation as A
2930import qualified Reporting.Doc as D
3031import qualified Reporting.Region as R
3132import qualified Reporting.Render.Code as Code
@@ -66,7 +67,8 @@ data Context
6667 | CallArity MaybeName Int
6768 | CallArg MaybeName Index.ZeroBased
6869 | RecordAccess N.Name
69− | RecordUpdate N.Name (Map.Map N.Name Can.Expr)
70+ | RecordUpdateKeys N.Name (Map.Map N.Name Can.FieldUpdate)
71+ | RecordUpdateValue N.Name
7072 | Destructure
7173
7274
@@ -384,7 +386,7 @@ addCategory thisIs category maybeAlias =
384386 let
385387 definitely whatever =
386388 case maybeAlias of
387− Just alias -> " a `" <> N.toString alias <> "` value:"
389+ Just alias -> " a `" <> N.toString alias <> "`:"
388390 Nothing -> whatever
389391 in
390392 D.reflow $
@@ -701,6 +703,10 @@ toExprReport source localizer exprRegion category tipe expected =
701703 ( D.reflow problem
702704 , loneType localizer tipe expectedType (addCategory thisIs category) furtherDetails
703705 )
706+
707+ custom maybeHighlight docPair =
708+ Report.Report "TYPE MISMATCH" exprRegion [] $
709+ Report.toCodeSnippet source region maybeHighlight docPair
704710 in
705711 case context of
706712 ListEntry index ->
@@ -731,18 +737,16 @@ toExprReport source localizer exprRegion category tipe expected =
731737 )
732738
733739 OpLeft op ->
734− Report.Report "TYPE MISMATCH" exprRegion [] $
735− Report.toCodeSnippet source region (Just exprRegion) $
736− opLeftToDocs localizer category op tipe expectedType
740+ custom (Just exprRegion) $
741+ opLeftToDocs localizer category op tipe expectedType
737742
738743 OpRight op ->
739− Report.Report "TYPE MISMATCH" exprRegion [] $
740− case opRightToDocs localizer category op tipe expectedType of
741− EmphBoth details ->
742− Report.toCodeSnippet source region Nothing details
744+ case opRightToDocs localizer category op tipe expectedType of
745+ EmphBoth details ->
746+ custom Nothing details
743747
744− EmphRight details ->
745− Report.toCodeSnippet source region (Just exprRegion) details
748+ EmphRight details ->
749+ custom (Just exprRegion) details
746750
747751 IfCondition ->
748752 badType
@@ -862,34 +866,43 @@ toExprReport source localizer exprRegion category tipe expected =
862866 ]
863867 )
864868
865− RecordUpdate name updatedFields ->
866− badType $
869+ RecordUpdateKeys record expectedFields ->
867870 case T.getFields tipe of
868871 Nothing ->
872+ badType
869873 ( Just exprRegion
870− , "I cannot update the `" <> N.toString name <> "` value:"
874+ , "This is not a record, so it has no fields to update!"
871875 , "It is"
872− , [ D.reflow $ "It is not a record. It has no fields to update!"
876+ , [ D.reflow $ "But I need a record!"
873877 ]
874878 )
875879
876− Just _fields ->
877− case Map.keys updatedFields of
878− [field] ->
879− ( Nothing
880− , "The `" <> N.toString name <> "` record does not have a `" <> N.toString field <> "` field."
881− , "It is"
882− , [ -- TODO suggest what the typo is!
880+ Just actualFields ->
881+ case Map.foldrWithKey addLocatedField [] (Map.difference expectedFields actualFields) of
882+ [] ->
883+ error "TODO RecordUpdateKeys"
884+
885+ A.At fieldRegion field : _ ->
886+ badType
887+ ( Just fieldRegion
888+ , "The `" <> N.toString record <> "` record does not have a `" <> N.toString field <> "` field:"
889+ , "The `" <> N.toString record <> "` is"
890+ , [ D.reflow $ "So maybe you want one of these fields instead? TODO make suggestions!"
891+ -- TODO suggest what the typo is!
883892 ]
884893 )
885894
886− _ ->
887− ( Nothing
888− , "The `" <> N.toString name <> "` record does have all of these fields:"
889− , "It is"
890− , [ -- TODO suggest what the typo is!
891− ]
892− )
895+ RecordUpdateValue field ->
896+ mismatch
897+ ( Just exprRegion
898+ , "I cannot update the `" <> N.toString field <> "` field like this:"
899+ , "You are trying to update `" <> N.toString field <> "` to be"
900+ , singular "But it should be"
901+ , [ D.toSimpleNote
902+ "The record update syntax does not allow you to change the type of fields.\
903+ \ You can achieve that with record constructors or the record literal syntax."
904+ ]
905+ )
893906
894907 Destructure ->
895908 mismatch
@@ -902,7 +915,7 @@ toExprReport source localizer exprRegion category tipe expected =
902915
903916
904917
905−-- COUNT ARGS
918+-- HELPERS
906919
907920
908921countArgs :: T.Type -> Int
@@ -915,6 +928,11 @@ countArgs tipe =
915928 0
916929
917930
931+addLocatedField :: N.Name -> Can.FieldUpdate -> [A.Located N.Name] -> [A.Located N.Name]
932+addLocatedField name (Can.FieldUpdate region _) names =
933+ A.At region name : names
934+
935+
918936
919937-- OP LEFT
920938
compiler/src/Type/Constrain/Expression.hs+16−13
@@ -406,25 +406,28 @@ constrainField rtv expr =
406406-- CONSTRAIN RECORD UPDATE
407407
408408
409−constrainUpdate :: RTV -> R.Region -> N.Name -> 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.FieldUpdate -> Expected Type -> IO Constraint
410410constrainUpdate rtv region name expr fields expected =
411− do sharedVar <- mkFlexVar
412− let sharedType = VarN sharedVar
411+ do extVar <- mkFlexVar
412+ fieldDict <- Map.traverseWithKey (constrainUpdateField rtv region) fields
413413
414− oldVars <- traverse (\_ -> mkFlexVar) fields
415− let oldTypes = Map.map VarN oldVars
416− let oldRecordType = RecordN oldTypes sharedType
417− oldCon <- constrain rtv expr (FromContext region (RecordUpdate name fields) oldRecordType)
414+ let recordType = RecordN (Map.map (\(_,t,_) -> t) fieldDict) (VarN extVar)
415+ let recordCon = CEqual region Record recordType expected
416+
417+ let vars = Map.foldr (\(v,_,_) vs -> v:vs) [extVar] fieldDict
418+ let cons = Map.foldr (\(_,_,c) cs -> c:cs) [recordCon] fieldDict
418419
419− newDict <- traverse (constrainField rtv) fields
420+ con <- constrain rtv expr (FromContext region (RecordUpdateKeys name fields) recordType)
420421
421− let newRecordType = RecordN (Map.map (\(_,t,_) -> t) newDict) sharedType
422− let newCon = CEqual region Record newRecordType expected
422+ return $ exists vars $ CAnd (con:cons)
423423
424− let vars = Map.foldr (\(v,_,_) vs -> v:vs) (sharedVar : Map.elems oldVars) newDict
425− let cons = Map.foldr (\(_,_,c) cs -> c:cs) [newCon] newDict
426424
427− return $ exists vars (CAnd (oldCon:cons))
425+constrainUpdateField :: RTV -> R.Region -> N.Name -> Can.FieldUpdate -> IO (Variable, Type, Constraint)
426+constrainUpdateField rtv region field (Can.FieldUpdate _ expr) =
427+ do var <- mkFlexVar
428+ let tipe = VarN var
429+ con <- constrain rtv expr (FromContext region (RecordUpdateValue field) tipe)
430+ return (var, tipe, con)
428431
429432
430433
compiler/src/Type/Error.hs+2−2
@@ -73,14 +73,14 @@ iteratedDealias tipe =
7373 tipe
7474
7575
76−getFields :: Type -> Maybe [N.Name]
76+getFields :: Type -> Maybe (Map.Map N.Name Type)
7777getFields tipe =
7878 case tipe of
7979 Alias _ _ _ real ->
8080 getFields real
8181
8282 Record fields _ ->
83− Just (Map.keys fields)
83+ Just fields
8484
8585 _ ->
8686 Nothing