git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Disallow class/type or class/dctor name overlaps
commitf987838ddb8c5af9dfaf48ec327effd718ea34bb authorGary Burgess <gary.burgess@gmail.com> dateFri 6 Feb 2015, 15:20 (12 years ago) parent26b82ea
1 file changed+16−1
src/Language/PureScript/Sugar/Names.hs+16−1
src/Language/PureScript/Sugar/Names.hs+16−1
@@ -107,9 +107,12 @@ addType :: ExportEnvironment -> ModuleName -> ProperName -> [ProperName] -> Eith
107107addType env mn name dctors = updateExportedModule env mn $ \m -> do
108108 let exTypes = exportedTypes m
109109 let exDctors = snd `concatMap` exTypes
110+ let exClasses = exportedTypeClasses m
110111 when (any ((== name) . fst) exTypes) $ throwMultipleDefError "type" name
111− forM_ dctors $ \dctor ->
112+ when (any (== name) exClasses) $ throwConflictingDefError "Type" "type class" name
113+ forM_ dctors $ \dctor -> do
112114 when (any (== dctor) exDctors) $ throwMultipleDefError "data constructor" dctor
115+ when (any (== dctor) exClasses) $ throwConflictingDefError "Data constructor" "type class" dctor
113116 return $ m { exportedTypes = (name, dctors) : exTypes }
114117
115118-- |
@@ -117,6 +120,10 @@ addType env mn name dctors = updateExportedModule env mn $ \m -> do
117120--
118121addTypeClass :: ExportEnvironment -> ModuleName -> ProperName -> Either ErrorStack ExportEnvironment
119122addTypeClass 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
120127 classes <- addExport "type class" (exportedTypeClasses m) name
121128 return $ m { exportedTypeClasses = classes }
122129
@@ -535,3 +542,11 @@ throwMultipleDefError :: (Show a) => String -> a -> Either ErrorStack b
535542throwMultipleDefError what name = throwError $
536543 mkErrorStack ("Multiple definitions for " ++ what ++ " '" ++ show name ++ "'") Nothing
537544
545+-- |
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.
548+--
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
552+