b5df201 · elk · git.iko.soy

git.iko.soy/elk

Switch TRecord constructors to have (Maybe Name) extensions

It is not valid syntax for a record extension to be anything except a variable, so I changed the internal representations to match that. The types in unification can be a bit more flexible, but the rules apply when they are converted back to normal types.

commitb5df20188516c1c35bef1b64ca17788e8da15f39 authorEvan Czaplicki <evancz@users.noreply.github.com> dateFri 9 Feb 2018, 20:39 (9 years ago) parent435987d

11 files changed+53−67

compare with master

unifiedsplit

src/AST/Canonical.hs+1−1 src/AST/Source.hs+1−1 src/AST/Utils/Type.hs+2−4 src/Canonicalize/Environment/Local.hs+11−8 src/Canonicalize/Type.hs+3−4 src/Elm/Compiler/Type.hs+25−41 src/Elm/Compiler/Type/Extract.hs+2−3 src/Parse/Type.hs+1−1 src/Type/Instantiate.hs+1−1 src/Type/Solve.hs+4−1 src/Type/Type.hs+2−2

src/AST/Canonical.hs+1−1

@@ -183,7 +183,7 @@ data Type

183183 = TLambda Type Type

184184 | TVar N.Name

185185 | TType ModuleName.Canonical N.Name [Type]

186− | TRecord (Map.Map N.Name Type) (Maybe Type)

186+ | TRecord (Map.Map N.Name Type) (Maybe N.Name)

187187 | TUnit

188188 | TTuple Type Type (Maybe Type)

189189 | TAlias ModuleName.Canonical N.Name [(N.Name, Type)] AliasType

src/AST/Source.hs+1−1

@@ -109,7 +109,7 @@ data Type_

109109 | TVar N.Name

110110 | TType R.Region N.Name [Type]

111111 | TTypeQual R.Region N.Name N.Name [Type]

112− | TRecord [(A.Located N.Name, Type)] (Maybe Type)

112+ | TRecord [(A.Located N.Name, Type)] (Maybe (A.Located N.Name))

113113 | TUnit

114114 | TTuple Type Type [Type]

115115

src/AST/Utils/Type.hs+2−4

@@ -55,9 +55,7 @@ dealiasHelp typeTable tipe =

5555 Map.findWithDefault tipe x typeTable

5656

5757 TRecord fields ext ->

58− TRecord

59− (Map.map (dealiasHelp typeTable) fields)

60− (fmap (dealiasHelp typeTable) ext)

58+ TRecord (Map.map (dealiasHelp typeTable) fields) ext

6159

6260 TAlias home name args t' ->

6361 TAlias home name (map (fmap (dealiasHelp typeTable)) args) t'

@@ -89,7 +87,7 @@ deepDealias tipe =

8987 tipe

9088

9189 TRecord fields ext ->

92− TRecord (Map.map deepDealias fields) (fmap deepDealias ext)

90+ TRecord (Map.map deepDealias fields) ext

9391

9492 TAlias _ _ args tipe' ->

