on master help sign in
Throw errors for unbound type variables in ADTs and aliases, resolves #302
692d8d8Evan Czaplicki
compiler/SourceSyntax/Declaration.hs+24−1
@@ -4,6 +4,8 @@ module SourceSyntax.Declaration where
4import Data.Data
4import Data.Data
5import qualified SourceSyntax.Expression as Expr
5import qualified SourceSyntax.Expression as Expr
6import SourceSyntax.Type
6import SourceSyntax.Type
7+import SourceSyntax.PrettyPrint
8+import Text.PrettyPrint as P
7
9
8data Declaration tipe var
10data Declaration tipe var
9 = Definition (Expr.Def tipe var)
11 = Definition (Expr.Def tipe var)
@@ -22,4 +24,25 @@ instance Show Assoc where
22 case assoc of
24 case assoc of
23 L -> "left"
25 L -> "left"
24 N -> "non"
26 N -> "non"
25− R -> "right"
27+ R -> "right"
28+
29+instance Pretty (Declaration t v) where
30+ pretty decl =
31+ case decl of
32+ Definition def -> pretty def
33+
34+ Datatype tipe tvars ctors ->
35+ P.hang (P.text "data" <+> P.text tipe <+> P.hsep (map P.text tvars)) 4
36+ (P.sep $ zipWith join ("=" : repeat "|") ctors)
37+ where
38+ join c ctor = P.text c <+> prettyCtor ctor
39+ prettyCtor (name, tipes) =
40+ P.hang (P.text name) 2 (P.sep (map prettyParens tipes))
41+
42+ TypeAlias name tvars tipe ->
43+ let alias = P.text name <+> P.hsep (map P.text tvars) in
44+ P.hang (P.text "type" <+> alias <+> P.equals) 4 (pretty tipe)
45+
46+ -- TODO: actually write out the other cases. They are currently unused, but
47+ -- this is probably going to be a bug someday.
48+ _ -> P.text (show decl)
compiler/Transform/Check.hs+46−2
@@ -2,9 +2,11 @@ module Transform.Check (mistakes) where
2
2
3import Transform.SortDefinitions (boundVars)
3import Transform.SortDefinitions (boundVars)
4import SourceSyntax.Everything
4import SourceSyntax.Everything
5+import SourceSyntax.PrettyPrint
5import qualified SourceSyntax.Type as T
6import qualified SourceSyntax.Type as T
6import Data.List as List
7import Data.List as List
7import qualified Data.Map as Map
8import qualified Data.Map as Map
9+import qualified Data.Maybe as Maybe
8import qualified Data.Set as Set
10import qualified Data.Set as Set
9import Data.Data
11import Data.Data
10import Data.Generics.Uniplate.Data
12import Data.Generics.Uniplate.Data
@@ -13,7 +15,7 @@ import Text.PrettyPrint as P
13
15
14mistakes :: (Data t, Data v) => [Declaration t v] -> [Doc]
16mistakes :: (Data t, Data v) => [Declaration t v] -> [Doc]
15mistakes decls =
17mistakes decls =
16− map P.text $ concatMap findErrors (getLets decls)
18+ illFormedTypes decls ++ map P.text (concatMap findErrors (getLets decls))
17 where
19 where
18 findErrors defs = duplicates defs ++ badOrder defs
20 findErrors defs = duplicates defs ++ badOrder defs
19
21
@@ -60,4 +62,46 @@ badOrder defs = go defs
60
62
61 _ -> []
63 _ -> []
62
64
63−
65+illFormedTypes :: [Declaration t v] -> [Doc]
66+illFormedTypes decls = map report (Maybe.mapMaybe isIllFormed (aliases ++ adts))
67+ where
68+ aliases = [ (decl, tvars, [tipe]) | decl@(TypeAlias _ tvars tipe) <- decls ]
69+ adts = [ (decl, tvars, concatMap snd ctors) | decl@(Datatype _ tvars ctors) <- decls ]
70+
71+ freeVars tipe =
72+ case tipe of
73+ T.Lambda t1 t2 -> Set.union (freeVars t1) (freeVars t2)
74+ T.Var x -> Set.singleton x
75+ T.Data _ ts -> Set.unions (map freeVars ts)
76+ T.EmptyRecord -> Set.empty
77+ T.Record fields ext -> Set.unions (freeVars ext : map (freeVars . snd) fields)
78+
79+ undeclared tvars tipes = Set.difference used declared
80+ where
81+ used = Set.unions (map freeVars tipes)
82+ declared = Set.fromList tvars
83+
84+ isIllFormed (decl, tvars, tipes) =
85+ let unbound = undeclared tvars tipes in
86+ if Set.null unbound then Nothing
87+ else Just (decl, Set.toList unbound)
88+
89+ report (decl, tvars) =
90+ P.vcat [ P.text $ "Error: type variable" ++ listing ++ " unbound in:"
91+ , P.text "\n"
92+ , nest 4 (pretty decl) ]
93+ where
94+ listing =
95+ case tvars of
96+ [tvar] -> " " ++ quote tvar ++ " is"
97+ _ -> "s " ++ addCommas (addAnd (map quote tvars)) ++ " are"
98+
99+ addCommas xs
100+ | length xs < 3 = concat xs
101+ | otherwise = intercalate ", " xs
102+
103+ addAnd xs
104+ | length xs < 2 = xs
105+ | otherwise = zipWith (++) (replicate (length xs - 1) "" ++ ["and "]) xs
106+
107+ quote tvar = "'" ++ tvar ++ "'"
libraries/AutomatonV2.elm → libraries/AutomatonV2.elm.hiddenrenamed

