Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Avoid including daml-stdlib and daml-prim twice #4222

Merged
merged 1 commit into from
Jan 27, 2020
Merged

Avoid including daml-stdlib and daml-prim twice #4222

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 7 additions & 5 deletions compiler/damlc/daml-compiler/src/DA/Daml/Compiler/DataDependencies.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,8 @@ import Control.Lens (toListOf)
import Control.Lens.MonoTraversal (monoTraverse)
import Control.Monad
import Data.List.Extra
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Map.Strict as MS
import Data.Maybe
import qualified Data.NameMap as NM
Expand Down Expand Up @@ -40,7 +42,7 @@ import SdkVersion
data Env = Env
{ envPkgs :: MS.Map UnitId LF.Package
, envGetUnitId :: LF.PackageRef -> UnitId
, envStablePackages :: MS.Map LF.PackageId (UnitId, LF.ModuleName)
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

nice :-)

, envStablePackages :: Set LF.PackageId
, envQualify :: Bool
, envSdkPrefix :: Maybe String
, envMod :: LF.Module
Expand Down Expand Up @@ -165,7 +167,7 @@ generateSrcFromLf env = noLoc mod
, modRef /= LF.ModuleName ["CurrentSdk", "GHC", "Prim"]
]
isStable LF.PRSelf = False
isStable (LF.PRImport pkgId) = pkgId `MS.member` envStablePackages env
isStable (LF.PRImport pkgId) = pkgId `Set.member` envStablePackages env

modRefs :: [(Bool, GHC.UnitId, LF.ModuleName)]
modRefs = nubSort . concat . concat $
Expand Down Expand Up @@ -340,7 +342,7 @@ convType env =
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
| pkgId `Set.member` envStablePackages env
= LF.ModuleName (sdkPrefix ++ n)

| otherwise
Expand Down Expand Up @@ -438,7 +440,7 @@ mkTyConTypeUnqual = mkTyConType False
generateSrcPkgFromLf ::
MS.Map UnitId LF.Package
-> (LF.PackageRef -> UnitId)
-> MS.Map LF.PackageId (UnitId, LF.ModuleName)
-> Set LF.PackageId
-> Maybe String
-> LF.Package
-> [(NormalizedFilePath, String)]
Expand Down Expand Up @@ -485,7 +487,7 @@ genericInstances env externPkgId =

