55420d4 · elk · git.iko.soy

src/AST/Type.hs+36−14

compare with master

unifiedsplit

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

1module AST.Type

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

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

3+ , RawType, CanonicalType

3 , PortType(..), PortDirection(..)

4 , PortType(..), PortDirection(..)

4 , fieldMap, recordOf, listOf, tupleOf

5 , fieldMap, recordOf, listOf, tupleOf

5 , deepDealias, dealias

6 , deepDealias, dealias

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

26 | Type var

27 | Type var

27 | App (Type var) [Type var]

28 | App (Type var) [Type var]

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

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

30 deriving (Eq,Show)

37 deriving (Eq,Show)

31

38

32

39

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

102 App (go f) (map go args)

109 App (go f) (map go args)

103

110

104

111

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

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

106−dealias args tipe =

113+dealias args aliasType =

114+ case aliasType of

115+ Holey tipe ->

107− dealiasHelp (Map.fromList args) tipe

116+ dealiasHelp (Map.fromList args) tipe

117+

118+ Filled tipe ->

119+ tipe

108

120

109

121

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

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

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

188 prettyField (field, tipe) =

200 prettyField (field, tipe) =

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

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

190

202

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−

198 Aliased name args _ ->

203 Aliased name args _ ->

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

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

200

205

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

246 in

251 in

247 (fields' ++ fields, ext')

252 (fields' ++ fields, ext')

248

253

249− Aliased _ _ tipe' ->

254+ Aliased _ args tipe' ->

250− flattenRecord tipe'

255+ flattenRecord (dealias args tipe')

251

256

252 _ ->

257 _ ->

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

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

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

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

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

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

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

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

293 _ -> 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 =

204 Type.Record fs ext ->

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

206

207− Type.Aliased _ args t ->

207+ Type.Aliased _ args aliasType ->

208+ case aliasType of

209+ Type.Holey t ->

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

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

211+ Type.Filled t ->

212+ edges t

209

213

210

214

211addTypeAliases

215addTypeAliases

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

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

34 T.Lambda a b ->

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

36

37− T.Aliased name args t ->

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

39−

40 T.Record fields ext ->

37 T.Record fields ext ->

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

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

42

39

40+ T.Aliased _ _ _ ->

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

42+

43

44canonicalizeApp

45 :: Environment

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

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

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

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

76 where

77 tipesLen = length tipes

78 tvarsLen = length tvars

src/Transform/Check.hs+7−2

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

189 T.Record fields _ ->

190 any (infinite . snd) fields

191

192− T.Aliased _ args t ->

192+ T.Aliased _ args aliasType ->

193+ case aliasType of

194+ T.Holey t ->

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

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

196+

197+ T.Filled t ->

198+ infinite t

194

199

195 indented :: D.ValidDecl -> Doc

200 indented :: D.ValidDecl -> Doc

196 indented decl =

201 indented decl =

src/Transform/Declaration.hs+1−1

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

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

97 where

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

100

101 args =

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

src/Type/Environment.hs+8−2

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

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

187 | otherwise = Flexible

188

189− T.Aliased name args aliasedType ->

189+ T.Aliased name args aliasType ->

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

191+ aliasedType' <-

192+ case aliasType of

193+ T.Filled tipe ->

194+ instantiatorHelp env Set.empty tipe

195+ T.Holey tipe ->

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

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

197+

192 case aliasedType' of

198 case aliasedType' of

193 PlaceHolder _ ->

199 PlaceHolder _ ->

194 error "problem instantiating type"

200 error "problem instantiating type"

src/Type/Type.hs+1−1

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

376

377 Just (name, args) ->

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

380 where

381 backupSrcType :: Descriptor -> IO T.CanonicalType

382 backupSrcType desc =