Add missing CurrentSdk prefixes in data-dependencies (digital-asset#4220

) * Expose scenarios in data-dependencies. Also add some type signatures. changelog_begin changelog_end * Add missing prefixes in data-dependencies
axman6 · Jan 27, 2020 · 830c2c6 · 830c2c6
1 parent 68b938d
commit 830c2c6
Show file tree

Hide file tree

Showing 2 changed files with 28 additions and 7 deletions.
diff --git a/compiler/damlc/daml-compiler/src/DA/Daml/Compiler/DataDependencies.hs b/compiler/damlc/daml-compiler/src/DA/Daml/Compiler/DataDependencies.hs
@@ -107,8 +107,7 @@ generateSrcFromLf env = noLoc mod
     shouldExposeDefValue :: LF.DefValue -> Bool
     shouldExposeDefValue LF.DefValue{..}
         | (lfName, lfType) <- dvalBinder
-        = not (LF.getIsTest dvalIsTest)
-        && not ("$" `T.isPrefixOf` LF.unExprValName lfName)
+        = not ("$" `T.isPrefixOf` LF.unExprValName lfName)
         && not (typeHasOldTypeclass env lfType)
         && (LF.moduleNameString lfModName /= "GHC.Prim")
 
@@ -180,7 +179,7 @@ generateSrcFromLf env = noLoc mod
 
     modRefsFromDefDataType :: LF.DefDataType -> [(Bool, GHC.UnitId, LF.ModuleName)]
     modRefsFromDefDataType typeDef = concat
-        [ [ (isStable pkg, envGetUnitId env pkg, modRef)
+        [ [ (isStable pkg, envGetUnitId env pkg, addSdkPrefixIfStable env pkg modRef)
           | (pkg, modRef) <- toListOf monoTraverse typeDef ]
         , [ (True, pkg, modRef)
           | b <- toListOf (dataConsType . builtinType) (LF.dataCons typeDef)
@@ -193,7 +192,7 @@ generateSrcFromLf env = noLoc mod
 
     modRefsFromDefValue :: LF.DefValue -> [(Bool, GHC.UnitId, LF.ModuleName)]
     modRefsFromDefValue LF.DefValue{..} | (_, dvalType) <- dvalBinder = concat
-        [ [ (isStable pkg, envGetUnitId env pkg, modRef)
+        [ [ ( isStable pkg, envGetUnitId env pkg, addSdkPrefixIfStable env pkg modRef)
           | (pkg, modRef) <- toListOf monoTraverse dvalType ]
         , [ (True, pkg, modRef)
           | b <- toListOf builtinType dvalType
@@ -304,8 +303,8 @@ convType env =
                     mkOrig
                         (mkModule
                              (envGetUnitId env qualPackage)
-                             (mkModuleName $
-                              T.unpack $ LF.moduleNameString qualModule))
+                             (mkModuleName $ T.unpack $ LF.moduleNameString
+                                (addSdkPrefixIfStable env qualPackage qualModule)))
                         (mkOccName varName $ T.unpack name)
                 n@[_name0, _name1] -> case MS.lookup n (sumProdRecords $ envMod env) of
                     Nothing ->
@@ -337,6 +336,20 @@ convType env =
         HsTyVar noExt NotPromoted $
         noLoc $ mkRdrUnqual $ occName $ tupleTyConName BoxedTuple i
 
+
+addSdkPrefixIfStable :: Env -> LF.PackageRef -> LF.ModuleName -> LF.ModuleName
+addSdkPrefixIfStable _ LF.PRSelf mod = mod
+addSdkPrefixIfStable env (LF.PRImport pkgId) m@(LF.ModuleName n)
+    | pkgId `MS.member` envStablePackages env
+    = LF.ModuleName (sdkPrefix ++ n)
+
+    | otherwise
+    = m
+  where
+    sdkPrefix = case envSdkPrefix env of
+        Nothing -> []
+        Just p -> [T.pack p]
+
 convBuiltInTy :: Env -> LF.BuiltinType -> HsType GhcPs
 convBuiltInTy env =
     \case

diff --git a/compiler/damlc/lib/DA/Cli/Damlc.hs b/compiler/damlc/lib/DA/Cli/Damlc.hs
@@ -812,19 +812,27 @@ execGenerateSrc opts dalfOrDar mbOutDir = Command GenerateSrc Nothing effect
             stableDalfPkgMap <- useNoFile_ GenerateStablePackages
             pure (dalfPkgMap, stableDalfPkgMap)
 
-        let allDalfPkgs =
+        let allDalfPkgs :: [(UnitId, LF.DalfPackage)]
+            allDalfPkgs =
                 [ (unitId, dalfPkg)
                 | ((unitId, _modName), dalfPkg) <- MS.toList stableDalfPkgMap ]
                 ++ MS.toList dalfPkgMap
+
+            pkgMap :: MS.Map UnitId LF.Package
             pkgMap = MS.insert unitId pkg $ MS.fromList
                 [ (unitId, LF.extPackagePkg (LF.dalfPackagePkg dalfPkg))
                 | (unitId, dalfPkg) <- allDalfPkgs ]
+
+            unitIdMap :: MS.Map LF.PackageId UnitId
             unitIdMap = MS.insert pkgId unitId $ MS.fromList
                 [ (LF.dalfPackageId dalfPkg, unitId)
                 | (unitId, dalfPkg) <- allDalfPkgs ]
+
+            stablePkgIds :: MS.Map LF.PackageId (UnitId, LF.ModuleName)
             stablePkgIds = MS.fromList
                 [ (LF.dalfPackageId dalfPkg, k)
                 | (k, dalfPkg) <- MS.toList stableDalfPkgMap ]
+
             genSrcs = generateSrcPkgFromLf pkgMap (getUnitId unitId unitIdMap) stablePkgIds (Just "CurrentSdk") pkg
 
         forM_ genSrcs $ \(path, src) -> do