Report errors for duplicate definitions

passes/src/Luna/Pass/Data/Error.hs

@@ -5,7 +5,7 @@
 
 module Luna.Pass.Data.Error where
 
-import Prologue
+import Prologue hiding (intercalate)
 
 import qualified Control.Monad.State.Layered           as State
 import qualified Data.Construction                     as Data
@@ -19,12 +19,14 @@ import qualified Data.Graph.Store.Size.Discovery       as Buffer
 import qualified Data.Mutable.Class                    as Mutable
 import qualified Foreign.Storable.Deriving             as Storable
 import qualified Luna.Pass.Typing.Data.Target          as Target
+import qualified Luna.Pass.Resolve.Data.Resolution     as Resolution
 import qualified Luna.IR                               as IR
 import qualified Luna.IR.Layer                         as Layer
 import qualified Luna.IR.Term.Ast.Invalid              as Invalid
 
 import Data.Graph.Data.Layer.Class           (Layer)
 import Data.Mutable.Storable.SmallAutoVector (UnmanagedSmallVector)
+import Data.Text                             (intercalate)
 import Luna.Pass.Typing.Data.Target          (Target)
 
 data CompileError = CompileError
@@ -121,6 +123,22 @@ functionNotFound mod n = CompileError msg mempty mempty where
     msg =  "Function not found: "
         <> convertVia @String mod <> "." <> convert n
 
+duplicateFunctionDefinition :: IR.Qualified -> IR.Name -> CompileError
+duplicateFunctionDefinition mod n = CompileError msg mempty mempty where
+    msg =  "Duplicate function definition: "
+        <> convert n <> " in module " <> convertVia @String mod
+
+duplicateClassDefinition :: IR.Qualified -> IR.Name -> CompileError
+duplicateClassDefinition mod cls = CompileError msg mempty mempty where
+    msg =  "Duplicate class definition: "
+        <> convert cls <> " in module " <> convertVia @String mod
+
+duplicateMethodDefinition :: IR.Qualified -> IR.Name -> IR.Name -> CompileError
+duplicateMethodDefinition mod cls n = CompileError msg mempty mempty where
+    msg =  "Duplicate method definition: "
+        <> convert n <> " in class " <> convert cls
+        <> " in module " <> convertVia @String mod
+
 unexpectedFunctionNotFound :: IR.Qualified -> IR.Name -> CompileError
 unexpectedFunctionNotFound = unexpected .: functionNotFound
 
@@ -162,6 +180,14 @@ consNotFound :: IR.Name -> CompileError
 consNotFound n = CompileError msg mempty mempty where
     msg = "Constructor " <> convert n <> " is not in scope."
 
+consAmbiguous :: IR.Name -> [Resolution.ConsRef] -> CompileError
+consAmbiguous n consRefs = CompileError msg mempty mempty where
+    msg = "Constructor " <> convert n <> " is ambiguous. "
+       <> "It is defined in classes: "
+       <> intercalate ", " (map showRef consRefs)
+    showRef (Resolution.ConsRef unitName className _) =
+        convertVia @String unitName <> "." <> convert className
+
 placeholderError :: CompileError
 placeholderError = unexpected $ CompileError "placeholder" mempty mempty
 

passes/src/Luna/Pass/Resolve/ConsResolution.hs

@@ -49,6 +49,8 @@ resolveConstructors positive root = Layer.read @IR.Model root >>= \case
                                          (Layout.unsafeRelayout root)
                                          consRef
                 IR.replace new root
+            Ambiguous conses ->
+                Error.setError (Just $ Error.consAmbiguous n conses) root
             _ -> Error.setError (Just $ Error.consNotFound n) root
     Uni.Unify l r -> do
         resolveConstructors False =<< IR.source l

passes/src/Luna/Pass/Sourcing/ClassProcessor.hs

@@ -18,6 +18,7 @@ import qualified Luna.IR.Layer                         as Layer
 import qualified Luna.Pass                             as Pass
 import qualified Luna.Pass.Attr                        as Attr
 import qualified Luna.Pass.Basic                       as Pass
