update: round 2 of comments

Author: cstml

lambda-buffers-compiler/src/LambdaBuffers/Compiler/KindCheck.hs

@@ -117,7 +117,7 @@ globalStrategy = reinterpret $ \case
 
 moduleStrategy :: Transform GlobalCheck ModuleCheck
 moduleStrategy = reinterpret $ \case
-  CreateContext ci -> evalState (mempty @(M.Map Variable P.TyName)) . resolveCreateContext $ ci
+  CreateContext ci -> evalState (mempty @(M.Map Variable P.TyDef)) . resolveCreateContext $ ci
   ValidateModule cx md -> do
     traverse_ (kCTypeDefinition (module2ModuleName md) cx) (md ^. #typeDefs)
     traverse_ (kCClassInstance cx) (md ^. #instances)
@@ -190,35 +190,50 @@ tyDef2TyName (P.TyDef n _ _) = n
 -}
 resolveCreateContext ::
   forall effs.
-  Member (State (M.Map Variable P.TyName)) effs =>
+  Member (State (M.Map Variable P.TyDef)) effs =>
   Member Err effs =>
   P.CompilerInput ->
   Eff effs Context
 resolveCreateContext ci = do
   ctxs <- traverse module2Context (ci ^. #modules)
   pure $ mconcat ctxs
 
-module2Context :: forall effs. Member (State (M.Map Variable P.TyName)) effs => Member Err effs => P.Module -> Eff effs Context
+module2Context ::
+  forall effs.
+  Member (State (M.Map Variable P.TyDef)) effs =>
+  Member Err effs =>
+  P.Module ->
+  Eff effs Context
 module2Context m = do
   let typeDefinitions = m ^. #typeDefs
-  ctxs <- traverse (tyDef2Context (moduleName2ModName (m ^. #moduleName))) typeDefinitions
+  ctxs <- runReader (m ^. #moduleName) $ do
+    traverse (tyDef2Context (moduleName2ModName (m ^. #moduleName))) typeDefinitions
   pure $ mconcat ctxs
 
 -- | Creates a Context entry from one type definition.
-tyDef2Context :: forall effs. Member (State (M.Map Variable P.TyName)) effs => Member Err effs => ModName -> P.TyDef -> Eff effs Context
-tyDef2Context curModName tyDef@(P.TyDef tyName _ _) = do
+tyDef2Context ::
+  forall effs.
+  Member (Reader P.ModuleName) effs =>
+  Member (State (M.Map Variable P.TyDef)) effs =>
+  Member Err effs =>
+  ModName ->
+  P.TyDef ->
+  Eff effs Context
+tyDef2Context curModName tyDef = do
   r@(v, _) <- tyDef2NameAndKind curModName tyDef
-  associateName v tyName
+  associateName v tyDef
   pure $ mempty & context .~ uncurry M.singleton r
   where
     -- Ads the name to our map - we can use its SourceLocation in the case of a
     -- double use. If it's already in our map - that means we've double declared it.
-    associateName :: Variable -> P.TyName -> Eff effs ()
-    associateName v t = do
-      maps <- get @(M.Map Variable P.TyName)
+    associateName :: Variable -> P.TyDef -> Eff effs ()
+    associateName v curTyDef = do
+      modName <- ask
+      maps <- get @(M.Map Variable P.TyDef)
       case maps M.!? v of
-        Just otherTyName -> throwError . PT.CompKindCheckError $ PT.MultipleTyDefError otherTyName t
-        Nothing -> modify (M.insert v t)
+        Just otherTyDef ->
+          throwError . PT.CompKindCheckError $ PT.MultipleTyDefError modName [otherTyDef, curTyDef]
+        Nothing -> modify (M.insert v curTyDef)
 
 {- | Converts the Proto Module name to a local modname - dropping the
  information.

lambda-buffers-compiler/src/LambdaBuffers/Compiler/ProtoCompat.hs

@@ -568,8 +568,8 @@ instance IsMessage P.KindCheckError KindCheckError where
             <*> fromProto (err ^. P.definedKind)
         P.KindCheckError'MultipleTydefError err ->
           MultipleTyDefError
-            <$> fromProto (err ^. P.declaration1)
-            <*> fromProto (err ^. P.declaration2)
+            <$> fromProto (err ^. P.moduleName)
+            <*> traverse fromProto (err ^. P.tyDefs)
       Nothing -> throwProtoError EmptyField
 
   toProto = \case
@@ -590,10 +590,10 @@ instance IsMessage P.KindCheckError KindCheckError where
         & (P.inconsistentTypeError . P.tyName) .~ toProto name
         & (P.inconsistentTypeError . P.inferredKind) .~ toProto ki
         & (P.inconsistentTypeError . P.definedKind) .~ toProto kd
-    MultipleTyDefError d1 d2 ->
+    MultipleTyDefError m ds ->
       defMessage
-        & (P.multipleTydefError . P.declaration1) .~ toProto d1
-        & (P.multipleTydefError . P.declaration2) .~ toProto d2
+        & (P.multipleTydefError . P.moduleName) .~ toProto m
+        & (P.multipleTydefError . P.tyDefs) .~ (toProto <$> ds)
 
 instance IsMessage P.CompilerError CompilerError where
   fromProto cErr = case cErr ^. P.maybe'compilerError of

lambda-buffers-compiler/src/LambdaBuffers/Compiler/ProtoCompat/Types.hs

@@ -305,16 +305,11 @@ instance Arbitrary CompilerInput where
       fn n = CompilerInput <$> resize n arbitrary
 
 data KindCheckError
-  = -- | The following term is unbound in the following type definition.
-    UnboundTermError TyName VarName
-  | -- | Failed unifying TyRef with TyRef in TyName. This is the TyDef.
-    IncorrectApplicationError TyName Kind Kind
-  | -- | Kind recurses forever - not permitted.
-    RecursiveKindError TyName
-  | -- | The following type has the wrong.
-    InconsistentTypeError TyName Kind Kind
-  | -- | The following type@(TyName) was redeclared here@(TyName).
-    MultipleTyDefError TyName TyName
+  = UnboundTermError TyName VarName
+  | IncorrectApplicationError TyName Kind Kind
+  | RecursiveKindError TyName
+  | InconsistentTypeError TyName Kind Kind
+  | MultipleTyDefError ModuleName [TyDef]
   deriving stock (Show, Eq, Ord, Generic)
   deriving (Arbitrary) via GenericArbitrary KindCheckError
 instance Exception KindCheckError

lambda-buffers-compiler/test/Test/KindCheck.hs

@@ -32,7 +32,8 @@ import Test.Utils.CompilerInput (
   compilerInput'incoherent,
   compilerInput'maybe,
  )
-import Test.Utils.Constructors (_tyName)
+import Test.Utils.Constructors (_ModuleName)
+import Test.Utils.TyDef (tyDef'maybe)
 
 --------------------------------------------------------------------------------
 -- Top Level tests
@@ -49,7 +50,10 @@ testMultipleDec = testGroup "Multiple declaration tests." [doubleDeclaration, pa
 doubleDeclaration :: TestTree
 doubleDeclaration =
   testCase "Two declarations of Maybe within the same module are caught." $
-    check_ compilerInput'doubleDeclaration @?= Left (P.CompKindCheckError $ P.MultipleTyDefError (_tyName "Maybe") (_tyName "Maybe"))
+    check_ compilerInput'doubleDeclaration
+      @?= Left (P.CompKindCheckError (P.MultipleTyDefError moduleName [tyDef'maybe, tyDef'maybe]))
+  where
+    moduleName = _ModuleName ["Module"]
 
 passingDoubleDeclaration :: TestTree
 passingDoubleDeclaration =

lambda-buffers-compiler/test/Test/Utils/Constructors.hs

@@ -12,13 +12,37 @@ module Test.Utils.Constructors (
   _Type,
   _TyDef,
   _TyRefILocal,
+  _Module,
+  _ModuleName,
+  _ModuleNamePart,
 ) where
 
 import Data.List.NonEmpty (fromList)
 import Data.Text (Text)
 import LambdaBuffers.Compiler.ProtoCompat qualified as P
 import Test.Utils.SourceInfo (sourceInfo'empty)
 
+_Module :: P.ModuleName -> [P.TyDef] -> [P.ClassDef] -> [P.InstanceClause] -> P.Module
+_Module mn tds cds ins =
+  P.Module
+    { P.moduleName = mn
+    , P.typeDefs = tds
+    , P.classDefs = cds
+    , P.instances = ins
+    , P.imports = mempty
+    , P.sourceInfo = sourceInfo'empty
+    }
+
+_ModuleName :: [Text] -> P.ModuleName
+_ModuleName ps =
+  P.ModuleName
+    { P.parts = _ModuleNamePart <$> ps
+    , P.sourceInfo = sourceInfo'empty
+    }
+
+_ModuleNamePart :: Text -> P.ModuleNamePart
+_ModuleNamePart n = P.ModuleNamePart n sourceInfo'empty
+
 _tyName :: Text -> P.TyName
 _tyName x = P.TyName x sourceInfo'empty
 

lambda-buffers-compiler/test/Test/Utils/Module.hs

@@ -5,17 +5,6 @@ import LambdaBuffers.Compiler.ProtoCompat qualified as P
 import Test.Utils.SourceInfo (sourceInfo'empty)
 import Test.Utils.TyDef (tyDef'incoherent, tyDef'maybe)
 
-_Module :: P.ModuleName -> [P.TyDef] -> [P.ClassDef] -> [P.InstanceClause] -> P.Module
-_Module mn tds cds ins =
-  P.Module
-    { P.moduleName = mn
-    , P.typeDefs = tds
-    , P.classDefs = cds
-    , P.instances = ins
-    , P.imports = mempty
-    , P.sourceInfo = sourceInfo'empty
-    }
-
 module'maybe :: P.Module
 module'maybe =
   P.Module

lambda-buffers-proto/compiler.proto

@@ -566,10 +566,13 @@ message KindCheckError {
     Kind defined_kind = 3;
   }
 
-  // A tydef was defined multiple times.
+  // Error reads:
+  // Multiple TyDefs with the same TyName were found in ModuleName.
   message MultipleTyDefError {
-    TyName declaration_1 = 1;
-    TyName declaration_2 = 2;
+    // Module in which the error was found.
+    ModuleName module_name = 1;
+    // Conflicting type definitions.
+    repeated TyDef ty_defs = 2;
   }
 
   // The types of inference errors.