generateGenInstancesPkgFromLf ::
(LF.PackageRef -> UnitId)
-> MS.Map LF.PackageId (UnitId, LF.ModuleName)
-> Set LF.PackageId
-> Maybe String
-> LF.PackageId
-> LF.Package
Expand Down
8 changes: 3 additions & 5 deletions compiler/damlc/lib/DA/Cli/Damlc.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -828,10 +828,8 @@ execGenerateSrc opts dalfOrDar mbOutDir = Command GenerateSrc Nothing effect
[ (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 ]
stablePkgIds :: Set.Set LF.PackageId
stablePkgIds = Set.fromList $ map LF.dalfPackageId $ MS.elems stableDalfPkgMap

genSrcs = generateSrcPkgFromLf pkgMap (getUnitId unitId unitIdMap) stablePkgIds (Just "CurrentSdk") pkg

Expand Down Expand Up @@ -870,7 +868,7 @@ execGenerateGenSrc darFp mbQual outDir = Command GenerateGenerics Nothing effect
decode $ BSL.toStrict $ ZipArchive.fromEntry mainDalfEntry
let getUid = getUnitId unitId pkgMap
-- TODO Passing MS.empty is not right but this command is only used for debugging so for now this is fine.
let genSrcs = generateGenInstancesPkgFromLf getUid MS.empty Nothing mainPkgId mainLfPkg (fromMaybe "" mbQual)
let genSrcs = generateGenInstancesPkgFromLf getUid Set.empty Nothing mainPkgId mainLfPkg (fromMaybe "" mbQual)
forM_ genSrcs $ \(path, src) -> do
let fp = fromMaybe "" outDir </> fromNormalizedFilePath path
createDirectoryIfMissing True $ takeDirectory fp
Expand Down
57 changes: 38 additions & 19 deletions compiler/damlc/lib/DA/Cli/Damlc/Packaging.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,8 @@ import Data.Graph
import Data.List.Extra
import qualified Data.Map.Strict as MS
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Text.Extended as T
import Development.IDE.Core.Service (runAction)
import Development.IDE.Core.Shake
Expand Down Expand Up @@ -79,14 +81,36 @@ createProjectPackageDb opts thisSdkVer deps dataDeps = do

deps <- expandSdkPackages (filter (`notElem` basePackages) deps)
depsExtracted <- mapM extractDar deps

let uniqSdkVersions = nubSort $ unPackageSdkVersion thisSdkVer : map edSdkVersions depsExtracted
let depsSdkVersions = map edSdkVersions depsExtracted
unless (all (== unPackageSdkVersion thisSdkVer) depsSdkVersions) $
fail $
"Package dependencies from different SDK versions: " ++
intercalate ", " uniqSdkVersions

-- deal with data imports first
-- Register deps at the very beginning. This allows data-dependencies to
-- depend on dependencies which is necessary so that we can reconstruct typeclass
-- instances for a typeclass defined in a library.
-- It does mean that we can’t have a dependency from a dependency on a
-- data-dependency but that seems acceptable.
-- See https://github.com/digital-asset/daml/issues/4218 for more details.
-- TODO Enforce this with useful error messages
forM_ depsExtracted $
\ExtractedDar{..} -> installDar dbPath edConfFiles edDalfs edSrcs

loggerH <- getLogger opts "generate package maps"
-- mkOptions is necessary to pick up the proper packagedb paths.
stablePkgsOpts <- mkOptions opts
(stablePkgs, dependencies) <- withDamlIdeState stablePkgsOpts loggerH diagnosticsLogger $ \ide -> runAction ide $
(,) <$> useNoFile_ GenerateStablePackages <*> useNoFile_ GeneratePackageMap
let stablePkgIds :: Set LF.PackageId
stablePkgIds = Set.fromList $ map LF.dalfPackageId $ MS.elems stablePkgs
-- This includes both SDK dependencies like daml-prim and daml-stdlib but also DARs specified
-- in the dependencies field.
let dependencyPkgIds = Set.fromList $ map LF.dalfPackageId $ MS.elems dependencies

-- Now handle data imports.
let (fpDars, fpDalfs) = partition ((== ".dar") . takeExtension) dataDeps
dars <- mapM extractDar fpDars
-- These are the dalfs that are in a DAR that has been passed in via data-dependencies.
Expand Down Expand Up @@ -117,22 +141,21 @@ createProjectPackageDb opts thisSdkVer deps dataDeps = do
-- one of them), we instead include the package hash in the unit id.
--
-- In principle, we can run into the same issue if you combine "dependencies"
-- (which have precompiled interface files with uncontrollable unit ids) and
-- "data-dependencies" but given that our long-term goal is to kill "dependencies"
-- completely, we ignore that for now.
-- (which have precompiled interface files) and
-- "data-dependencies". However, there you can get away with changing the
-- package name and version to change the unit id which is not possible for
-- daml-prim.
--
-- If the version of daml-prim/daml-stdlib in a data-dependency is the same
-- as the one we are currently compiling against, we don’t need to apply this
-- hack.
let parsedUnitId = parseUnitId name pkgId
let unitId = stringToUnitId $ case splitUnitId parsedUnitId of
("daml-prim", Nothing) -> "daml-prim-" <> T.unpack (LF.unPackageId pkgId)
("daml-stdlib", _) -> "daml-stdlib-" <> T.unpack (LF.unPackageId pkgId)
("daml-prim", Nothing) | pkgId `Set.notMember` dependencyPkgIds -> "daml-prim-" <> T.unpack (LF.unPackageId pkgId)
("daml-stdlib", _) | pkgId `Set.notMember` dependencyPkgIds -> "daml-stdlib-" <> T.unpack (LF.unPackageId pkgId)
_ -> parsedUnitId
pure (pkgId, package, dalf, unitId)

