Data dependency exports fix backport (#20601)

* Fix exports for data dependencies (#20354)

* Fix exports for data dependencies

* Update platform independence

* Fix generated exports

* Fix reexport only data deps, rename exports def

* Fix various issues with exports

* Change to be forward backwards compatible when building old LF versions

* Update dar hashes

* Use old style exports for stdlib + prim

* Small cleanup, add test

* Add `--ignore-data-deps-visibility` flag

* Fix DamlScriptTestRunner following #20337

* Address comments from #20354

* Update from comments

Author: samuel-williams-da

Diff for: sdk/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Util.hs

@@ -325,6 +325,21 @@ partitionDefinitions = foldr f ([], [], [], [], [], [])
       DException e -> over _5 (e:)
       DInterface i -> over _6 (i:)
 
+-- | All names of top level exportable definitions (does not include data constructors/record accessors, as they are covered by the type name)
+topLevelExportables :: [Definition] -> [T.Text]
+topLevelExportables defs =
+  let (syns, dataTypes, values, templates, exceptions, interfaces) = partitionDefinitions defs
+   in mconcat
+        [ last . unTypeSynName . synName <$> syns
+        , last . unTypeConName . dataTypeCon <$> dataTypes
+        , unExprValName . fst . dvalBinder <$> values
+        , last . unTypeConName . tplTypeCon <$> templates -- Template names
+        , mconcat $ fmap (unChoiceName . chcName) . NM.elems . tplChoices <$> templates -- Template Choice names
+        , last . unTypeConName . exnName <$> exceptions
+        , last . unTypeConName . intName <$> interfaces -- Interface names
+        , mconcat $ fmap (unChoiceName . chcName) . NM.elems . intChoices <$> interfaces -- Interface Choice names
+        ]
+
 -- | This is the analogue of GHC’s moduleNameString for the LF
 -- `ModuleName` type.
 moduleNameString :: ModuleName -> T.Text

Diff for: sdk/compiler/damlc/daml-compiler/src/DA/Daml/Compiler/DataDependencies.hs

@@ -11,6 +11,7 @@ module DA.Daml.Compiler.DataDependencies
     ) where
 
 import DA.Pretty hiding (first)
+import Control.Applicative
 import Control.Monad
 import Control.Monad.State.Strict
 import Data.Bifunctor (first)
@@ -85,6 +86,8 @@ data Config = Config
         -- ^ Information about dependencies (not data-dependencies)
     , configSdkPrefix :: [T.Text]
         -- ^ prefix to use for current SDK in data-dependencies
+    , configIgnoreExplicitExports :: Bool
+        -- ^ Should explicit export information be disregarded, and all definitions in this module be exported
     }
 
 data Env = Env
@@ -324,9 +327,32 @@ generateSrcFromLf env = noLoc mod
             , modRefImpSpec = EmptyImpSpec
             }
 
+    {- # Exports/Re-exports #
+    Before Daml 3.3, data dependencies only preserved re-export information, that is explicit definitions that the 
+    data dependency re-exports from another module. For definitions defined in this module, we exported everything
+    (using `module ThisModule` in the export list)
+
+    These re-exports were/still are defined as top level metadata stubs, of the name `$$export<n>` with one definition
+    per re-export (with <n> counting up from 0). Note that a single re-export included information about a types fields and constructors
+
+    This information is encoded at the type level using a TStruct, the value of these definitions is error.
+    Post 2.10, we have added explicit information about local exports, under definitions of `$$explicitExport<n>`. We did not
+    rename the existing re-exports name of `$$export<n>` for backwards compatibility, even though it isn't correct.
+
+    The following packages however will not have these new explicit exports:
+      - Stable packages, for these are generated directly, and do not use LFConversion
+      - Stdlib + prim, for these packages have special behaviour with replaced definitions that lead to convoluted exports
+      - Packages compiled before this feature was implemented, i.e. pre 2.10
+    In order to differentiate between these packages, and packages with modules that have no explicit exports (i.e. only typeclasses instances or only re-exports),
+      we include a tag `$$explicitExports` of type `()`.
+    When this tag is not present, we revert to the usual `module ThisModule` exports.
+    
+    Note that since fixing this behaviour is a breaking change, there is a second scenario in which we ignore these tags and use `module ThisModule` regardless
+    This is when the `--ignore-data-dep-visibility` flag is passed, for backwards compatibility.
+    -} 
     genExports :: Gen [LIE GhcPs]
     genExports = (++)
