@@ -49,15 +49,8 @@ dealias aliases t =
4949 RecordT r t -> RecordT (Map.map (map f) r) (f t)
5050 _ -> t
5151
52−--mistakes :: [Def t v] -> [String]
53−mistakes defs = badKinds defs -- ++ dups defs ++ badOrder defs
54−
55−extractDefs :: [Declaration t v] -> [Def t v]
56−extractDefs = concatMap keepDef
57− where
58− keepDef decl = case decl of
59− Definition def -> [def]
60− _ -> []
52+mistakes :: (Data t, Data v) => [Declaration t v] -> [String]
53+mistakes decls = badKinds decls ++ dups decls ++ badOrder decls
6154
6255badKinds :: (Data t, Data v) => [Declaration t v] -> [String]
6356badKinds decls = map msg (concatMap bad decls)
@@ -66,7 +59,7 @@ badKinds decls = map msg (concatMap bad decls)
6659 "' was given the wrong number of arguments."
6760
6861 aliases :: AliasDict
69− aliases = Map.empty
62+ aliases = get decls
7063
7164 badType :: Type -> [String]
7265 badType t =
@@ -107,32 +100,34 @@ annotation s =
107100definition :: Declaration t v -> [String]
108101definition s =
109102 case s of
110− Definition d -> [defName d]
103+ Definition d -> defName d
111104 _ -> []
112105
113−defName :: Def t v -> String
106+defName :: Def t v -> [String]
114107defName d =
115108 case d of
116− FnDef n _ _ -> n
117− OpDef n _ _ _ -> n
109+ FnDef n _ _ -> [n]
110+ OpDef n _ _ _ -> [n]
111+ _ -> []
118112
119113dups :: [Declaration t v] -> [String]
120−dups defs = map defMsg (dup definition) ++ map annMsg (dup annotation)
114+dups decls = map defMsg (dup definition) ++ map annMsg (dup annotation)
121115 where
122116 --dup :: (Declaration t v -> [String]) -> [String]
123− dup f = map head . filter ((>1) . length) . group . sort $ concatMap f defs
117+ dup f = map head . filter ((>1) . length) . group . sort $ concatMap f decls
124118
125119 msg = "Syntax Error: There can only be one "
126120 defMsg x = msg ++ "top-level definition of '" ++ x ++ "'."
127121 annMsg x = msg ++ "type annotation for '" ++ x ++ "'."
128122
129−--badOrder :: [Def t v] -> [String]
130−badOrder defs = map msg $ missings (sort $ expectedPairs as ds) (sort $ actualPairs defs)
123+badOrder :: (Data t, Data v) => [Declaration t v] -> [String]
124+badOrder decls =
125+ map msg $ missings (sort $ expectedPairs as ds) (sort $ actualPairs decls)
131126 where
132127 msg x = "Syntax Error: The type annotation for '" ++ x ++
133128 "' must be directly above its definition."
134− as = sort $ concatMap annotation defs
135− ds = sort $ concatMap definition defs
129+ as = sort $ concatMap annotation decls
130+ ds = sort $ concatMap definition decls
136131
137132 expectedPairs :: [String] -> [String] -> [String]
138133 expectedPairs as ds =
@@ -144,10 +139,12 @@ badOrder defs = map msg $ missings (sort $ expectedPairs as ds) (sort $ actualPa
144139 ( _ , _ ) -> []
145140
146141 --actualPairs :: [Def t v] -> [String]
147− actualPairs defs =
148− case defs of
149− Definition (TypeAnnotation n _) : Definition d : rest ->
150− (if n == defName d then [n] else []) ++ actualPairs rest
142+ actualPairs decls =
143+ case decls of
144+ Definition (TypeAnnotation n _) : Definition (FnDef m _ _) : rest ->
145+ (if n == m then [n] else []) ++ actualPairs rest
146+ Definition (TypeAnnotation n _) : Definition (OpDef m _ _ _) : rest ->
147+ (if n == m then [n] else []) ++ actualPairs rest
151148 t:s:rest -> actualPairs (s:rest)
152149 _ -> []
153150