f91c6d0 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Make it so record update syntax cannot change field types

f91c6d0Evan Czaplicki9 years ago

compiler/src/AST/Canonical.hs+6−1

compare with master

unifiedsplit

@@ -3,6 +3,7 @@

3module AST.Canonical

4 ( Expr, Expr_(..)

5 , CaseBranch(..)

6+ , FieldUpdate(..)

6 , CtorOpts(..)

7 , CtorOpts(..)

7 -- definitions

8 -- definitions

8 , Def(..)

9 , Def(..)

@@ -97,7 +98,7 @@ data Expr_

97 | Case Expr [CaseBranch]

98 | Case Expr [CaseBranch]

98 | Accessor N.Name

99 | Accessor N.Name

99 | Access Expr N.Name

100 | Access Expr N.Name

100− | Update N.Name Expr (Map.Map N.Name Expr)

101+ | Update N.Name Expr (Map.Map N.Name FieldUpdate)

101 | Record (Map.Map N.Name Expr)

102 | Record (Map.Map N.Name Expr)

102 | Unit

103 | Unit

103 | Tuple Expr Expr (Maybe Expr)

104 | Tuple Expr Expr (Maybe Expr)

@@ -108,6 +109,10 @@ data CaseBranch =

108 CaseBranch Pattern Expr

109 CaseBranch Pattern Expr

109

110

111

112+data FieldUpdate =

113+ FieldUpdate R.Region Expr

114+

115+

111

116

112-- DEFS

117-- DEFS

113

118

compiler/src/Canonicalize/Environment/Dups.hs+11

@@ -3,6 +3,7 @@

3module Canonicalize.Environment.Dups

4 ( detect

5 , checkFields

6+ , checkFields'

6 , Dict

7 , Dict

7 , none

8 , none

8 , one

9 , one

@@ -76,6 +77,16 @@ addField (A.At region name, value) dups =

76 Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dups

77 Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dups

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+

80-- BUILDING DICTIONARIES

91-- BUILDING DICTIONARIES

compiler/src/Canonicalize/Expression.hs+7−4

@@ -138,10 +138,13 @@ canonicalize env (A.At region expression) =

138 <*> Result.ok field

139

140 Valid.Update (A.At reg name) fields ->

141+ let

142+ makeCanFields =

141− do fieldDict <- Dups.checkFields fields

143+ Dups.checkFields' (\r t -> Can.FieldUpdate r <$> canonicalize env t) fields

142− name_ <- findVar reg env name

144+ in

143− Can.Update name (A.At reg name_)

145+ Can.Update name

144− <$> traverse (canonicalize env) fieldDict

146+ <$> (A.At reg <$> findVar reg env name)

147+ <*> (sequenceA =<< makeCanFields)

145

148

146 Valid.Record fields ->

149 Valid.Record fields ->

147 do fieldDict <- Dups.checkFields fields

150 do fieldDict <- Dups.checkFields fields

compiler/src/Nitpick/PatternMatches.hs+10−1

@@ -330,7 +330,7 @@ checkExpr (A.At region expression) errors =

330 checkExpr record errors

331

332 Can.Update _ record fields ->

333− checkExpr record $ Map.foldr checkExpr errors fields

333+ checkExpr record $ Map.foldr checkField errors fields

334

335 Can.Record fields ->

336 Map.foldr checkExpr errors fields

@@ -353,6 +353,15 @@ checkExpr (A.At region expression) errors =

353

354

355

356+-- CHECK FIELD

357+

358+

359+checkField :: Can.FieldUpdate -> [Error] -> [Error]

360+checkField (Can.FieldUpdate _ expr) errors =

361+ checkExpr expr errors

362+

363+

364+

356-- CHECK IF BRANCH

365-- CHECK IF BRANCH

357

366

358

367

compiler/src/Optimize/Expression.hs+10−1

@@ -153,7 +153,7 @@ optimize cycle (A.At region expression) =

153 Can.Update _ record updates ->

154 Names.registerFieldDict updates Opt.Update

155 <*> optimize cycle record

156− <*> traverse (optimize cycle) updates

156+ <*> traverse (optimizeUpdate cycle) updates

157

158 Can.Record fields ->

159 Names.registerFieldDict fields Opt.Record

@@ -173,6 +173,15 @@ optimize cycle (A.At region expression) =

173

174

175

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+

176-- DEFINITION

185-- DEFINITION

177

186

178

187

compiler/src/Reporting/Error/Type.hs+48−30

@@ -26,6 +26,7 @@ import Data.Monoid ((<>))

26import qualified AST.Canonical as Can

27import qualified Data.Index as Index

28import qualified Elm.Name as N

29+import qualified Reporting.Annotation as A

29import qualified Reporting.Doc as D

30import qualified Reporting.Doc as D

30import qualified Reporting.Region as R

31import qualified Reporting.Region as R

31import qualified Reporting.Render.Code as Code

32import qualified Reporting.Render.Code as Code

@@ -66,7 +67,8 @@ data Context

66 | CallArity MaybeName Int

67 | CallArity MaybeName Int

67 | CallArg MaybeName Index.ZeroBased

68 | CallArg MaybeName Index.ZeroBased

68 | RecordAccess N.Name

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

70 | Destructure

72 | Destructure

@@ -384,7 +386,7 @@ addCategory thisIs category maybeAlias =

384 let

386 let

385 definitely whatever =

387 definitely whatever =

386 case maybeAlias of

388 case maybeAlias of

387− Just alias -> " a `" <> N.toString alias <> "` value:"

389+ Just alias -> " a `" <> N.toString alias <> "`:"

388 Nothing -> whatever

390 Nothing -> whatever

389 in

391 in

390 D.reflow $

392 D.reflow $

@@ -701,6 +703,10 @@ toExprReport source localizer exprRegion category tipe expected =

701 ( D.reflow problem

703 ( D.reflow problem

702 , loneType localizer tipe expectedType (addCategory thisIs category) furtherDetails

704 , loneType localizer tipe expectedType (addCategory thisIs category) furtherDetails

703 )

705 )

706+

707+ custom maybeHighlight docPair =

708+ Report.Report "TYPE MISMATCH" exprRegion [] $

709+ Report.toCodeSnippet source region maybeHighlight docPair

704 in

710 in

705 case context of

711 case context of

706 ListEntry index ->

712 ListEntry index ->

@@ -731,18 +737,16 @@ toExprReport source localizer exprRegion category tipe expected =

731 )

737 )