-        <$> (sequence $ selfReexport : classReexports)
+        <$> (sequence $ selfReexport <> classReexports)
         <*> allExports
 
     genDecls :: Gen [LHsDecl GhcPs]
@@ -352,20 +378,35 @@ generateSrcFromLf env = noLoc mod
         , Just methodName <- [getClassMethodName fieldName]
         ]
 
+    usesExplicitExports :: Bool
+    usesExplicitExports = not $ null $ do
+        guard $ not $ configIgnoreExplicitExports $ envConfig env
+        LF.DefValue {dvalBinder=(name, _)} <- NM.toList . LF.moduleValues $ envMod env
+        guard $ name == LFC.explicitExportsTag
+
+    qualNameToSynName :: LFC.QualName -> LF.TypeSynName
+    qualNameToSynName (LFC.QualName (LF.Qualified {LF.qualObject})) = LF.TypeSynName $ T.split (=='.') $ T.pack $ occNameString qualObject
+
     allExports :: Gen [LIE GhcPs]
     allExports = sequence $ do
         LF.DefValue {dvalBinder=(name, ty)} <- NM.toList . LF.moduleValues $ envMod env
-        Just _ <- [LFC.unExportName name] -- We don't really care about the order of exports
+        -- We don't really care about the order of exports
+        -- Export both re-exports and explicit exports with the same mechanism
+        Just _ <- [LFC.unReExportName name <|> (guard usesExplicitExports >> LFC.unExportName name)]
         Just export <- [LFC.decodeExportInfo ty]
-        pure $ mkLIE export
+        mkLIE export
         where
-            mkLIE :: LFC.ExportInfo -> Gen (LIE GhcPs)
-            mkLIE = fmap noLoc . \case
+            mkLIE :: LFC.ExportInfo -> [Gen (LIE GhcPs)]
+            mkLIE = fmap (fmap noLoc) . \case
                 LFC.ExportInfoVal name ->
-                    IEVar NoExt
+                    pure $ IEVar NoExt
                         <$> mkWrappedRdrName IEName name
+                -- Classes that are duplicated in non-data-dependencies are replaced with re-exports of the other class
+                -- (for compatibility with old stdlibs)
+                -- As such, we do not want to export definitions that have already been re-exported/replaced
+                LFC.ExportInfoTC name _ _ | qualNameToSynName name `MS.member` classReexportMap -> []
                 LFC.ExportInfoTC name pieces fields ->
-                    IEThingWith NoExt
+                    pure $ IEThingWith NoExt
                         <$> mkWrappedRdrName IEType name
                         <*> pure NoIEWildcard
                         <*> mapM (mkWrappedRdrName IEName) pieces
@@ -385,9 +426,12 @@ generateSrcFromLf env = noLoc mod
             mkFieldLblRdrName :: FieldLbl LFC.QualName -> Gen (Located (FieldLbl RdrName))
             mkFieldLblRdrName = fmap noLoc . traverse mkRdrName
 
-    selfReexport :: Gen (LIE GhcPs)
-    selfReexport = pure . noLoc $
-        IEModuleContents noExt (noLoc ghcModName)
+    -- We only reexport self (i.e. module Self) when not using explicit exports
+    selfReexport :: [Gen (LIE GhcPs)]
+    selfReexport =
+      [ pure . noLoc $ IEModuleContents noExt (noLoc ghcModName)
+      | not usesExplicitExports
+      ]
 
     classReexports :: [Gen (LIE GhcPs)]
     classReexports = map snd3 (MS.elems classReexportMap)

Diff for: sdk/compiler/damlc/daml-ghc-util/src/DA/Daml/UtilGHC.hs

@@ -97,7 +97,7 @@ pattern GHC_Types <- ModuleIn DamlPrim "GHC.Types"
 pattern GHC_Show <- ModuleIn DamlPrim "GHC.Show"
 
 -- daml-stdlib module patterns