The content is the same.

libraries/Graphics/Collage.elm+10−10
@@ -204,37 +204,37 @@ collage : Int -> Int -> [Form] -> Element
204collage = Native.Graphics.Collage.collage
204collage = Native.Graphics.Collage.collage
205
205
206
206
207−type Path = [(number,number)]
207+type Path = [(Float,Float)]
208
208
209{-| Create a path that follows a sequence of points. -}
209{-| Create a path that follows a sequence of points. -}
210−path : [(number,number)] -> Path
210+path : [(Float,Float)] -> Path
211path ps = ps
211path ps = ps
212
212
213{-| Create a path along a given line segment. -}
213{-| Create a path along a given line segment. -}
214−segment : (number,number) -> (number,number) -> Path
214+segment : (Float,Float) -> (Float,Float) -> Path
215segment p1 p2 = [p1,p2]
215segment p1 p2 = [p1,p2]
216
216
217−type Shape = [(number,number)]
217+type Shape = [(Float,Float)]
218
218
219{-| Create an arbitrary polygon by specifying its corners in order.
219{-| Create an arbitrary polygon by specifying its corners in order.
220`polygon` will automatically close all shapes, so the given list
220`polygon` will automatically close all shapes, so the given list
221of points does not need to start and end with the same position.
221of points does not need to start and end with the same position.
222-}
222-}
223−polygon : [(number,number)] -> Shape
223+polygon : [(Float,Float)] -> Shape
224polygon points = points
224polygon points = points
225
225
226{-| A rectangle with a given width and height. -}
226{-| A rectangle with a given width and height. -}
227−rect : number -> number -> Shape
227+rect : Float -> Float -> Shape
228rect w h = let hw = w/2
228rect w h = let hw = w/2
229 hh = h/2
229 hh = h/2
230 in [ (0-hw,0-hh), (0-hw,hh), (hw,hh), (hw,0-hh) ]
230 in [ (0-hw,0-hh), (0-hw,hh), (hw,hh), (hw,0-hh) ]
231
231
232{-| A square with a given edge length. -}
232{-| A square with a given edge length. -}
233−square : number -> Shape
233+square : Float -> Shape
234square n = rect n n
234square n = rect n n
235
235
236{-| An oval with a given width and height. -}
236{-| An oval with a given width and height. -}
237−oval : number -> number -> Shape
237+oval : Float -> Float -> Shape
238oval w h =
238oval w h =
239 let n = 50
239 let n = 50
240 t = 2 * pi / n
240 t = 2 * pi / n
@@ -244,7 +244,7 @@ oval w h =
244 in List.map f [0..n-1]
244 in List.map f [0..n-1]
245
245
246{-| A circle with a given radius. -}
246{-| A circle with a given radius. -}
247−circle : number -> Shape
247+circle : Float -> Shape
248circle r = oval (2*r) (2*r)
248circle r = oval (2*r) (2*r)
249
249
250{-| A regular polygon with N sides. The first argument specifies the number
250{-| A regular polygon with N sides. The first argument specifies the number
@@ -253,7 +253,7 @@ of sides and the second is the radius. So to create a pentagon with radius
253
253
254 ngon 5 30
254 ngon 5 30
255-}
255-}
256−ngon : Int -> number -> Shape
256+ngon : Int -> Float -> Shape
257ngon n r =
257ngon n r =
258 let m = toFloat n
258 let m = toFloat n
259 t = 2 * pi / m
259 t = 2 * pi / m