732

738

733 OpLeft op ->

739 OpLeft op ->

734− Report.Report "TYPE MISMATCH" exprRegion [] $

735− Report.toCodeSnippet source region (Just exprRegion) $

740+ custom (Just exprRegion) $

736− opLeftToDocs localizer category op tipe expectedType

741+ opLeftToDocs localizer category op tipe expectedType

737

742

738 OpRight op ->

743 OpRight op ->

739− Report.Report "TYPE MISMATCH" exprRegion [] $

740− case opRightToDocs localizer category op tipe expectedType of

744+ case opRightToDocs localizer category op tipe expectedType of

741− EmphBoth details ->

745+ EmphBoth details ->

742− Report.toCodeSnippet source region Nothing details

746+ custom Nothing details

743

747

744− EmphRight details ->

748+ EmphRight details ->

745− Report.toCodeSnippet source region (Just exprRegion) details

749+ custom (Just exprRegion) details

746

750

747 IfCondition ->

751 IfCondition ->

748 badType

752 badType

@@ -862,34 +866,43 @@ toExprReport source localizer exprRegion category tipe expected =

862 ]

866 ]

863 )

867 )

864

868

865− RecordUpdate name updatedFields ->

869+ RecordUpdateKeys record expectedFields ->

866− badType $

867 case T.getFields tipe of

870 case T.getFields tipe of

868 Nothing ->

871 Nothing ->

872+ badType

869 ( Just exprRegion

873 ( Just exprRegion

870− , "I cannot update the `" <> N.toString name <> "` value:"

874+ , "This is not a record, so it has no fields to update!"

871 , "It is"

875 , "It is"

872− , [ D.reflow $ "It is not a record. It has no fields to update!"

876+ , [ D.reflow $ "But I need a record!"

873 ]

877 ]

874 )

878 )

