Fix instance import (#2350)

Fixes a bug which prevented some instances from being imported from
other modules.

src/Juvix/Compiler/Internal/Data/InstanceInfo.hs

@@ -27,22 +27,43 @@ data InstanceInfo = InstanceInfo
     _instanceInfoResult :: Expression,
     _instanceInfoArgs :: [FunctionParameter]
   }
+  deriving stock (Eq)
+
+instance Hashable InstanceInfo where
+  hashWithSalt salt InstanceInfo {..} = hashWithSalt salt _instanceInfoResult
 
 -- | Maps trait names to available instances
-type InstanceTable = HashMap InductiveName [InstanceInfo]
+newtype InstanceTable = InstanceTable
+  { _instanceTableMap :: HashMap InductiveName [InstanceInfo]
+  }
 
 makeLenses ''InstanceApp
 makeLenses ''InstanceInfo
+makeLenses ''InstanceTable
+
+instance Semigroup InstanceTable where
+  t1 <> t2 =
+    InstanceTable $
+      HashMap.unionWith combine (t1 ^. instanceTableMap) (t2 ^. instanceTableMap)
+    where
+      combine :: [InstanceInfo] -> [InstanceInfo] -> [InstanceInfo]
+      combine ii1 ii2 = nubHashable (ii1 ++ ii2)
+
+instance Monoid InstanceTable where
+  mempty = InstanceTable mempty
 
 updateInstanceTable :: InstanceTable -> InstanceInfo -> InstanceTable
 updateInstanceTable tab ii@InstanceInfo {..} =
-  HashMap.alter go _instanceInfoInductive tab
+  over instanceTableMap (HashMap.alter go _instanceInfoInductive) tab
   where
     go :: Maybe [InstanceInfo] -> Maybe [InstanceInfo]
     go = \case
       Just is -> Just (ii : is)
       Nothing -> Just [ii]
 
+lookupInstanceTable :: InstanceTable -> Name -> Maybe [InstanceInfo]
+lookupInstanceTable tab name = HashMap.lookup name (tab ^. instanceTableMap)
+
 paramToExpression :: InstanceParam -> Expression
 paramToExpression = \case
   InstanceParamVar v ->

src/Juvix/Compiler/Internal/Extra/DependencyBuilder.hs

@@ -84,12 +84,15 @@ goModuleNoVisited (ModuleIndex m) = do
 goImport :: (Members '[Reader ExportsTable, State DependencyGraph, State StartNodes, Visit ModuleIndex] r) => Import -> Sem r ()
 goImport (Import m) = visit m
 
--- | Ignores includes
-goPreModule :: (Members '[Reader ExportsTable, State DependencyGraph, State StartNodes] r) => PreModule -> Sem r ()
+goPreModule :: (Members '[Reader ExportsTable, State DependencyGraph, State StartNodes, Visit ModuleIndex] r) => PreModule -> Sem r ()
 goPreModule m = do
   checkStartNode (m ^. moduleName)
   let b = m ^. moduleBody
   mapM_ (goPreStatement (m ^. moduleName)) (b ^. moduleStatements)
+  -- We cannot ignore imports with instances, because a trait in a module M may
+  -- depend on an instance in a module N which imports M  (i.e. new edges may be
+  -- added from definitions in M to definitions in N)
+  mapM_ goImport (b ^. moduleImports)
 
 goStatement :: forall r. (Members '[Reader ExportsTable, State DependencyGraph, State StartNodes] r) => Name -> Statement -> Sem r ()
 goStatement parentModule = \case

src/Juvix/Compiler/Internal/Pretty/Base.hs

@@ -7,6 +7,7 @@ where
 
 import Data.HashMap.Strict qualified as HashMap
 import Juvix.Compiler.Internal.Data.InfoTable.Base
+import Juvix.Compiler.Internal.Data.InstanceInfo (instanceInfoResult, instanceTableMap)
 import Juvix.Compiler.Internal.Data.NameDependencyInfo
 import Juvix.Compiler.Internal.Extra
 import Juvix.Compiler.Internal.Pretty.Options
@@ -313,6 +314,7 @@ instance PrettyCode InfoTable where
     inds <- ppCode (HashMap.keys (tbl ^. infoInductives))
     constrs <- ppCode (HashMap.keys (tbl ^. infoConstructors))
     funs <- ppCode (HashMap.keys (tbl ^. infoFunctions))
+    insts <- ppCode $ map (map (^. instanceInfoResult)) $ HashMap.elems (tbl ^. infoInstances . instanceTableMap)
     let header :: Text -> Doc Ann = annotate AnnImportant . pretty
     return $
       header "InfoTable"
@@ -323,6 +325,8 @@ instance PrettyCode InfoTable where
         <> constrs
         <> header "\nFunctions: "
         <> funs
+        <> header "\nInstances: "
+        <> insts
 
 ppPostExpression ::
   (PrettyCode a, HasAtomicity a, Member (Reader Options) r) =>

src/Juvix/Compiler/Internal/Translation/FromInternal/Analysis/TypeChecking/Traits/Resolver.hs

@@ -83,7 +83,7 @@ lookupInstance' ::
   [InstanceParam] ->
   Sem r [(InstanceInfo, SubsI)]
 lookupInstance' tab name params = do
-  let is = fromMaybe [] $ HashMap.lookup name tab
+  let is = fromMaybe [] $ lookupInstanceTable tab name
   mapMaybeM matchInstance is
   where
     matchInstance :: InstanceInfo -> Sem r (Maybe (InstanceInfo, SubsI))

test/Typecheck/Positive.hs

@@ -284,7 +284,11 @@ tests =
     posTest
       "Traits"
       $(mkRelDir ".")
-      $(mkRelFile "Traits.juvix")
+      $(mkRelFile "Traits.juvix"),
+    posTest
+      "Instance import"
+      $(mkRelDir "InstanceImport")
+      $(mkRelFile "Main.juvix")
   ]
     <> [ compilationTest t | t <- Compilation.tests
        ]

tests/positive/InstanceImport/M.juvix

@@ -0,0 +1,9 @@
+module M;
+
+trait
+type T A := mkT {pp : A → A};
+
+type Unit := unit;
+
+instance
+unitI : T Unit := mkT λ {x := x};

tests/positive/InstanceImport/Main.juvix

@@ -0,0 +1,12 @@
+module Main;
+
+import M open;
+import M open;
+
+type Bool := true | false;
+
+instance
+boolI : T Bool := mkT λ {x := x};
+
+main : Bool := case T.pp unit
+  | unit := T.pp true;