git.iko.soy/elk
on fbad8ea help sign in
elk/compiler/Transform/Check.hs
63 lines 1.9 kB history raw
1module Transform.Check (mistakes) where
3import Transform.SortDefinitions (boundVars)
4import SourceSyntax.Everything
5import qualified SourceSyntax.Type as T
6import Data.List as List
7import qualified Data.Map as Map
8import qualified Data.Set as Set
9import Data.Data
10import Data.Generics.Uniplate.Data
11import Text.PrettyPrint as P
14mistakes :: (Data t, Data v) => [Declaration t v] -> [Doc]
15mistakes decls =
16 map P.text $ concatMap findErrors (getLets decls)
17 where
18 findErrors defs = duplicates defs ++ badOrder defs
21getLets :: (Data t, Data v) => [Declaration t v] -> [[Def t v]]
22getLets decls = defs : concatMap getSubLets defs
23 where
24 defs = concatMap (\d -> case d of Definition d -> [d] ; _ -> []) decls
26 getSubLets def =
27 case def of
28 Def pattern expr -> [ defs | Let defs _ <- universeBi expr ]
29 TypeAnnotation _ _ -> []
32duplicates :: [Def t v] -> [String]
33duplicates defs =
34 map defMsg (dups definitions) ++ map annMsg (dups annotations)
35 where
36 annotations = List.sort [ name | TypeAnnotation name _ <- defs ]
37 definitions = List.sort $ concatMap Set.toList [ boundVars pattern | Def pattern _ <- defs ]
39 dups = map head . filter ((>1) . length) . List.group
41 msg = "Syntax Error: There can only be one "
42 defMsg x = msg ++ "definition of '" ++ x ++ "'."
43 annMsg x = msg ++ "type annotation for '" ++ x ++ "'."
46badOrder :: [Def t v] -> [String]
47badOrder defs = go defs
48 where
49 msg x = "Syntax Error: The type annotation for '" ++ x ++
50 "' must be directly above its definition."
52 go defs =
53 case defs of
54 TypeAnnotation name _ : Def (PVar name') _ : rest
55 | name == name' -> go rest
57 TypeAnnotation name _ : rest -> [msg name] ++ go rest
59 _ : rest -> go rest
61 _ -> []