@@ -107,9 +107,12 @@ addType :: ExportEnvironment -> ModuleName -> ProperName -> [ProperName] -> Eith
107addType env mn name dctors = updateExportedModule env mn $ \m -> do
107addType env mn name dctors = updateExportedModule env mn $ \m -> do
108 let exTypes = exportedTypes m
108 let exTypes = exportedTypes m
109 let exDctors = snd `concatMap` exTypes
109 let exDctors = snd `concatMap` exTypes
110+ let exClasses = exportedTypeClasses m
110 when (any ((== name) . fst) exTypes) $ throwMultipleDefError "type" name
111 when (any ((== name) . fst) exTypes) $ throwMultipleDefError "type" name
112+ when (any (== name) exClasses) $ throwConflictingDefError "Type" "type class" name
111− forM_ dctors $ \dctor ->
113+ forM_ dctors $ \dctor -> do
112 when (any (== dctor) exDctors) $ throwMultipleDefError "data constructor" dctor
114 when (any (== dctor) exDctors) $ throwMultipleDefError "data constructor" dctor
115+ when (any (== dctor) exClasses) $ throwConflictingDefError "Data constructor" "type class" dctor
113 return $ m { exportedTypes = (name, dctors) : exTypes }
116 return $ m { exportedTypes = (name, dctors) : exTypes }
@@ -117,6 +120,10 @@ addType env mn name dctors = updateExportedModule env mn $ \m -> do
118addTypeClass :: ExportEnvironment -> ModuleName -> ProperName -> Either ErrorStack ExportEnvironment
121addTypeClass :: ExportEnvironment -> ModuleName -> ProperName -> Either ErrorStack ExportEnvironment
119addTypeClass env mn name = updateExportedModule env mn $ \m -> do
122addTypeClass env mn name = updateExportedModule env mn $ \m -> do
123+ let exTypes = exportedTypes m
124+ let exDctors = snd `concatMap` exTypes
125+ when (any ((== name) . fst) exTypes) $ throwConflictingDefError "Type class" "type" name
126+ when (any (== name) exDctors) $ throwConflictingDefError "Type class" "data constructor" name
120 classes <- addExport "type class" (exportedTypeClasses m) name
127 classes <- addExport "type class" (exportedTypeClasses m) name
121 return $ m { exportedTypeClasses = classes }
128 return $ m { exportedTypeClasses = classes }
@@ -535,3 +542,11 @@ throwMultipleDefError :: (Show a) => String -> a -> Either ErrorStack b
535throwMultipleDefError what name = throwError $
542throwMultipleDefError what name = throwError $
536 mkErrorStack ("Multiple definitions for " ++ what ++ " '" ++ show name ++ "'") Nothing
543 mkErrorStack ("Multiple definitions for " ++ what ++ " '" ++ show name ++ "'") Nothing
546+-- Raises an error for when there is a conflicting definition for something, for example, a type
547+-- class and data constructor of the same name.
549+throwConflictingDefError :: (Show a) => String -> String -> a -> Either ErrorStack b
550+throwConflictingDefError what1 what2 name = throwError $
551+ mkErrorStack (what1 ++ " '" ++ show name ++ "' cannot be defined in the same module as a " ++ what2 ++ " of the same name") Nothing