+import qualified Luna.Pass.Data.Error                  as Error
 import qualified Luna.Pass.Data.Stage                  as TC
 import qualified Luna.Pass.Sourcing.Data.Class         as Class
 import qualified Luna.Pass.Sourcing.Data.Def           as Def
@@ -223,6 +224,10 @@ registerMethod = \modName clsName paramNames map t -> do
                                    $ Layout.unsafeRelayout root
                     IR.replace newRoot root
                     let documented = Documented doc (Def.Body newRoot)
+                    when_ (isJust $ map ^. wrapped . at name) $ do
+                        let error = Error.duplicateMethodDefinition
+                                modName clsName name
+                        Error.setError (Just error) newRoot
                     return $ map & wrapped . at name .~ Just documented
                 _ -> return map
         _ -> return map

passes/src/Luna/Pass/Sourcing/UnitMapper.hs

@@ -13,6 +13,7 @@ import qualified Luna.IR.Aliases                  as Uni
 import qualified Luna.IR.Layer                    as Layer
 import qualified Luna.Pass                        as Pass
 import qualified Luna.Pass.Attr                   as Attr
+import qualified Luna.Pass.Data.Error             as Error
 import qualified Luna.Pass.Data.Stage             as TC
 import qualified Luna.Pass.Scheduler              as Scheduler
 import qualified Luna.Pass.Sourcing.Data.Def      as Def
@@ -30,7 +31,7 @@ data UnitMapper
 
 type instance Pass.Spec UnitMapper t = UnitMapperSpec t
 type family UnitMapperSpec t where
-    UnitMapperSpec (Pass.In  Pass.Attrs) = '[Root]
+    UnitMapperSpec (Pass.In  Pass.Attrs) = '[Root, Unit.Name]
     UnitMapperSpec (Pass.Out Pass.Attrs) = '[PartiallyMappedUnit]
     UnitMapperSpec t = Pass.BasicPassSpec t
 
@@ -47,28 +48,33 @@ makeLenses ''PartiallyMappedUnit
 instance Pass.Definition TC.Stage UnitMapper where
     definition = do
         Root root <- Attr.get
-        unitMap   <- partiallyMapUnit $ Layout.unsafeRelayout root
+        Unit.Name unitName <- Attr.get
+        unitMap   <- partiallyMapUnit unitName $ Layout.unsafeRelayout root
         Attr.put unitMap
 
-partiallyMapUnit :: IR.Term IR.Unit -> TC.Pass UnitMapper PartiallyMappedUnit
-partiallyMapUnit root = do
+partiallyMapUnit :: IR.Qualified -> IR.Term IR.Unit -> TC.Pass UnitMapper PartiallyMappedUnit
+partiallyMapUnit unitName root = do
     IR.Unit _ _ cls <- IR.modelView root
     klass <- IR.source cls
     Layer.read @IR.Model klass >>= \case
         Uni.Record _ _ _ _ decls' -> do
             decls <- traverse IR.source =<< ComponentVector.toList decls'
-            foldM registerDecl def decls
+            foldM (registerDecl unitName) def decls
         _ -> return def
 
-registerDecl :: PartiallyMappedUnit -> IR.SomeTerm -> TC.Pass UnitMapper PartiallyMappedUnit
-registerDecl map t = do
+registerDecl :: IR.Qualified -> PartiallyMappedUnit -> IR.SomeTerm -> TC.Pass UnitMapper PartiallyMappedUnit
+registerDecl unitName map t = do
     (doc, root) <- Sourcing.cutDoc t
     Layer.read @IR.Model root >>= \case
         Uni.Function n _ _ -> do
             IR.source n >>= Layer.read @IR.Model >>= \case
                 Uni.Var name -> do
                     let documented =
                           Documented doc (Def.Body $ Layout.unsafeRelayout root)
+                    when_ (isJust $ map ^. defs . wrapped . at name) $ do
+                        let error = Error.duplicateFunctionDefinition
+                                unitName name
+                        Error.setError (Just error) root
                     return $ map & defs . wrapped . at name .~ Just documented
                 _ -> return map
         Uni.Record _ n _ _ _ -> do