-pattern DA_Action, DA_Internal_LF, DA_Internal_Prelude, DA_Internal_Record, DA_Internal_Desugar, DA_Internal_Template_Functions, DA_Internal_Exception, DA_Internal_Interface, DA_Internal_Template :: GHC.Module
+pattern DA_Action, DA_Internal_LF, DA_Internal_Prelude, DA_Internal_Record, DA_Internal_Desugar, DA_Internal_Template_Functions, DA_Internal_Exception, DA_Internal_Interface, DA_Internal_Template, DA_Internal_Compatible :: GHC.Module
 pattern DA_Action <- ModuleIn DamlStdlib "DA.Action"
 pattern DA_Internal_LF <- ModuleIn DamlStdlib "DA.Internal.LF"
 pattern DA_Internal_Prelude <- ModuleIn DamlStdlib "DA.Internal.Prelude"
@@ -107,6 +107,7 @@ pattern DA_Internal_Template_Functions <- ModuleIn DamlStdlib "DA.Internal.Templ
 pattern DA_Internal_Exception <- ModuleIn DamlStdlib "DA.Internal.Exception"
 pattern DA_Internal_Interface <- ModuleIn DamlStdlib "DA.Internal.Interface"
 pattern DA_Internal_Template <- ModuleIn DamlStdlib "DA.Internal.Template"
+pattern DA_Internal_Compatible <- ModuleIn DamlStdlib "DA.Internal.Compatible"
 
 -- | Deconstruct a dictionary function (DFun) identifier into a tuple
 -- containing, in order:

Diff for: sdk/compiler/damlc/daml-lf-conversion/src/DA/Daml/LFConversion.hs

@@ -761,7 +761,6 @@ convertModuleContents env mc = do
     templates <- convertTemplateDefs env mc
     exceptions <- convertExceptionDefs env mc
     interfaces <- convertInterfaces env mc
-    exports <- convertExports env mc
     let fixities = convertFixities mc
         defs =
             types
@@ -770,9 +769,10 @@ convertModuleContents env mc = do
             ++ definitions
             ++ interfaces
             ++ depOrphanModules
-            ++ exports
             ++ fixities
-    pure defs
+    -- Exports need to know what is defined to know if it should export it
+    exports <- convertExports env mc defs
+    pure $ defs ++ exports
 
 data Consuming = PreConsuming
                | Consuming
@@ -961,22 +961,49 @@ convertFixities = zipWith mkFixityDef [0..] . mcFixities
           (fixityName i)
           (encodeFixityInfo fixityInfo)
 
-convertExports :: Env -> ModuleContents -> ConvertM [Definition]
-convertExports env mc = do
-    let externalExportInfos = filter isExternalAvailInfo (mcExports mc)
-    exportInfos <- mapM availInfoToExportInfo externalExportInfos
-    pure $ zipWith mkExportDef [0..] exportInfos
+convertExports :: SdkVersioned => Env -> ModuleContents -> [Definition] -> ConvertM [Definition]
+convertExports env mc existingDefs = do
+    let externalReExportInfos = filter (isReExportName . GHC.availName) (mcExports mc)
+    reExportInfos <- mapM availInfoToExportInfo externalReExportInfos
+    let reExportDefs = zipWith mkExportDef (reExportName <$> [0..]) reExportInfos
+        
+    -- [SW] Use old style exports for prim/stdlib, i.e. export everything
+    -- I tried to have these also export normally, but ran into issues with proto3-suite overflowing heap when parsing stdlib
+    -- (when using `compile` directly, without daml-assistant)
+    if isPrimOrStdlib
+      then pure reExportDefs
+      else do
+        let externalExportInfos = filter (isExportName . GHC.availName) (mcExports mc) \\ externalReExportInfos
+        exportInfos <- mapM availInfoToExportInfo externalExportInfos
+        let exportDefs = zipWith mkExportDef (exportName <$> [0..]) exportInfos
+        pure $ explicitExportsDef : reExportDefs <> exportDefs
     where
