55420d4 · elk · git.iko.soy

git.iko.soy/elk

Track dealiasing more precisely

commit55420d411920e0380630adf150d13cfe891783b2 authorEvan Czaplicki <info@elm-lang.org> dateTue 24 Mar 2015, 00:18 (12 years ago) parent54f9d33

7 files changed+63−26

compare with master

unifiedsplit

src/AST/Type.hs+36−14 src/Transform/Canonicalize/Setup.hs+6−2 src/Transform/Canonicalize/Type.hs+4−4 src/Transform/Check.hs+7−2 src/Transform/Declaration.hs+1−1 src/Type/Environment.hs+8−2 src/Type/Type.hs+1−1

src/AST/Type.hs+36−14

@@ -1,5 +1,6 @@

11module AST.Type

2− ( Type(..), RawType, CanonicalType

2+ ( Type(..), AliasType(..)

3+ , RawType, CanonicalType

34 , PortType(..), PortDirection(..)

45 , fieldMap, recordOf, listOf, tupleOf

56 , deepDealias, dealias

@@ -26,7 +27,13 @@ data Type var

2627 | Type var

2728 | App (Type var) [Type var]

2829 | Record [(String, Type var)] (Maybe (Type var))

29− | Aliased Var.Canonical [(String, Type var)] (Type var)

30+ | Aliased Var.Canonical [(String, Type var)] (AliasType var)

31+ deriving (Eq,Show)

32+

33+

34+data AliasType var

35+ = Holey (Type var)

36+ | Filled (Type var)

3037 deriving (Eq,Show)

3138

3239

@@ -102,9 +109,14 @@ deepDealias tipe =

102109 App (go f) (map go args)

103110

104111

105−dealias :: [(String, Type v)] -> Type v -> Type v

106−dealias args tipe =

107− dealiasHelp (Map.fromList args) tipe

112+dealias :: [(String, Type v)] -> AliasType v -> Type v

113+dealias args aliasType =

114+ case aliasType of

115+ Holey tipe ->

116+ dealiasHelp (Map.fromList args) tipe

117+

118+ Filled tipe ->

119+ tipe

108120

109121

110122dealiasHelp :: Map.Map String (Type var) -> Type var -> Type var

@@ -188,13 +200,6 @@ instance (Var.ToString var, Pretty var) => Pretty (Type var) where

188200 prettyField (field, tipe) =

189201 P.text field <+> P.text ":" <+> pretty tipe

190202

191− Aliased name [] t ->

192− let t' = pretty t

193− in

194− if show t' `elem` ["Int", "Float", "String", "Char", "Bool"]

195− then t'

196− else pretty name

197−

198203 Aliased name args _ ->

199204 P.hang (pretty name) 2 (P.sep (map (prettyParens . snd) args))

200205

@@ -246,8 +251,8 @@ flattenRecord tipe =

246251 in

247252 (fields' ++ fields, ext')

248253

249− Aliased _ _ tipe' ->

250− flattenRecord tipe'

254+ Aliased _ args tipe' ->

255+ flattenRecord (dealias args tipe')

251256

252257 _ ->

253258 error "Trying to flatten ill-formed record."

@@ -286,3 +291,20 @@ instance Binary var => Binary (Type var) where

286291 4 -> Record <$> get <*> get

287292 5 -> Aliased <$> get <*> get <*> get

288293 _ -> error "Error reading a valid type from serialized string"

294+

295+

296+instance Binary var => Binary (AliasType var) where

297+ put aliasType =

298+ case aliasType of

299+ Holey tipe ->

300+ putWord8 0 >> put tipe

301+

302+ Filled tipe ->

303+ putWord8 1 >> put tipe

304+

305+ get = do

306+ n <- getWord8

307+ case n of

308+ 0 -> Holey <$> get

309+ 1 -> Filled <$> get

310+ _ -> error "Error reading a valid type from serialized string"

src/Transform/Canonicalize/Setup.hs+6−2

@@ -204,8 +204,12 @@ node name tvars alias =

204204 Type.Record fs ext ->

205205 maybe [] edges ext ++ concatMap (edges . snd) fs

206206

207− Type.Aliased _ args t ->

208− edges t ++ concatMap (edges . snd) args

207+ Type.Aliased _ args aliasType ->

208+ case aliasType of

209+ Type.Holey t ->

210+ edges t ++ concatMap (edges . snd) args

211+ Type.Filled t ->

212+ edges t

209213

210214

211215addTypeAliases

src/Transform/Canonicalize/Type.hs+4−4

@@ -34,12 +34,12 @@ tipe env typ =

3434 T.Lambda a b ->

3535 T.Lambda <$> go a <*> go b

3636

37− T.Aliased name args t ->

38− T.Aliased name <$> mapM goSnd args <*> go t

39−

4037 T.Record fields ext ->

4138 T.Record <$> mapM goSnd fields <*> traverse go ext

4239

40+ T.Aliased _ _ _ ->

41+ error "a RawType should never have an alias in it"

42+

4343

4444canonicalizeApp

4545 :: Environment

@@ -72,7 +72,7 @@ canonicalizeAlias

7272canonicalizeAlias env (name, tvars, dealiasedTipe) tipes =

7373 do when (tipesLen /= tvarsLen) (throwError msg)

7474 tipes' <- mapM (tipe env) tipes

75− return $ T.Aliased name (zip tvars tipes') dealiasedTipe

75+ return $ T.Aliased name (zip tvars tipes') (T.Holey dealiasedTipe)

7676 where

7777 tipesLen = length tipes

7878 tvarsLen = length tvars

src/Transform/Check.hs+7−2

@@ -189,8 +189,13 @@ infiniteTypeAliases decls =

189189 T.Record fields _ ->

190190 any (infinite . snd) fields

191191

192− T.Aliased _ args t ->

193− infinite t || any (infinite . snd) args

192+ T.Aliased _ args aliasType ->

193+ case aliasType of

194+ T.Holey t ->

195+ infinite t || any (infinite . snd) args

196+

197+ T.Filled t ->

198+ infinite t

194199

195200 indented :: D.ValidDecl -> Doc

196201 indented decl =

src/Transform/Declaration.hs+1−1

@@ -96,7 +96,7 @@ toDefs moduleName decl =

9696 [ definition name (buildFunction record vars) (foldr T.Lambda result args) ]

9797 where

9898 result =

99− T.Aliased (typeVar name) (zip tvars (map T.Var tvars)) tipe

99+ T.Aliased (typeVar name) (zip tvars (map T.Var tvars)) (T.Holey tipe)

100100

101101 args =

102102 map snd fields ++ maybe [] (:[]) ext

src/Type/Environment.hs+8−2

@@ -186,9 +186,15 @@ instantiatorHelp env aliasVars sourceType =

186186 | "appendable" `isPrefixOf` x = Is Appendable

187187 | otherwise = Flexible

188188

189− T.Aliased name args aliasedType ->

189+ T.Aliased name args aliasType ->

190190 do args' <- mapM (\(arg,tipe) -> (,) arg <$> go tipe) args

191− aliasedType' <- instantiatorHelp env (Set.fromList (map fst args)) aliasedType

191+ aliasedType' <-

192+ case aliasType of

193+ T.Filled tipe ->

194+ instantiatorHelp env Set.empty tipe

195+ T.Holey tipe ->

196+ instantiatorHelp env (Set.fromList (map fst args)) tipe

197+

192198 case aliasedType' of

193199 PlaceHolder _ ->

194200 error "problem instantiating type"

src/Type/Type.hs+1−1

@@ -376,7 +376,7 @@ variableToSrcType rootVariable variable =

376376

377377 Just (name, args) ->

378378 do args' <- mapM (\(arg,tvar) -> (,) arg <$> variableToSrcType rootVariable tvar) args

379− return (T.Aliased name args' srcType)

379+ return (T.Aliased name args' (T.Filled srcType))

380380 where

381381 backupSrcType :: Descriptor -> IO T.CanonicalType

382382 backupSrcType desc =