5fb82e2 · elk · git.iko.soy

git.iko.soy/elk

Complete TODO for unbound type variables in union type declarations

commit5fb82e2d3fd6c62b92b5548cdf119d6f24787a5f authorEvan Czaplicki <evancz@users.noreply.github.com> dateMon 19 Feb 2018, 13:54 (9 years ago) parent266e49d

4 files changed+60−22

compare with master

unifiedsplit

src/AST/Valid.hs+2−2 src/Canonicalize/Environment/Local.hs+13−14 src/Reporting/Error/Canonicalize.hs+43−4 src/Validate.hs+2−2

src/AST/Valid.hs+2−2

@@ -88,8 +88,8 @@ data Module =

8888

8989

9090data Decl = Decl (A.Located N.Name) [Src.Pattern] Expr (Maybe Src.Type)

91−data Union = Union (A.Located N.Name) [A.Located N.Name] [(A.Located N.Name, [Src.Type])]

92−data Alias = Alias (A.Located N.Name) [A.Located N.Name] Src.Type

91+data Union = Union R.Region (A.Located N.Name) [A.Located N.Name] [(A.Located N.Name, [Src.Type])]

92+data Alias = Alias R.Region (A.Located N.Name) [A.Located N.Name] Src.Type

9393data Binop = Binop N.Name Binop.Associativity Binop.Precedence N.Name

9494

9595

src/Canonicalize/Environment/Local.hs+13−14

@@ -100,8 +100,8 @@ toEffectDups effects =

100100addTypes :: Valid.Module -> Env.Env -> Result i w Env.Env

101101addTypes (Valid.Module _ _ _ _ _ _ unions aliases _ _) (Env.Env home vs ts cs bs qvs qts qcs) =

102102 let

103− addAliasDups dups (Valid.Alias (A.At region name) _ _) = Dups.insert name region () dups

104− addUnionDups dups (Valid.Union (A.At region name) _ _) = Dups.insert name region () dups

103+ addAliasDups dups (Valid.Alias _ (A.At region name) _ _) = Dups.insert name region () dups

104+ addUnionDups dups (Valid.Union _ (A.At region name) _ _) = Dups.insert name region () dups

105105 typeNameDups =

106106 List.foldl' addUnionDups (List.foldl' addAliasDups Dups.none aliases) unions

107107 in