875

879

876− Just _fields ->

880+ Just actualFields ->

877− case Map.keys updatedFields of

881+ case Map.foldrWithKey addLocatedField [] (Map.difference expectedFields actualFields) of

882+ [] ->

883+ error "TODO RecordUpdateKeys"

884+

878− [field] ->

885+ A.At fieldRegion field : _ ->

879− ( Nothing

886+ badType

887+ ( Just fieldRegion

880− , "The `" <> N.toString name <> "` record does not have a `" <> N.toString field <> "` field."

888+ , "The `" <> N.toString record <> "` record does not have a `" <> N.toString field <> "` field:"

881− , "It is"

889+ , "The `" <> N.toString record <> "` is"

890+ , [ D.reflow $ "So maybe you want one of these fields instead? TODO make suggestions!"

882− , [ -- TODO suggest what the typo is!

891+ -- TODO suggest what the typo is!

883 ]

892 ]

884 )

893 )

885

894

886− _ ->

895+ RecordUpdateValue field ->

887− ( Nothing

896+ mismatch

888− , "The `" <> N.toString name <> "` record does have all of these fields:"

897+ ( Just exprRegion

889− , "It is"

898+ , "I cannot update the `" <> N.toString field <> "` field like this:"

890− , [ -- TODO suggest what the typo is!

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

891− ]

904+ ]

892− )

905+ )

893

906

894 Destructure ->

907 Destructure ->

895 mismatch

908 mismatch

@@ -902,7 +915,7 @@ toExprReport source localizer exprRegion category tipe expected =

902

915

903

916

904

917

905−-- COUNT ARGS

918+-- HELPERS

906

919

907

920

908countArgs :: T.Type -> Int

921countArgs :: T.Type -> Int

@@ -915,6 +928,11 @@ countArgs tipe =

915 0

928 0

916

929

917

930

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+

918

936

919-- OP LEFT

937-- OP LEFT

920

938

compiler/src/Type/Constrain/Expression.hs+16−13

@@ -406,25 +406,28 @@ constrainField rtv expr =

406-- CONSTRAIN RECORD UPDATE

407

408

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

410constrainUpdate rtv region name expr fields expected =

411− do sharedVar <- mkFlexVar

411+ do extVar <- mkFlexVar

412− let sharedType = VarN sharedVar

412+ fieldDict <- Map.traverseWithKey (constrainUpdateField rtv region) fields

413

414− oldVars <- traverse (\_ -> mkFlexVar) fields

414+ let recordType = RecordN (Map.map (\(_,t,_) -> t) fieldDict) (VarN extVar)

415− let oldTypes = Map.map VarN oldVars

415+ let recordCon = CEqual region Record recordType expected

416− let oldRecordType = RecordN oldTypes sharedType

416+

417− oldCon <- constrain rtv expr (FromContext region (RecordUpdate name fields) oldRecordType)

417+ let vars = Map.foldr (\(v,_,_) vs -> v:vs) [extVar] fieldDict

418+ let cons = Map.foldr (\(_,_,c) cs -> c:cs) [recordCon] fieldDict

418

419

419− newDict <- traverse (constrainField rtv) fields

420+ con <- constrain rtv expr (FromContext region (RecordUpdateKeys name fields) recordType)

420

421

421− let newRecordType = RecordN (Map.map (\(_,t,_) -> t) newDict) sharedType

422+ return $ exists vars $ CAnd (con:cons)

422− let newCon = CEqual region Record newRecordType expected

423

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

426

424

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)

428

431

429

432

430

433

compiler/src/Type/Error.hs+2−2

@@ -73,14 +73,14 @@ iteratedDealias tipe =

73 tipe

76−getFields :: Type -> Maybe [N.Name]

76+getFields :: Type -> Maybe (Map.Map N.Name Type)

77getFields tipe =

78 case tipe of

79 Alias _ _ _ real ->

80 getFields real

82 Record fields _ ->

83− Just (Map.keys fields)

83+ Just fields

85 _ ->

86 Nothing