@@ -111,16 +111,16 @@ checkTypeClassInstance _ _ = throwError "Type class instance must be of the form
111111--
112112-- * Process module imports
113113--
114−typeCheckAll :: ModuleName -> [Declaration] -> Check [Declaration]
115−typeCheckAll _ [] = return []
116−typeCheckAll moduleName (d@(DataDeclaration name args dctors) : rest) = do
114+typeCheckAll :: Maybe ModuleName -> ModuleName -> [Declaration] -> Check [Declaration]
115+typeCheckAll _ _ [] = return []
116+typeCheckAll mainModuleName moduleName (d@(DataDeclaration name args dctors) : rest) = do
117117 rethrow (("Error in type constructor " ++ show name ++ ":\n") ++) $ do
118118 typeIsNotDefined moduleName name
119119 ctorKind <- kindsOf moduleName name args (concatMap snd dctors)
120120 addDataType moduleName name args dctors ctorKind
121− ds <- typeCheckAll moduleName rest
121+ ds <- typeCheckAll mainModuleName moduleName rest
122122 return $ d : ds
123−typeCheckAll moduleName (d@(DataBindingGroupDeclaration tys) : rest) = do
123+typeCheckAll mainModuleName moduleName (d@(DataBindingGroupDeclaration tys) : rest) = do
124124 rethrow ("Error in data binding group:\n" ++) $ do
125125 let syns = mapMaybe toTypeSynonym tys
126126 let dataDecls = mapMaybe toDataDecl tys
@@ -131,48 +131,48 @@ typeCheckAll moduleName (d@(DataBindingGroupDeclaration tys) : rest) = do
131131 forM_ (zip syns syn_ks) $ \((name, args, ty), kind) -> do
132132 typeIsNotDefined moduleName name
133133 addTypeSynonym moduleName name args ty kind
134− ds <- typeCheckAll moduleName rest
134+ ds <- typeCheckAll mainModuleName moduleName rest
135135 return $ d : ds
136136 where
137137 toTypeSynonym (TypeSynonymDeclaration nm args ty) = Just (nm, args, ty)
138138 toTypeSynonym _ = Nothing
139139 toDataDecl (DataDeclaration nm args dctors) = Just (nm, args, dctors)
140140 toDataDecl _ = Nothing
141−typeCheckAll moduleName (d@(TypeSynonymDeclaration name args ty) : rest) = do
141+typeCheckAll mainModuleName moduleName (d@(TypeSynonymDeclaration name args ty) : rest) = do
142142 rethrow (("Error in type synonym " ++ show name ++ ":\n") ++) $ do
143143 typeIsNotDefined moduleName name
144144 kind <- kindsOf moduleName name args [ty]
145145 addTypeSynonym moduleName name args ty kind
146− ds <- typeCheckAll moduleName rest
146+ ds <- typeCheckAll mainModuleName moduleName rest
147147 return $ d : ds
148−typeCheckAll _ (TypeDeclaration _ _ : _) = error "Type declarations should have been removed"
149−typeCheckAll moduleName (ValueDeclaration name [] Nothing val : rest) = do
148+typeCheckAll _ _ (TypeDeclaration _ _ : _) = error "Type declarations should have been removed"
149+typeCheckAll mainModuleName moduleName (ValueDeclaration name [] Nothing val : rest) = do
150150 d <- rethrow (("Error in declaration " ++ show name ++ ":\n") ++) $ do
151151 valueIsNotDefined moduleName name
152− [(_, (val', ty))] <- typesOf moduleName [(name, val)]
152+ [(_, (val', ty))] <- typesOf mainModuleName moduleName [(name, val)]
153153 addValue moduleName name ty
154154 return $ ValueDeclaration name [] Nothing val'
155− ds <- typeCheckAll moduleName rest
155+ ds <- typeCheckAll mainModuleName moduleName rest
156156 return $ d : ds
157−typeCheckAll _ (ValueDeclaration _ _ _ _ : _) = error "Binders were not desugared"
158−typeCheckAll moduleName (BindingGroupDeclaration vals : rest) = do
157+typeCheckAll _ _ (ValueDeclaration _ _ _ _ : _) = error "Binders were not desugared"
158+typeCheckAll mainModuleName moduleName (BindingGroupDeclaration vals : rest) = do
159159 d <- rethrow (("Error in binding group " ++ show (map fst vals) ++ ":\n") ++) $ do
160160 forM_ (map fst vals) $ \name ->
161161 valueIsNotDefined moduleName name
162− tys <- typesOf moduleName vals
162+ tys <- typesOf mainModuleName moduleName vals
163163 vals' <- forM (zip (map fst vals) (map snd tys)) $ \(name, (val, ty)) -> do
164164 addValue moduleName name ty
165165 return (name, val)
166166 return $ BindingGroupDeclaration vals'
167− ds <- typeCheckAll moduleName rest
167+ ds <- typeCheckAll mainModuleName moduleName rest
168168 return $ d : ds
169−typeCheckAll moduleName (d@(ExternDataDeclaration name kind) : rest) = do
169+typeCheckAll mainModuleName moduleName (d@(ExternDataDeclaration name kind) : rest) = do
170170 env <- getEnv
171171 guardWith (show name ++ " is already defined") $ not $ M.member (moduleName, name) (types env)
172172 putEnv $ env { types = M.insert (moduleName, name) (kind, TypeSynonym) (types env) }
173− ds <- typeCheckAll moduleName rest
173+ ds <- typeCheckAll mainModuleName moduleName rest
174174 return $ d : ds
175−typeCheckAll moduleName (d@(ExternDeclaration importTy name _ ty) : rest) = do
175+typeCheckAll mainModuleName moduleName (d@(ExternDeclaration importTy name _ ty) : rest) = do
176176 rethrow (("Error in foreign import declaration " ++ show name ++ ":\n") ++) $ do
177177 env <- getEnv
178178 kind <- kindOf moduleName ty
@@ -180,14 +180,14 @@ typeCheckAll moduleName (d@(ExternDeclaration importTy name _ ty) : rest) = do
180180 case M.lookup (moduleName, name) (names env) of
181181 Just _ -> throwError $ show name ++ " is already defined"
182182 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
184184 return $ d : ds
185−typeCheckAll moduleName (d@(FixityDeclaration _ name) : rest) = do
186− ds <- typeCheckAll moduleName rest
185+typeCheckAll mainModuleName moduleName (d@(FixityDeclaration _ name) : rest) = do
186+ ds <- typeCheckAll mainModuleName moduleName rest
187187 env <- getEnv
188188 guardWith ("Fixity declaration with no binding: " ++ name) $ M.member (moduleName, Op name) $ names env
189189 return $ d : ds
190−typeCheckAll currentModule (d@(ImportDeclaration moduleName idents) : rest) = do
190+typeCheckAll mainModuleName currentModule (d@(ImportDeclaration moduleName idents) : rest) = do
191191 env <- getEnv
192192 rethrow errorMessage $ do
193193 guardWith ("Module " ++ show moduleName ++ " does not exist") $ moduleExists env
@@ -199,7 +199,7 @@ typeCheckAll currentModule (d@(ImportDeclaration moduleName idents) : rest) = do
199199 shadowIdents (lefts idents') env
200200 shadowTypes (rights idents') env
201201 shadowTypeClassInstances env
202− ds <- typeCheckAll currentModule rest
202+ ds <- typeCheckAll mainModuleName currentModule rest
203203 return $ d : ds
204204 where
205205 errorMessage = (("Error in import declaration " ++ show moduleName ++ ":\n") ++)
@@ -243,16 +243,16 @@ typeCheckAll currentModule (d@(ImportDeclaration moduleName idents) : rest) = do
243243 constructs (TypeApp (TypeApp t _) ty) pn | t == tyFunction = ty `constructs` pn
244244 constructs (TypeApp ty _) pn = ty `constructs` pn
245245 constructs fn _ = error $ "Invalid arguments to constructs: " ++ show fn
246−typeCheckAll moduleName (d@(TypeClassDeclaration _ _ _) : rest) = do
246+typeCheckAll mainModuleName moduleName (d@(TypeClassDeclaration _ _ _) : rest) = do
247247 env <- getEnv
248− ds <- typeCheckAll moduleName rest
248+ ds <- typeCheckAll mainModuleName moduleName rest
249249 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
251251 env <- getEnv
252252 dictName <- Check . lift $ mkDictionaryValueName moduleName className ty
253253 checkTypeClassInstance moduleName ty
254254 forM_ deps $ checkTypeClassInstance moduleName . snd
255255 addTypeClassDictionaries (qualifyAllUnqualifiedNames moduleName env
256256 [TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) className ty (Just deps) TCDRegular])
257− ds <- typeCheckAll moduleName rest
257+ ds <- typeCheckAll mainModuleName moduleName rest
258258 return $ qualifyAllUnqualifiedNames moduleName env d : ds