loggerH <- getLogger opts "generate stable packages"
stablePkgsOpts <- mkOptions opts
stablePkgs <- withDamlIdeState stablePkgsOpts loggerH diagnosticsLogger $ \ide -> do
runAction ide $ useNoFile_ GenerateStablePackages
let stablePkgIds = MS.fromList $ map (\(k, pkg) -> (LF.dalfPackageId pkg, k)) $ MS.toList stablePkgs

let (depGraph, vertexToNode) = buildLfPackageGraph pkgs stablePkgIds
-- Iterate over the dependency graph in topological order.
-- We do a topological sort on the transposed graph which ensures that
Expand All @@ -142,7 +165,7 @@ createProjectPackageDb opts thisSdkVer deps dataDeps = do
let (pkgNode, pkgId) = vertexToNode vertex in
-- stable packages are mapped to the current version of daml-prim/daml-stdlib
-- so we don’t need to generate interface files for them.
unless (pkgId `MS.member` stablePkgIds) $ do
unless (pkgId `Set.member` stablePkgIds || pkgId `Set.member` dependencyPkgIds) $ do
let unitIdStr = unitIdString $ unitId pkgNode
let _instancesUnitIdStr = "instances-" <> unitIdStr
let pkgIdStr = T.unpack $ LF.unPackageId pkgId
Expand All @@ -151,7 +174,7 @@ createProjectPackageDb opts thisSdkVer deps dataDeps = do
[ unitIdString (unitId depPkgNode) <.> "dalf"
| (depPkgNode, depPkgId) <- map vertexToNode $ reachable depGraph vertex
, pkgId /= depPkgId
, not (depPkgId `MS.member` stablePkgIds)
, not (depPkgId `Set.member` stablePkgIds)
]
let workDir = dbPath </> unitIdStr <> "-" <> pkgIdStr
createDirectoryIfMissing True workDir
Expand All @@ -171,10 +194,6 @@ createProjectPackageDb opts thisSdkVer deps dataDeps = do
mbPkgVersion
deps

-- finally install the dependecies
forM_ depsExtracted $
\ExtractedDar{..} -> installDar dbPath edConfFiles edDalfs edSrcs

