b5df201 · elk · git.iko.soy

src/AST/Canonical.hs+1−1

compare with master

unifiedsplit

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

183 = TLambda Type Type

184 | TVar N.Name

185 | 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)

187 | TUnit

188 | TTuple Type Type (Maybe Type)

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

src/AST/Source.hs+1−1

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

109 | TVar N.Name

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

111 | 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))

113 | TUnit

114 | TTuple Type Type [Type]

115

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

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

55 Map.findWithDefault tipe x typeTable

56

57 TRecord fields ext ->

58− TRecord

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

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

60− (fmap (dealiasHelp typeTable) ext)

61

59

62 TAlias home name args t' ->

60 TAlias home name args t' ->

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

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

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

89 tipe

87 tipe

90

88

91 TRecord fields ext ->

89 TRecord fields ext ->

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

90+ TRecord (Map.map deepDealias fields) ext

93

91

94 TAlias _ _ args tipe' ->

92 TAlias _ _ args tipe' ->

95 deepDealias (dealias args tipe')

93 deepDealias (dealias args tipe')

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

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

173 Src.TTypeQual _ _ _ args ->

174 List.foldl' getEdges edges args

175

176− Src.TRecord fields Nothing ->

176+ Src.TRecord fields _ ->

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

178

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

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

181−

182 Src.TUnit ->

179 Src.TUnit ->

183 edges

180 edges

184

181

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

246 Src.TTypeQual _ _ _ args ->

243 Src.TTypeQual _ _ _ args ->

247 List.foldl' addFreeVars freeVars args

244 List.foldl' addFreeVars freeVars args

248

245

249− Src.TRecord fields Nothing ->

246+ Src.TRecord fields maybeExt ->

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

247+ let

248+ extFreeVars =

249+ case maybeExt of

250+ Nothing ->

251+ freeVars

251

252

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

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

254+ Map.insert ext extRegion freeVars

255+ in

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

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

254

257

255 Src.TUnit ->

258 Src.TUnit ->

256 freeVars

259 freeVars

src/Canonicalize/Type.hs+3−4

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

64

65 Src.TRecord fields ext ->

66 do fieldDict <- Dups.checkFields fields

67+ cfields <- traverse (canonicalize env) fieldDict

67− Can.TRecord

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

68− <$> traverse (canonicalize env) fieldDict

69− <*> traverse (canonicalize env) ext

70

69

71 Src.TUnit ->

70 Src.TUnit ->

72 Result.ok Can.TUnit

71 Result.ok Can.TUnit

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

133 Map.foldl addFreeVars freeVars fields

132 Map.foldl addFreeVars freeVars fields

134

133

135 Can.TRecord fields (Just ext) ->

134 Can.TRecord fields (Just ext) ->

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

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

137

136

138 Can.TUnit ->

137 Can.TUnit ->

139 freeVars

138 freeVars

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

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

37 = Lambda Type Type

38 | Var N.Name

39 | Type N.Name [Type]

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

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

41 | Unit

42 | Tuple Type Type [Type]

43

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

127 _ ->

128 application

129

130− Record _ _ ->

131− case flattenRecord tipe of

132− ([], Nothing) ->

130+ Record [] Nothing ->

133− P.text "{}"

131+ "{}"

134

132

133+ Record fields ext ->

134+ case ext of

135− (fields, Nothing) ->

135+ Nothing ->

136− P.sep

136+ P.sep

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

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

138− , "}"

138+ , "}"

139− ]

139+ ]

140

141− (fields, Just x) ->

141+ Just x ->

142− P.hang

142+ P.hang

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

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

144− 4

144+ 4

145− (P.sep

145+ (P.sep

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

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

147− , "}"

147+ , "}"

148− ]

148+ ]

149− )

149+ )

150− where

150+

151+

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

151− prettyField (field, fieldType) =

153+entryToDoc (field, fieldType) =

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

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

153

155

154

156

155collectLambdas :: Type -> [Type]

157collectLambdas :: Type -> [Type]

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

159 _ -> [tipe]

161 _ -> [tipe]

160

162

161

163

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−

180

164

181-- JSON for TYPE

165-- JSON for TYPE

182

166

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

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

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

226 Record

210 Record

227 (map fromField fields)

211 (map fromField fields)

228− (fmap fromRawType ext)

212+ (fmap A.toValue ext)

229

213

230

214

231

215

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

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

53 <*> traverse extract args

54

55 Can.TRecord fields ext ->

56− T.Record

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

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

58− <*> traverse extract ext

57+ pure (T.Record efields ext)

59

58

60 Can.TUnit ->

59 Can.TUnit ->

61 pure T.Unit

60 pure T.Unit

src/Parse/Type.hs+1−1

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

190 firstField <- field

191 fields <- chompFields [firstField]

192 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)))

194 , do Symbol.hasType

195 spaces

196 (tipe, _, nextPos) <- expression

src/Type/Instantiate.hs+1−1

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

69 return EmptyRecordN

70

71 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 =

527

528 Can.TRecord fields maybeExt ->

529 do fieldVars <- traverse go fields

530+ extVar <-

531+ case maybeExt of

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

532+ Nothing -> register rank pools emptyRecord1

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

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

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

532

535

533 Can.TUnit ->

536 Can.TUnit ->

src/Type/Type.hs+2−2

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

413 Can.TRecord subFields subExt ->

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

415

416− Can.TVar _ ->

416+ Can.TVar name ->

417− Can.TRecord canFields (Just canExt)

417+ Can.TRecord canFields (Just name)

418

419 _ ->

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