git.iko.soy/elk
on master help sign in
Underline type when type annotation does not match body
6ea2189Evan Czaplicki
src/AST/Expression/Canonical.hs+2−1
compare with master
unifiedsplit
@@ -7,6 +7,7 @@ import qualified AST.Expression.General as General
7import qualified AST.Pattern as Pattern
7import qualified AST.Pattern as Pattern
8import qualified AST.Type as Type
8import qualified AST.Type as Type
9import qualified AST.Variable as Var
9import qualified AST.Variable as Var
10+import qualified Reporting.Annotation as A
10import qualified Reporting.PrettyPrint as P
11import qualified Reporting.PrettyPrint as P
11import qualified Reporting.Region as R
12import qualified Reporting.Region as R
12
13
@@ -23,7 +24,7 @@ type Expr' =
23
24
24
25
25data Def
26data Def
26− = Definition Pattern.CanonicalPattern Expr (Maybe Type.Canonical)
27+ = Definition Pattern.CanonicalPattern Expr (Maybe (A.Located Type.Canonical))
27 deriving (Show)
28 deriving (Show)
28
29
29
30
src/Canonicalize.hs+13−5
@@ -265,12 +265,12 @@ declaration
265declaration env (A.A (region,_) decl) =
265declaration env (A.A (region,_) decl) =
266 A.A region <$>
266 A.A region <$>
267 case decl of
267 case decl of
268− D.Definition (Valid.Definition p e t) ->
268+ D.Definition (Valid.Definition pat expr typ) ->
269 D.Definition <$> (
269 D.Definition <$> (
270 Canonical.Definition
270 Canonical.Definition
271− <$> pattern env p
271+ <$> pattern env pat
272− <*> expression env e
272+ <*> expression env expr
273− <*> T.traverse (Canonicalize.tipe env) t
273+ <*> T.traverse (regionType env) typ
274 )
274 )
275
275
276 D.Datatype name tvars ctors ->
276 D.Datatype name tvars ctors ->
@@ -306,6 +306,14 @@ declaration env (A.A (region,_) decl) =
306 Result.ok (D.Fixity assoc prec op)
306 Result.ok (D.Fixity assoc prec op)
307
307
308
308
309+regionType
310+ :: Env.Environment
311+ -> Type.Raw
312+ -> Result.ResultErr (A.Located Type.Canonical)
313+regionType env typ@(A.A region _) =
314+ A.A region <$> Canonicalize.tipe env typ
315+
316+
309expression
317expression
310 :: Env.Environment
318 :: Env.Environment
311 -> Valid.Expr
319 -> Valid.Expr
@@ -369,7 +377,7 @@ expression env (A.A region validExpr) =
369 Canonical.Definition
377 Canonical.Definition
370 <$> pattern env' p
378 <$> pattern env' p
371 <*> expression env' body
379 <*> expression env' body
372− <*> T.traverse (Canonicalize.tipe env') mtipe
380+ <*> T.traverse (regionType env') mtipe
373
381
374 Var (Var.Raw x) ->
382 Var (Var.Raw x) ->
375 Var <$> Canonicalize.variable region env x
383 Var <$> Canonicalize.variable region env x
src/Canonicalize/Declaration.hs+9−8
@@ -9,6 +9,7 @@ import qualified AST.Pattern as P
9import qualified AST.Type as T
9import qualified AST.Type as T
10import qualified AST.Variable as Var
10import qualified AST.Variable as Var
11import qualified Reporting.Annotation as A
11import qualified Reporting.Annotation as A
12+import qualified Reporting.Region as R
12
13
13
14
14toExpr :: Module.Name -> [D.CanonicalDecl] -> [Canonical.Def]
15toExpr :: Module.Name -> [D.CanonicalDecl] -> [Canonical.Def]
@@ -35,10 +36,10 @@ toDefs moduleName (A.A region decl) =
35 tbody = T.App (T.Type (typeVar name)) (map T.Var tvars)
36 tbody = T.App (T.Type (typeVar name)) (map T.Var tvars)
36 body = loc . E.Data ctor $ map (loc . E.localVar) vars
37 body = loc . E.Data ctor $ map (loc . E.localVar) vars
37 in
38 in
38− [ definition ctor (buildFunction body vars) (foldr T.Lambda tbody tipes) ]
39+ [ definition ctor (buildFunction body vars) region (foldr T.Lambda tbody tipes) ]
39
40
40 D.TypeAlias name tvars tipe@(T.Record fields ext) ->
41 D.TypeAlias name tvars tipe@(T.Record fields ext) ->
41− [ definition name (buildFunction record vars) (foldr T.Lambda result args) ]
42+ [ definition name (buildFunction record vars) region (foldr T.Lambda result args) ]
42 where
43 where
43 result =
44 result =
44 T.Aliased (typeVar name) (zip tvars (map T.Var tvars)) (T.Holey tipe)
45 T.Aliased (typeVar name) (zip tvars (map T.Var tvars)) (T.Holey tipe)
@@ -70,13 +71,13 @@ toDefs moduleName (A.A region decl) =
70 in
71 in
71 case impl of
72 case impl of
72 E.In name tipe ->
73 E.In name tipe ->
73− [ definition name body (T.getPortType tipe) ]
74+ [ definition name body region (T.getPortType tipe) ]
74
75
75 E.Out name _expr tipe ->
76 E.Out name _expr tipe ->
76− [ definition name body (T.getPortType tipe) ]
77+ [ definition name body region (T.getPortType tipe) ]
77
78
78 E.Task name _expr tipe ->
79 E.Task name _expr tipe ->
79− [ definition name body (T.getPortType tipe) ]
80+ [ definition name body region (T.getPortType tipe) ]
80
81
81 -- no constraints are needed for fixity declarations
82 -- no constraints are needed for fixity declarations
82 D.Fixity _ _ _ ->
83 D.Fixity _ _ _ ->
@@ -96,6 +97,6 @@ buildFunction body@(A.A ann _) vars =
96 (map (A.A ann . P.Var) vars)
97 (map (A.A ann . P.Var) vars)
97
98
98
99
99−definition :: String -> Canonical.Expr -> T.Canonical -> Canonical.Def
100+definition :: String -> Canonical.Expr -> R.Region -> T.Canonical -> Canonical.Def
100−definition name expr@(A.A ann _) tipe =
101+definition name expr@(A.A ann _) region tipe =
101− Canonical.Definition (A.A ann (P.Var name)) expr (Just tipe)
102+ Canonical.Definition (A.A ann (P.Var name)) expr (Just (A.A region tipe))
src/Type/Constrain/Expression.hs+2−2
@@ -416,11 +416,11 @@ data Info = Info
416
416
417
417
418constrainDef :: Env.Environment -> Info -> Canonical.Def -> IO Info
418constrainDef :: Env.Environment -> Info -> Canonical.Def -> IO Info
419−constrainDef env info (Canonical.Definition (A.A region pattern) expr maybeTipe) =
419+constrainDef env info (Canonical.Definition (A.A _ pattern) expr maybeTipe) =
420 let qs = [] -- should come from the def, but I'm not sure what would live there...
420 let qs = [] -- should come from the def, but I'm not sure what would live there...
421 in
421 in
422 case (pattern, maybeTipe) of
422 case (pattern, maybeTipe) of
423− (P.Var name, Just tipe) ->
423+ (P.Var name, Just (A.A region tipe)) ->
424 constrainAnnotatedDef env info qs region name expr tipe
424 constrainAnnotatedDef env info qs region name expr tipe
425
425
426 (P.Var name, Nothing) ->
426 (P.Var name, Nothing) ->