9593 deepDealias (dealias args tipe')

src/Canonicalize/Environment/Local.hs+11−8

@@ -173,12 +173,9 @@ getEdges edges (A.At _ tipe) =

173173 Src.TTypeQual _ _ _ args ->

174174 List.foldl' getEdges edges args

175175

176− Src.TRecord fields Nothing ->

176+ Src.TRecord fields _ ->

177177 List.foldl' (\es (_,t) -> getEdges es t) edges fields

178178

179− Src.TRecord fields (Just ext) ->

180− List.foldl' (\es (_,t) -> getEdges es t) (getEdges edges ext) fields

181−

182179 Src.TUnit ->

183180 edges

184181

@@ -246,11 +243,17 @@ addFreeVars freeVars (A.At region tipe) =

246243 Src.TTypeQual _ _ _ args ->

247244 List.foldl' addFreeVars freeVars args

248245

249− Src.TRecord fields Nothing ->

250− List.foldl' (\fvs (_,t) -> addFreeVars fvs t) freeVars fields

246+ Src.TRecord fields maybeExt ->

247+ let

248+ extFreeVars =

249+ case maybeExt of

250+ Nothing ->

251+ freeVars

251252

252− Src.TRecord fields (Just ext) ->

253− List.foldl' (\fvs (_,t) -> addFreeVars fvs t) (addFreeVars freeVars ext) fields

253+ Just (A.At extRegion ext) ->

254+ Map.insert ext extRegion freeVars

255+ in

256+ List.foldl' (\fvs (_,t) -> addFreeVars fvs t) extFreeVars fields

254257

255258 Src.TUnit ->

256259 freeVars

src/Canonicalize/Type.hs+3−4

@@ -64,9 +64,8 @@ canonicalize env (A.At typeRegion tipe) =

6464

6565 Src.TRecord fields ext ->

6666 do fieldDict <- Dups.checkFields fields

67− Can.TRecord

68− <$> traverse (canonicalize env) fieldDict

69− <*> traverse (canonicalize env) ext

67+ cfields <- traverse (canonicalize env) fieldDict

68+ return $ Can.TRecord cfields (fmap A.toValue ext)

7069

7170 Src.TUnit ->

7271 Result.ok Can.TUnit

@@ -133,7 +132,7 @@ addFreeVars freeVars tipe =

133132 Map.foldl addFreeVars freeVars fields

134133

135134 Can.TRecord fields (Just ext) ->

136− Map.foldl addFreeVars (addFreeVars freeVars ext) fields

135+ Map.foldl addFreeVars (Map.insert ext () freeVars) fields

137136

138137 Can.TUnit ->

139138 freeVars

src/Elm/Compiler/Type.hs+25−41

@@ -37,7 +37,7 @@ data Type

3737 = Lambda Type Type

3838 | Var N.Name

3939 | Type N.Name [Type]

40− | Record [(N.Name, Type)] (Maybe Type)

40+ | Record [(N.Name, Type)] (Maybe N.Name)

4141 | Unit

4242 | Tuple Type Type [Type]

4343

@@ -127,29 +127,31 @@ toDoc context tipe =

127127 _ ->

128128 application

129129

130− Record _ _ ->

131− case flattenRecord tipe of

132− ([], Nothing) ->

133− P.text "{}"

130+ Record [] Nothing ->

131+ "{}"

134132

135− (fields, Nothing) ->

136− P.sep

137− [ P.cat (zipWith (<+>) ("{" : repeat ",") (map prettyField fields))

138− , "}"

139− ]

133+ Record fields ext ->

134+ case ext of

135+ Nothing ->

136+ P.sep

137+ [ P.cat (zipWith (<+>) ("{" : repeat ",") (map entryToDoc fields))

138+ , "}"

139+ ]

140140

141− (fields, Just x) ->

142− P.hang

143− ("{" <+> P.text (N.toString x) <+> "|")

144− 4

145− (P.sep

146− [ P.sep (P.punctuate "," (map prettyField fields))

147− , "}"

148− ]

149− )

150− where

151− prettyField (field, fieldType) =

152− P.text (N.toString field) <+> ":" <+> toDoc None fieldType

141+ Just x ->

142+ P.hang

143+ ("{" <+> P.text (N.toString x) <+> "|")

144+ 4

145+ (P.sep

146+ [ P.sep (P.punctuate "," (map entryToDoc fields))

147+ , "}"

148+ ]

149+ )

150+

151+

152+entryToDoc :: (N.Name, Type) -> P.Doc

153+entryToDoc (field, fieldType) =

154+ P.text (N.toString field) <+> ":" <+> toDoc None fieldType

153155

154156

155157collectLambdas :: Type -> [Type]

@@ -159,24 +161,6 @@ collectLambdas tipe =

159161 _ -> [tipe]

160162

161163

162−flattenRecord :: Type -> ( [(N.Name, Type)], Maybe N.Name )

163−flattenRecord tipe =

164− case tipe of

165− Var x ->

166− ([], Just x)

167−

168− Record fields Nothing ->

169− (fields, Nothing)

170−

171− Record fields (Just ext) ->

172− let (fields',ext') = flattenRecord ext

173− in

174− (fields' ++ fields, ext')

175−

176− _ ->

177− error "Trying to flatten ill-formed record."

178−

179−

180164

181165-- JSON for TYPE

182166

@@ -225,7 +209,7 @@ fromRawType (A.At _ astType) =

225209 let fromField (A.At _ field, tipe) = (field, fromRawType tipe) in

226210 Record

227211 (map fromField fields)

228− (fmap fromRawType ext)

212+ (fmap A.toValue ext)

229213

230214

231215

src/Elm/Compiler/Type/Extract.hs+2−3

@@ -53,9 +53,8 @@ extract astType =

5353 <*> traverse extract args

5454

5555 Can.TRecord fields ext ->

56− T.Record

57− <$> fmap Map.toList (traverse extract fields)

58− <*> traverse extract ext

56+ do efields <- fmap Map.toList (traverse extract fields)

57+ pure (T.Record efields ext)

5958

6059 Can.TUnit ->

6160 pure T.Unit

src/Parse/Type.hs+1−1

@@ -190,7 +190,7 @@ record start =

190190 firstField <- field

191191 fields <- chompFields [firstField]

192192 end <- getPosition

193− return (A.at start end (Src.TRecord fields (Just (A.map Src.TVar var))))

193+ return (A.at start end (Src.TRecord fields (Just var)))

194194 , do Symbol.hasType

195195 spaces

196196 (tipe, _, nextPos) <- expression

src/Type/Instantiate.hs+1−1

@@ -69,4 +69,4 @@ fromSrcType freeVars sourceType =

6969 return EmptyRecordN

7070

7171 Just ext ->

72− fromSrcType freeVars ext

72+ return (freeVars ! ext)

src/Type/Solve.hs+4−1

@@ -527,7 +527,10 @@ srcTypeToVar rank pools flexVars srcType =

527527

528528 Can.TRecord fields maybeExt ->

529529 do fieldVars <- traverse go fields

530− extVar <- maybe (register rank pools emptyRecord1) go maybeExt

530+ extVar <-

531+ case maybeExt of

532+ Nothing -> register rank pools emptyRecord1

533+ Just ext -> return (flexVars ! ext)

531534 register rank pools (Structure (Record1 fieldVars extVar))

532535

533536 Can.TUnit ->

src/Type/Type.hs+2−2

@@ -413,8 +413,8 @@ termToCanType term =

413413 Can.TRecord subFields subExt ->

414414 Can.TRecord (Map.union subFields canFields) subExt

415415

416− Can.TVar _ ->

417− Can.TRecord canFields (Just canExt)

416+ Can.TVar name ->

417+ Can.TRecord canFields (Just name)

418418

419419 _ ->

420420 error "Used toAnnotation on a type that is not well-formed"