@@ -111,16 +111,16 @@ checkTypeClassInstance _ _ = throwError "Type class instance must be of the form
112-- * Process module imports
112-- * Process module imports
114−typeCheckAll :: ModuleName -> [Declaration] -> Check [Declaration]
114+typeCheckAll :: Maybe ModuleName -> ModuleName -> [Declaration] -> Check [Declaration]
115−typeCheckAll _ [] = return []
115+typeCheckAll _ _ [] = return []
116−typeCheckAll moduleName (d@(DataDeclaration name args dctors) : rest) = do
116+typeCheckAll mainModuleName moduleName (d@(DataDeclaration name args dctors) : rest) = do
117 rethrow (("Error in type constructor " ++ show name ++ ":\n") ++) $ do
117 rethrow (("Error in type constructor " ++ show name ++ ":\n") ++) $ do
118 typeIsNotDefined moduleName name
118 typeIsNotDefined moduleName name
119 ctorKind <- kindsOf moduleName name args (concatMap snd dctors)
119 ctorKind <- kindsOf moduleName name args (concatMap snd dctors)
120 addDataType moduleName name args dctors ctorKind
120 addDataType moduleName name args dctors ctorKind
121− ds <- typeCheckAll moduleName rest
121+ ds <- typeCheckAll mainModuleName moduleName rest
122 return $ d : ds
122 return $ d : ds
123−typeCheckAll moduleName (d@(DataBindingGroupDeclaration tys) : rest) = do
123+typeCheckAll mainModuleName moduleName (d@(DataBindingGroupDeclaration tys) : rest) = do
124 rethrow ("Error in data binding group:\n" ++) $ do
124 rethrow ("Error in data binding group:\n" ++) $ do
125 let syns = mapMaybe toTypeSynonym tys
125 let syns = mapMaybe toTypeSynonym tys
126 let dataDecls = mapMaybe toDataDecl tys
126 let dataDecls = mapMaybe toDataDecl tys
@@ -131,48 +131,48 @@ typeCheckAll moduleName (d@(DataBindingGroupDeclaration tys) : rest) = do
131 forM_ (zip syns syn_ks) $ \((name, args, ty), kind) -> do
131 forM_ (zip syns syn_ks) $ \((name, args, ty), kind) -> do
132 typeIsNotDefined moduleName name
132 typeIsNotDefined moduleName name
133 addTypeSynonym moduleName name args ty kind
133 addTypeSynonym moduleName name args ty kind
134− ds <- typeCheckAll moduleName rest
134+ ds <- typeCheckAll mainModuleName moduleName rest
135 return $ d : ds
135 return $ d : ds
137 toTypeSynonym (TypeSynonymDeclaration nm args ty) = Just (nm, args, ty)
137 toTypeSynonym (TypeSynonymDeclaration nm args ty) = Just (nm, args, ty)
138 toTypeSynonym _ = Nothing
138 toTypeSynonym _ = Nothing
139 toDataDecl (DataDeclaration nm args dctors) = Just (nm, args, dctors)
139 toDataDecl (DataDeclaration nm args dctors) = Just (nm, args, dctors)
140 toDataDecl _ = Nothing
140 toDataDecl _ = Nothing
141−typeCheckAll moduleName (d@(TypeSynonymDeclaration name args ty) : rest) = do
141+typeCheckAll mainModuleName moduleName (d@(TypeSynonymDeclaration name args ty) : rest) = do
142 rethrow (("Error in type synonym " ++ show name ++ ":\n") ++) $ do
142 rethrow (("Error in type synonym " ++ show name ++ ":\n") ++) $ do
143 typeIsNotDefined moduleName name
143 typeIsNotDefined moduleName name
144 kind <- kindsOf moduleName name args [ty]
144 kind <- kindsOf moduleName name args [ty]
145 addTypeSynonym moduleName name args ty kind
145 addTypeSynonym moduleName name args ty kind
146− ds <- typeCheckAll moduleName rest
146+ ds <- typeCheckAll mainModuleName moduleName rest
147 return $ d : ds
147 return $ d : ds
148−typeCheckAll _ (TypeDeclaration _ _ : _) = error "Type declarations should have been removed"
148+typeCheckAll _ _ (TypeDeclaration _ _ : _) = error "Type declarations should have been removed"
149−typeCheckAll moduleName (ValueDeclaration name [] Nothing val : rest) = do
149+typeCheckAll mainModuleName moduleName (ValueDeclaration name [] Nothing val : rest) = do
150 d <- rethrow (("Error in declaration " ++ show name ++ ":\n") ++) $ do
150 d <- rethrow (("Error in declaration " ++ show name ++ ":\n") ++) $ do
151 valueIsNotDefined moduleName name
151 valueIsNotDefined moduleName name
152− [(_, (val', ty))] <- typesOf moduleName [(name, val)]
152+ [(_, (val', ty))] <- typesOf mainModuleName moduleName [(name, val)]
153 addValue moduleName name ty
153 addValue moduleName name ty
154 return $ ValueDeclaration name [] Nothing val'
154 return $ ValueDeclaration name [] Nothing val'
155− ds <- typeCheckAll moduleName rest
155+ ds <- typeCheckAll mainModuleName moduleName rest
156 return $ d : ds
156 return $ d : ds
157−typeCheckAll _ (ValueDeclaration _ _ _ _ : _) = error "Binders were not desugared"
157+typeCheckAll _ _ (ValueDeclaration _ _ _ _ : _) = error "Binders were not desugared"
158−typeCheckAll moduleName (BindingGroupDeclaration vals : rest) = do
158+typeCheckAll mainModuleName moduleName (BindingGroupDeclaration vals : rest) = do
159 d <- rethrow (("Error in binding group " ++ show (map fst vals) ++ ":\n") ++) $ do
159 d <- rethrow (("Error in binding group " ++ show (map fst vals) ++ ":\n") ++) $ do
160 forM_ (map fst vals) $ \name ->
160 forM_ (map fst vals) $ \name ->
161 valueIsNotDefined moduleName name
161 valueIsNotDefined moduleName name
162− tys <- typesOf moduleName vals
162+ tys <- typesOf mainModuleName moduleName vals
163 vals' <- forM (zip (map fst vals) (map snd tys)) $ \(name, (val, ty)) -> do
163 vals' <- forM (zip (map fst vals) (map snd tys)) $ \(name, (val, ty)) -> do
164 addValue moduleName name ty
164 addValue moduleName name ty
165 return (name, val)
165 return (name, val)
166 return $ BindingGroupDeclaration vals'
166 return $ BindingGroupDeclaration vals'
167− ds <- typeCheckAll moduleName rest
167+ ds <- typeCheckAll mainModuleName moduleName rest
168 return $ d : ds
168 return $ d : ds
169−typeCheckAll moduleName (d@(ExternDataDeclaration name kind) : rest) = do
169+typeCheckAll mainModuleName moduleName (d@(ExternDataDeclaration name kind) : rest) = do
170 env <- getEnv
170 env <- getEnv
171 guardWith (show name ++ " is already defined") $ not $ M.member (moduleName, name) (types env)
171 guardWith (show name ++ " is already defined") $ not $ M.member (moduleName, name) (types env)
172 putEnv $ env { types = M.insert (moduleName, name) (kind, TypeSynonym) (types env) }
172 putEnv $ env { types = M.insert (moduleName, name) (kind, TypeSynonym) (types env) }
173− ds <- typeCheckAll moduleName rest
173+ ds <- typeCheckAll mainModuleName moduleName rest
174 return $ d : ds
174 return $ d : ds
175−typeCheckAll moduleName (d@(ExternDeclaration importTy name _ ty) : rest) = do
175+typeCheckAll mainModuleName moduleName (d@(ExternDeclaration importTy name _ ty) : rest) = do
176 rethrow (("Error in foreign import declaration " ++ show name ++ ":\n") ++) $ do
176 rethrow (("Error in foreign import declaration " ++ show name ++ ":\n") ++) $ do
177 env <- getEnv
177 env <- getEnv
178 kind <- kindOf moduleName ty
178 kind <- kindOf moduleName ty
@@ -180,14 +180,14 @@ typeCheckAll moduleName (d@(ExternDeclaration importTy name _ ty) : rest) = do
180 case M.lookup (moduleName, name) (names env) of
180 case M.lookup (moduleName, name) (names env) of
181 Just _ -> throwError $ show name ++ " is already defined"
181 Just _ -> throwError $ show name ++ " is already defined"
182 Nothing -> putEnv (env { names = M.insert (moduleName, name) (qualifyAllUnqualifiedNames moduleName env ty, Extern importTy) (names env) })
182 Nothing -> putEnv (env { names = M.insert (moduleName, name) (qualifyAllUnqualifiedNames moduleName env ty, Extern importTy) (names env) })
183− ds <- typeCheckAll moduleName rest
183+ ds <- typeCheckAll mainModuleName moduleName rest
184 return $ d : ds
184 return $ d : ds
185−typeCheckAll moduleName (d@(FixityDeclaration _ name) : rest) = do
185+typeCheckAll mainModuleName moduleName (d@(FixityDeclaration _ name) : rest) = do
186− ds <- typeCheckAll moduleName rest
186+ ds <- typeCheckAll mainModuleName moduleName rest
187 env <- getEnv
187 env <- getEnv
188 guardWith ("Fixity declaration with no binding: " ++ name) $ M.member (moduleName, Op name) $ names env
188 guardWith ("Fixity declaration with no binding: " ++ name) $ M.member (moduleName, Op name) $ names env
189 return $ d : ds
189 return $ d : ds
190−typeCheckAll currentModule (d@(ImportDeclaration moduleName idents) : rest) = do
190+typeCheckAll mainModuleName currentModule (d@(ImportDeclaration moduleName idents) : rest) = do
191 env <- getEnv
191 env <- getEnv
192 rethrow errorMessage $ do
192 rethrow errorMessage $ do
193 guardWith ("Module " ++ show moduleName ++ " does not exist") $ moduleExists env
193 guardWith ("Module " ++ show moduleName ++ " does not exist") $ moduleExists env
@@ -199,7 +199,7 @@ typeCheckAll currentModule (d@(ImportDeclaration moduleName idents) : rest) = do
199 shadowIdents (lefts idents') env
199 shadowIdents (lefts idents') env
200 shadowTypes (rights idents') env
200 shadowTypes (rights idents') env
201 shadowTypeClassInstances env
201 shadowTypeClassInstances env
202− ds <- typeCheckAll currentModule rest
202+ ds <- typeCheckAll mainModuleName currentModule rest
203 return $ d : ds
203 return $ d : ds
205 errorMessage = (("Error in import declaration " ++ show moduleName ++ ":\n") ++)
205 errorMessage = (("Error in import declaration " ++ show moduleName ++ ":\n") ++)
@@ -243,16 +243,16 @@ typeCheckAll currentModule (d@(ImportDeclaration moduleName idents) : rest) = do
243 constructs (TypeApp (TypeApp t _) ty) pn | t == tyFunction = ty `constructs` pn
243 constructs (TypeApp (TypeApp t _) ty) pn | t == tyFunction = ty `constructs` pn
244 constructs (TypeApp ty _) pn = ty `constructs` pn
244 constructs (TypeApp ty _) pn = ty `constructs` pn
245 constructs fn _ = error $ "Invalid arguments to constructs: " ++ show fn
245 constructs fn _ = error $ "Invalid arguments to constructs: " ++ show fn
246−typeCheckAll moduleName (d@(TypeClassDeclaration _ _ _) : rest) = do
246+typeCheckAll mainModuleName moduleName (d@(TypeClassDeclaration _ _ _) : rest) = do
247 env <- getEnv
247 env <- getEnv
248− ds <- typeCheckAll moduleName rest
248+ ds <- typeCheckAll mainModuleName moduleName rest
249 return $ qualifyAllUnqualifiedNames moduleName env d : ds
249 return $ qualifyAllUnqualifiedNames moduleName env d : ds
250−typeCheckAll moduleName (d@(TypeInstanceDeclaration deps className ty _) : rest) = do
250+typeCheckAll mainModuleName moduleName (d@(TypeInstanceDeclaration deps className ty _) : rest) = do
251 env <- getEnv
251 env <- getEnv
252 dictName <- Check . lift $ mkDictionaryValueName moduleName className ty
252 dictName <- Check . lift $ mkDictionaryValueName moduleName className ty
253 checkTypeClassInstance moduleName ty
253 checkTypeClassInstance moduleName ty
254 forM_ deps $ checkTypeClassInstance moduleName . snd
254 forM_ deps $ checkTypeClassInstance moduleName . snd
255 addTypeClassDictionaries (qualifyAllUnqualifiedNames moduleName env
255 addTypeClassDictionaries (qualifyAllUnqualifiedNames moduleName env
256 [TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) className ty (Just deps) TCDRegular])
256 [TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) className ty (Just deps) TCDRegular])
257− ds <- typeCheckAll moduleName rest
257+ ds <- typeCheckAll mainModuleName moduleName rest
258 return $ qualifyAllUnqualifiedNames moduleName env d : ds
258 return $ qualifyAllUnqualifiedNames moduleName env d : ds