digital-asset/daml
1
1
Fork 0
mirror of https://github.com/digital-asset/daml.git synced 2024-09-20 09:17:43 +03:00
Code Issues Projects Releases Wiki Activity

Add missing CurrentSdk prefixes in data-dependencies (#4220)

Browse Source 
* Expose scenarios in data-dependencies.

Also add some type signatures.

changelog_begin
changelog_end

* Add missing prefixes in data-dependencies
This commit is contained in:
associahedron 2020-01-27 11:57:35 +00:00 committed by Moritz Kiefer
parent 68b938d1b4
commit 830c2c65f5
2 changed files with 28 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
compiler/damlc/daml-compiler/src/DA/Daml/Compiler/DataDependencies.hs
View File

@ -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

10
compiler/damlc/lib/DA/Cli/Damlc.hs
View File

@ -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