@@ -111,7 +111,7 @@ addTypes (Valid.Module _ _ _ _ _ _ unions aliases _ _) (Env.Env home vs ts cs bs

111111

112112

113113addUnion :: ModuleName.Canonical -> Env.Exposed Env.Type -> Valid.Union -> Result i w (Env.Exposed Env.Type)

114−addUnion home types union@(Valid.Union (A.At _ name) _ _) =

114+addUnion home types union@(Valid.Union _ (A.At _ name) _ _) =

115115 do arity <- checkUnionFreeVars union

116116 let one = Map.singleton home (Env.Union arity home)

117117 Result.ok $ Map.insert name one types

@@ -133,7 +133,7 @@ addAliases aliases env =

133133addAlias :: Env.Env -> Graph.SCC Valid.Alias -> Result i w Env.Env

134134addAlias env@(Env.Env home vs ts cs bs qvs qts qcs) scc =

135135 case scc of

136− Graph.AcyclicSCC alias@(Valid.Alias (A.At _ name) _ tipe) ->

136+ Graph.AcyclicSCC alias@(Valid.Alias _ (A.At _ name) _ tipe) ->

137137 do args <- checkAliasFreeVars alias

138138 ctype <- Type.canonicalize env tipe

139139 let one = Map.singleton home (Env.Alias (length args) home args ctype)

@@ -143,9 +143,9 @@ addAlias env@(Env.Env home vs ts cs bs qvs qts qcs) scc =

143143 Graph.CyclicSCC [] ->

144144 Result.ok env

145145

146− Graph.CyclicSCC (alias@(Valid.Alias (A.At region name1) _ tipe) : others) ->

146+ Graph.CyclicSCC (alias@(Valid.Alias _ (A.At region name1) _ tipe) : others) ->

147147 do args <- checkAliasFreeVars alias

148− let toName (Valid.Alias (A.At _ name) _ _) = name

148+ let toName (Valid.Alias _ (A.At _ name) _ _) = name

149149 Result.throw (Error.RecursiveAlias region name1 args tipe (map toName others))

150150

151151

@@ -154,7 +154,7 @@ addAlias env@(Env.Env home vs ts cs bs qvs qts qcs) scc =

154154

155155

156156toNode :: Valid.Alias -> (Valid.Alias, N.Name, [N.Name])

157−toNode alias@(Valid.Alias (A.At _ name) _ tipe) =

157+toNode alias@(Valid.Alias _ (A.At _ name) _ tipe) =

158158 ( alias, name, getEdges [] tipe )

159159

160160

@@ -188,7 +188,7 @@ getEdges edges (A.At _ tipe) =

188188

189189

190190checkUnionFreeVars :: Valid.Union -> Result i w Int

191−checkUnionFreeVars (Valid.Union (A.At unionRegion name) args ctors) =

191+checkUnionFreeVars (Valid.Union unionRegion (A.At _ name) args ctors) =

192192 let

193193 addArg (A.At region arg) dict =

194194 Dups.insert arg region region dict

@@ -202,14 +202,13 @@ checkUnionFreeVars (Valid.Union (A.At unionRegion name) args ctors) =

202202 [] ->

203203 Result.ok (length args)

204204

205− unbound ->

206− let toLoc (arg, region) = A.At region arg in

205+ unbound:unbounds ->

207206 Result.throw $

208− Error.TypeVarsUnboundInUnion unionRegion name (map A.toValue args) (map toLoc unbound)

207+ Error.TypeVarsUnboundInUnion unionRegion name (map A.toValue args) unbound unbounds

209208

210209

211210checkAliasFreeVars :: Valid.Alias -> Result i w [N.Name]

212−checkAliasFreeVars (Valid.Alias (A.At aliasRegion name) args tipe) =

211+checkAliasFreeVars (Valid.Alias aliasRegion (A.At _ name) args tipe) =

213212 let

214213 addArg (A.At region arg) dict =

215214 Dups.insert arg region region dict

@@ -294,7 +293,7 @@ type CtorDups = Dups.Dict (Map.Map ModuleName.Canonical Env.Ctor)

294293

295294

296295canonicalizeAlias :: Env.Env -> Valid.Alias -> Result i w ( (N.Name, Can.Alias), CtorDups )

297−canonicalizeAlias env@(Env.Env home _ _ _ _ _ _ _) (Valid.Alias (A.At region name) args tipe) =

296+canonicalizeAlias env@(Env.Env home _ _ _ _ _ _ _) (Valid.Alias _ (A.At region name) args tipe) =

298297 case tipe of

299298 A.At _ (Src.TRecord fields Nothing) ->

300299 do cfields <- traverse (traverse (Type.canonicalize env)) fields

@@ -324,7 +323,7 @@ canonicalizeAlias env@(Env.Env home _ _ _ _ _ _ _) (Valid.Alias (A.At region nam

324323

325324

326325canonicalizeUnion :: Env.Env -> Valid.Union -> Result i w ( (N.Name, Can.Union), CtorDups )

327−canonicalizeUnion env@(Env.Env home _ _ _ _ _ _ _) (Valid.Union (A.At _ name) avars ctors) =

326+canonicalizeUnion env@(Env.Env home _ _ _ _ _ _ _) (Valid.Union _ (A.At _ name) avars ctors) =

328327 do cctors <- Index.indexedTraverse (canonicalizeCtor env) ctors

329328 let vars = map A.toValue avars

330329 let alts = map A.toValue cctors

src/Reporting/Error/Canonicalize.hs+43−4

@@ -72,7 +72,7 @@ data Error

7272 | RecursiveLet (A.Located N.Name) [N.Name]

7373 | Shadowing N.Name R.Region R.Region

7474 | TupleLargerThanThree R.Region

75− | TypeVarsUnboundInUnion R.Region N.Name [N.Name] [A.Located N.Name]

75+ | TypeVarsUnboundInUnion R.Region N.Name [N.Name] (N.Name, R.Region) [(N.Name, R.Region)]

7676 | TypeVarsMessedUpInAlias R.Region N.Name [N.Name] [A.Located N.Name] [A.Located N.Name]

7777

7878

@@ -735,15 +735,54 @@ toReport source err =

735735 ]

736736 )

737737

738− TypeVarsUnboundInUnion _ _ _ _ ->

739− error "TODO TypeVarsUnboundInUnion"

738+ TypeVarsUnboundInUnion unionRegion tipe allVars (unboundVar, varRegion) unboundVars ->

739+ let

740+ backQuote name =

741+ "`" <> H.nameToDoc name <> "`"

742+

743+ (title, subRegion, overview) =

744+ case map fst unboundVars of

745+ [] ->

746+ ( "UNBOUND TYPE VARIABLE"

747+ , Just varRegion

748+ , ["The",backQuote tipe,"type","uses","an","unbound","type","variable"

749+ ,H.dullyellow (backQuote unboundVar),"in","its","definition:"

750+ ]

751+ )

752+

753+ vars ->

754+ ( "UNBOUND TYPE VARIABLES"

755+ , Nothing

756+ , ["Type","variables"]

757+ ++ H.commaSep "and" H.dullyellow (H.nameToDoc unboundVar : map H.nameToDoc vars)

758+ ++ ["are","unbound","in","the",backQuote tipe,"type","definition:"]

759+ )

760+ in

761+ Report.Report title unionRegion [] $

762+ Report.toCodeSnippet source unionRegion subRegion

763+ (

764+ H.fillSep overview

765+ ,

766+ H.stack

767+ [ H.reflow $

768+ "You probably need to change the type declaration to something like this:"

769+ , H.indent 4 $ H.hsep $

770+ ["type", H.nameToDoc tipe]

771+ ++ map H.nameToDoc allVars

772+ ++ map (H.green . H.nameToDoc) (unboundVar : map fst unboundVars)

773+ ++ ["=", "..."]

774+ , H.reflow $

775+ "Why? Well, imagine one `" ++ N.toString tipe ++ "` where `" ++ N.toString unboundVar ++

776+ "` is an Int and another where it is a Bool. When we explicitly list the type\

777+ \ variables, the type checker can see that they are actually different types."

778+ ]

779+ )

740780

741781 TypeVarsMessedUpInAlias _ _ _ _ _ ->

742782 error "TODO TypeVarsMessedUpInAlias"

743783

744784

745785

746−

747786-- UnboundTypeVarsInUnion typeName givenVars unbound ->

748787-- unboundTypeVars "type" typeName givenVars unbound

749788

src/Validate.hs+2−2

@@ -69,11 +69,11 @@ vsdHelp decls stuff =

6969 A.At region decl : otherDecls ->

7070 case decl of

7171 Src.Union name tvars ctors ->

72− do let union = Valid.Union name tvars ctors

72+ do let union = Valid.Union region name tvars ctors

7373 vsdHelp otherDecls $ stuff { _unions = union : _unions stuff }

7474

7575 Src.Alias name tvars tipe ->

76− do let alias = Valid.Alias name tvars tipe

76+ do let alias = Valid.Alias region name tvars tipe

7777 vsdHelp otherDecls $ stuff { _aliases = alias : _aliases stuff }

7878

7979 Src.Binop op assoc prec val ->