-        isExternalAvailInfo :: GHC.AvailInfo -> Bool
-        isExternalAvailInfo = isExternalName . GHC.availName
-            where
-                isExternalName name =
-                    not $
-                        nameIsLocalOrFrom thisModule name
-                        || isSystemName name
-                        || isWiredInName name
-                        || maybe False (isInternal . GHC.moduleName) (nameModule_maybe name)
-                thisModule = GHC.Module (envModuleUnitId env) (envGHCModuleName env)
+        isReExportName :: Name -> Bool
+        isReExportName name = not $
+            isSystemName name
+            || isWiredInName name
+            || nameIsLocalOrFrom thisModule name
+            || maybe False (isInternal . GHC.moduleName) (nameModule_maybe name)
+
+        isPrimOrStdlib :: Bool
+        isPrimOrStdlib = envModuleUnitId env == damlStdlib || envModuleUnitId env == stringToUnitId "daml-prim"
+
+        thisModule :: GHC.Module
+        thisModule = GHC.Module (envModuleUnitId env) (envGHCModuleName env)
+
+        localExportables :: [T.Text]
+        localExportables = topLevelExportables existingDefs
+
+        -- If name is local but isn't defined in other generated definitions, don't export it
+        isLocallyUndefined :: Name -> Bool
+        isLocallyUndefined name | nameIsLocalOrFrom thisModule name = not $ getOccText name `elem` localExportables
+        isLocallyUndefined _ = False
+
+        isExportName :: Name -> Bool
+        isExportName name = not $
+            isSystemName name
+            || isWiredInName name
+            || isLocallyUndefined name
 
         availInfoToExportInfo :: GHC.AvailInfo -> ConvertM ExportInfo
         availInfoToExportInfo = \case
@@ -1004,10 +1031,15 @@ convertExports env mc = do
             flSelector <- convertQualName (flSelector f)
             pure f { flSelector }
 
-        mkExportDef :: Integer -> ExportInfo -> Definition
-        mkExportDef i info =
+        mkExportDef :: LF.ExprValName -> ExportInfo -> Definition
+        mkExportDef name info =
             let exportType = encodeExportInfo info
-            in DValue (mkMetadataStub (exportName i) exportType)
+            in DValue (mkMetadataStub name exportType)
+
+        -- Tag for explicit exports, so we can differentiate between a module no exports and a module compiled either before
+        -- explicit exports was implemented, or is stdlib/prim
+        explicitExportsDef :: Definition
+        explicitExportsDef = DValue (mkMetadataStub explicitExportsTag (LF.TBuiltin LF.BTUnit))
 
 defNewtypeWorker :: NamedThing a => Env -> a -> TypeConName -> DataCon
     -> [(TypeVarName, LF.Kind)] -> [(FieldName, LF.Type)] -> Definition

Diff for: sdk/compiler/damlc/daml-lf-conversion/src/DA/Daml/LFConversion/MetadataEncoding.hs

@@ -27,8 +27,11 @@ module DA.Daml.LFConversion.MetadataEncoding
     , encodeModuleImports
     , decodeModuleImports
     -- * Exports
+    , reExportName
+    , unReExportName
     , exportName
     , unExportName
+    , explicitExportsTag
     , ExportInfo (..)
     , QualName (..)
     , encodeExportInfo
@@ -233,14 +236,28 @@ decodeModuleName = fmap LF.ModuleName . decodeTypeList decodeText
 --------------------
 -- Module Exports --
 --------------------
+-- Re-exports use the `exports` label for backwards compatibility
+reExportName :: Integer -> LF.ExprValName
+reExportName i = LF.ExprValName $ "$$export" <> T.pack (show i)
+
+unReExportName :: LF.ExprValName -> Maybe Integer
+unReExportName (LF.ExprValName name) = do
+    suffix <- T.stripPrefix "$$export" name
+    readMay (T.unpack suffix)
+
+-- Full exports use $$explicitExport<n>, with the `$$explicitExports` tag to differentiate between
+-- no explicit exports, and old style exporting (i.e. everything exported)
 exportName :: Integer -> LF.ExprValName
-exportName i = LF.ExprValName $ "$$export" <> T.pack (show i)
+exportName i = LF.ExprValName $ "$$explicitExport" <> T.pack (show i)
 
 unExportName :: LF.ExprValName -> Maybe Integer
 unExportName (LF.ExprValName name) = do
-    suffix <- T.stripPrefix "$$export" name
+    suffix <- T.stripPrefix "$$explicitExport" name
     readMay (T.unpack suffix)
 
+explicitExportsTag :: LF.ExprValName
+explicitExportsTag = LF.ExprValName "$$explicitExports"
+
 newtype QualName = QualName (LF.Qualified GHC.OccName)
     deriving (Eq)
 

Diff for: sdk/compiler/damlc/daml-opts/daml-opts-types/DA/Daml/Options/Types.hs

