git.iko.soy/elk
on master help sign in
Improve indentation and organization in Transform.Check
d06b33bEvan Czaplicki
src/Transform/Check.hs+114−76
compare with master
unifiedsplit
@@ -23,12 +23,14 @@ mistakes :: [D.ValidDecl] -> [Doc]
23mistakes decls =
23mistakes decls =
24 concat
24 concat
25 [ infiniteTypeAliases decls
25 [ infiniteTypeAliases decls
26− , illFormedTypes decls
26+ , illFormedTypeDecls decls
27 , map P.text (duplicateTypeDeclarations decls)
27 , map P.text (duplicateTypeDeclarations decls)
28 , map P.text (duplicateValues decls)
28 , map P.text (duplicateValues decls)
29 ]
29 ]
30
30
31
31
32+-- DUPLICATES
33+
32dups :: Ord a => [a] -> [a]
34dups :: Ord a => [a] -> [a]
33dups names =
35dups names =
34 List.sort names
36 List.sort names
@@ -97,82 +99,118 @@ dupCtorError name =
97 ++ " something should be renamed or moved to a different module."
99 ++ " something should be renamed or moved to a different module."
98
100
99
101
102+-- FREE TYPE VARIABLES IN TYPE DECLARATIONS
103+
100−illFormedTypes :: [D.ValidDecl] -> [Doc]
104+illFormedTypeDecls :: [D.ValidDecl] -> [Doc]
105+illFormedTypeDecls decls =
101−illFormedTypes decls = map report (Maybe.mapMaybe isIllFormed (aliases ++ adts))
106+ map report (Maybe.mapMaybe isIllFormed (aliases ++ adts))
102− where
107+ where
108+ aliases =
103− aliases = [ (decl, tvars, [tipe]) | decl@(D.TypeAlias _ tvars tipe) <- decls ]
109+ [ (decl, tvars, [tipe]) | decl@(D.TypeAlias _ tvars tipe) <- decls ]
110+
111+ adts =
104− adts = [ (decl, tvars, concatMap snd ctors) | decl@(D.Datatype _ tvars ctors) <- decls ]
112+ [ (decl, tvars, concatMap snd ctors) | decl@(D.Datatype _ tvars ctors) <- decls ]
105−
113+
106− freeVars tipe =
114+ freeVars tipe =
107− case tipe of
115+ case tipe of
116+ T.Lambda t1 t2 ->
108− T.Lambda t1 t2 -> Set.union (freeVars t1) (freeVars t2)
117+ Set.union (freeVars t1) (freeVars t2)
118+
119+ T.Var x ->
109− T.Var x -> Set.singleton x
120+ Set.singleton x
121+
122+ T.Type _ ->
110− T.Type _ -> Set.empty
123+ Set.empty
124+
125+ T.App t ts ->
111− T.App t ts -> Set.unions (map freeVars (t:ts))
126+ Set.unions (map freeVars (t:ts))
127+
112− T.Record fields ext -> Set.unions (ext' : map (freeVars . snd) fields)
128+ T.Record fields ext ->
113− where ext' = maybe Set.empty freeVars ext
129+ let ext' = maybe Set.empty freeVars ext
114− T.Aliased _ t -> freeVars t
130+ in
115−
131+ Set.unions (ext' : map (freeVars . snd) fields)
116− undeclared tvars tipes = Set.difference used declared
117− where
118− used = Set.unions (map freeVars tipes)
119− declared = Set.fromList tvars
120−
121− isIllFormed (decl, tvars, tipes) =
122− let unbound = undeclared tvars tipes in
123− if Set.null unbound then Nothing
124− else Just (decl, Set.toList unbound)
125−
126− report (decl, tvars) =
127− P.vcat [ P.text $ "Error: type variable" ++ listing ++ " unbound in:"
128− , P.text "\n"
129− , nest 4 (pretty decl) ]
130− where
131− listing =
132− case tvars of
133− [tvar] -> " " ++ quote tvar ++ " is"
134− _ -> "s" ++ addCommas (map ((++) " ") (addAnd (map quote tvars))) ++ " are"
135−
136− addCommas xs
137− | length xs < 3 = concat xs
138− | otherwise = List.intercalate "," xs
139−
140− addAnd xs
141− | length xs < 2 = xs
142− | otherwise = zipWith (++) (replicate (length xs - 1) "" ++ ["and "]) xs
143−
144− quote tvar = "'" ++ tvar ++ "'"
145
132
133+ T.Aliased _ t ->
134+ freeVars t
135+
136+ undeclared tvars tipes =
137+ Set.difference used declared
138+ where
139+ used = Set.unions (map freeVars tipes)
140+ declared = Set.fromList tvars
141+
142+ isIllFormed (decl, tvars, tipes) =
143+ let unbound = undeclared tvars tipes in
144+ if Set.null unbound
145+ then Nothing
146+ else Just (decl, Set.toList unbound)
147+
148+ report (decl, tvars) =
149+ P.vcat [ P.text $ "Error: type variable" ++ listing ++ " unbound in:"
150+ , P.text "\n"
151+ , nest 4 (pretty decl) ]
152+ where
153+ listing =
154+ case tvars of
155+ [tvar] -> " " ++ quote tvar ++ " is"
156+ _ -> "s" ++ addCommas (map ((++) " ") (addAnd (map quote tvars))) ++ " are"
157+
158+ addCommas xs
159+ | length xs < 3 = concat xs
160+ | otherwise = List.intercalate "," xs
161+
162+ addAnd xs
163+ | length xs < 2 = xs
164+ | otherwise = zipWith (++) (replicate (length xs - 1) "" ++ ["and "]) xs
165+
166+ quote tvar = "'" ++ tvar ++ "'"
167+
168+
169+-- INFINITE TYPE ALIASES
146
170
147infiniteTypeAliases :: [D.ValidDecl] -> [Doc]
171infiniteTypeAliases :: [D.ValidDecl] -> [Doc]
148infiniteTypeAliases decls =
172infiniteTypeAliases decls =
173+ [ report name tvars tipe
149− [ report name tvars tipe | D.TypeAlias name tvars tipe <- decls
174+ | D.TypeAlias name tvars tipe <- decls
150− , infiniteType name tipe ]
175+ , infiniteType name tipe
176+ ]
151− where
177+ where
152− infiniteType :: String -> T.Type Var.Raw -> Bool
178+ infiniteType :: String -> T.Type Var.Raw -> Bool
153− infiniteType name tipe =
179+ infiniteType name tipe =
154− let infinite = infiniteType name in
180+ let infinite = infiniteType name in
155− case tipe of
181+ case tipe of
182+ T.Lambda a b ->
156− T.Lambda a b -> infinite a || infinite b
183+ infinite a || infinite b
184+
157− T.Var _ -> False
185+ T.Var _ ->
186+ False
187+
158− T.Type (Var.Raw name') -> name == name'
188+ T.Type (Var.Raw name') ->
189+ name == name'
190+
191+ T.App t ts ->
159− T.App t ts -> any infinite (t:ts)
192+ any infinite (t:ts)
193+
194+ T.Record fields _ ->
160− T.Record fields _ -> any (infinite . snd) fields
195+ any (infinite . snd) fields
196+
161− T.Aliased _ t -> infinite t
197+ T.Aliased _ t ->
162−
198+ infinite t
199+
163− indented :: D.ValidDecl -> Doc
200+ indented :: D.ValidDecl -> Doc
201+ indented decl =
164− indented decl = P.text "\n " <> pretty decl <> P.text "\n"
202+ P.text "\n " <> pretty decl <> P.text "\n"
165−
203+
166− report name args tipe =
204+ report name args tipe =
167− P.vcat
205+ P.vcat
168− [ P.text $ eightyCharLines 0 msg1
206+ [ P.text $ eightyCharLines 0 msg1
169− , indented $ D.TypeAlias name args tipe
207+ , indented $ D.TypeAlias name args tipe
170− , P.text $ eightyCharLines 0 Setup.typeAliasErrorSegue
208+ , P.text $ eightyCharLines 0 Setup.typeAliasErrorSegue
171− , indented $ D.Datatype name args [(name,[tipe])]
209+ , indented $ D.Datatype name args [(name,[tipe])]
172− , P.text $ eightyCharLines 0 Setup.typeAliasErrorExplanation ++ "\n"
210+ , P.text $ eightyCharLines 0 Setup.typeAliasErrorExplanation ++ "\n"
173− ]
211+ ]
174− where
212+ where
175− msg1 =
213+ msg1 =
176− "Type alias '" ++ name ++ "' is an infinite type. " ++
214+ "Type alias '" ++ name ++ "' is an infinite type. " ++
177− "Notice that it appears in its own definition, so when \
215+ "Notice that it appears in its own definition, so when \
178− \you expand it, it just keeps getting bigger:"
216+ \you expand it, it just keeps getting bigger:"