-- generate interface files and install them in the package database
generateAndInstallIfaceFiles ::
LF.Package
Expand Down Expand Up @@ -476,7 +495,7 @@ lfVersionString = DA.Pretty.renderPretty
-- | The graph will have an edge from package A to package B if A depends on B.
buildLfPackageGraph
:: [(LF.PackageId, LF.Package, BS.ByteString, UnitId)]
-> MS.Map LF.PackageId (UnitId, LF.ModuleName)
-> Set LF.PackageId
-> ( Graph
, Vertex -> (PackageNode, LF.PackageId)
)
Expand Down
71 changes: 67 additions & 4 deletions compiler/damlc/tests/src/DA/Test/Packaging.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -579,10 +579,7 @@ dataDependencyTests damlc repl davlDar = testGroup "Data Dependencies" $
callProcessSilent repl ["validate", projb </> "projb.dar"]
projbPkgIds <- darPackageIds (projb </> "projb.dar")
-- daml-prim, daml-stdlib for targetLfVer, daml-prim, daml-stdlib for depLfVer if targetLfVer /= depLfVer, proja and projb
-- TODO We should not need nubOrd here. This is currently required since we include the daml-stdlib and daml-prim
-- dalfs twice. This is not a problem but wasteful and useless.
-- See https://github.com/digital-asset/daml/issues/4114
length (nubOrd projbPkgIds) @?= numStablePackages
length projbPkgIds @?= numStablePackages
targetLfVer + 2 + (if targetLfVer /= depLfVer then 2 else 0) + 1 + 1
length (filter (`notElem` projaPkgIds) projbPkgIds) @?=
(numStablePackages targetLfVer - numStablePackages depLfVer) + -- new stable packages
Expand Down Expand Up @@ -644,6 +641,72 @@ dataDependencyTests damlc repl davlDar = testGroup "Data Dependencies" $
callProcessSilent repl ["validate", tmpDir </> "foobar.dar"]
step "Testing scenario"
callProcessSilent repl ["test", "Main:test", tmpDir </> "foobar.dar"]
, testCaseSteps "Mixed dependencies and data-dependencies" $ \step -> withTempDir $ \tmpDir -> do
step "Building 'lib'"
createDirectoryIfMissing True (tmpDir </> "lib")
writeFileUTF8 (tmpDir </> "lib" </> "daml.yaml") $ unlines
[ "sdk-version: " <> sdkVersion
, "version: 0.0.1"
, "name: lib"
, "source: ."
, "dependencies: [daml-prim, daml-stdlib]"
]
writeFileUTF8 (tmpDir </> "lib" </> "Lib.daml") $ unlines
[ "daml 1.2 module Lib where"
, "inc : Int -> Int"
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If you think left-pad was the most useless library, think again!

, "inc = (+ 1)"
]
withCurrentDirectory (tmpDir </> "lib") $ callProcessSilent damlc ["build", "-o", tmpDir </> "lib" </> "lib.dar"]
libPackageIds <- darPackageIds (tmpDir </> "lib" </> "lib.dar")

step "Building 'a'"
createDirectoryIfMissing True (tmpDir </> "a")
writeFileUTF8 (tmpDir </> "a" </> "daml.yaml") $ unlines
[ "sdk-version: " <> sdkVersion
, "version: 0.0.1"
, "name: a"
, "source: ."
, "dependencies:"
, " - daml-prim"
, " - daml-stdlib"
, " - " <> show (tmpDir </> "lib" </> "lib.dar")
]
writeFileUTF8 (tmpDir </> "a" </> "A.daml") $ unlines
[ "daml 1.2 module A where"
, "import Lib"
, "two : Int"
, "two = inc 1"
]
withCurrentDirectory (tmpDir </> "a") $ callProcessSilent damlc ["build", "-o", tmpDir </> "a" </> "a.dar"]
aPackageIds <- darPackageIds (tmpDir </> "a" </> "a.dar")
length aPackageIds @?= length libPackageIds + 1

step "Building 'b'"
createDirectoryIfMissing True (tmpDir </> "b")
writeFileUTF8 (tmpDir </> "b" </> "daml.yaml") $ unlines
[ "sdk-version: " <> sdkVersion
, "version: 0.0.1"
, "name: b"
, "source: ."
, "dependencies:"
, " - daml-prim"
, " - daml-stdlib"
, " - " <> show (tmpDir </> "lib" </> "lib.dar")
, "data-dependencies: [" <> show (tmpDir </> "a" </> "a.dar") <> "]"
]
writeFileUTF8 (tmpDir </> "b" </> "B.daml") $ unlines
[ "daml 1.2 module B where"
, "import Lib"
, "import A"
, "three : Int"
, "three = inc two"
]
withCurrentDirectory (tmpDir </> "b") $ callProcessSilent damlc ["build", "-o", tmpDir </> "b" </> "b.dar"]
projbPackageIds <- darPackageIds (tmpDir </> "b" </> "b.dar")
length projbPackageIds @?= length libPackageIds + 2

step "Validating DAR"
callProcessSilent repl ["validate", tmpDir </> "b" </> "b.dar"]
] <>
[ testCaseSteps "Source generation edge cases" $ \step -> withTempDir $ \tmpDir -> do
writeFileUTF8 (tmpDir </> "Foo.daml") $ unlines
Expand Down