@@ -22,6 +22,7 @@ module DA.Daml.Options.Types
     , ModRenaming(..)
     , PackageArg(..)
     , ErrorOrWarning
+    , IgnoreDataDepVisibility(..)
     , defaultOptions
     , damlArtifactDir
     , projectPackageDatabase
@@ -145,6 +146,7 @@ data Options = Options
   -- unit-id, as script + scenario service assume it will be "main"
   , optUpgradeInfo :: UpgradeInfo
   , optDamlWarningFlags :: WarningFlags.DamlWarningFlags ErrorOrWarning
+  , optIgnoreDataDepVisibility :: IgnoreDataDepVisibility
   }
 
 type ErrorOrWarning = Either TypeCheckerError.ErrorOrWarning LFConversion.ErrorOrWarning
@@ -161,6 +163,9 @@ newtype IncrementalBuild = IncrementalBuild { getIncrementalBuild :: Bool }
 newtype IgnorePackageMetadata = IgnorePackageMetadata { getIgnorePackageMetadata :: Bool }
   deriving Show
 
+newtype IgnoreDataDepVisibility = IgnoreDataDepVisibility { getIgnoreDataDepVisibility :: Bool }
+  deriving Show
+
 newtype Haddock = Haddock Bool
   deriving Show
 
@@ -297,6 +302,7 @@ defaultOptions mbVersion =
         , optHideUnitId = False
         , optUpgradeInfo = defaultUpgradeInfo
         , optDamlWarningFlags = WarningFlags.mkDamlWarningFlags damlWarningFlagParser []
+        , optIgnoreDataDepVisibility = IgnoreDataDepVisibility False
         }
 
 defaultUpgradeInfo :: UpgradeInfo

Diff for: sdk/compiler/damlc/lib/DA/Cli/Damlc/Packaging.hs

@@ -23,7 +23,7 @@ import qualified Control.Monad.Trans.State.Strict as State
 import qualified Data.ByteString as BS
 import Data.Either.Combinators (whenLeft)
 import Data.Graph (Graph, Vertex, graphFromEdges, reachable, topSort, transposeG, vertices)
-import Data.List.Extra ((\\), intercalate, nubSortOn)
+import Data.List.Extra ((\\), intercalate, nubSortOn, nubOrd)
 import qualified Data.Map.Strict as MS
 import Data.Maybe (fromMaybe, isNothing)
 import qualified Data.NameMap as NM
@@ -307,6 +307,7 @@ installDataDep InstallDataDepArgs {..} = do
         , configStablePackages = MS.fromList [ (LF.dalfPackageId dalfPkg, unitId) | ((unitId, _), dalfPkg) <- MS.toList stablePkgs ]
         , configDependencyInfo = dependencyInfo
         , configSdkPrefix = [T.pack currentSdkPrefix]
+        , configIgnoreExplicitExports = getIgnoreDataDepVisibility $ optIgnoreDataDepVisibility opts
         }
 
     pkg = LF.extPackagePkg (LF.dalfPackagePkg dalfPackage)
@@ -602,7 +603,7 @@ buildLfPackageGraph =
       , getDecodedDalfUnitId = decodedUnitId . snd
       , getDecodedDalfPkg = decodedDalfPkg . snd
       , getDalfPkgId = LF.dalfPackageId
-      , getDalfPkgRefs = dalfPackageRefs
+      , getDalfPkgRefs = nubOrd . dalfPackageRefs
       }
   where
     dalfPackageRefs :: LF.DalfPackage -> [LF.PackageId]
@@ -621,6 +622,19 @@ buildLfPackageGraph =
               , Just quals <- [LFC.decodeModuleImports ty]
               , LF.Qualified { LF.qualPackage } <- Set.toList quals
               ]
+              -- Pull out all package ids from re-exports as well
+              <>
+              [ qualPackage
+              | m <- NM.toList $ LF.packageModules pkg
+              , LF.DefValue {dvalBinder=(name, ty)} <- NM.toList $ LF.moduleValues m
+              , Just _ <- [LFC.unReExportName name]
+              , Just export <- [LFC.decodeExportInfo ty]
+              , LFC.QualName (LF.Qualified { LF.qualPackage }) <-
+                  [ case export of 
+                      LFC.ExportInfoVal name -> name
+                      LFC.ExportInfoTC name _ _ -> name
+                  ]
+              ]
         , pid' /= pid
         ]