Skip to content

Commit

Permalink
replace Builtin RoundingMode by stable packages
Browse files Browse the repository at this point in the history
  • Loading branch information
remyhaemmerle-da committed Apr 12, 2024
1 parent 5b63b00 commit c4a9318
Show file tree
Hide file tree
Showing 19 changed files with 290 additions and 60 deletions.
186 changes: 186 additions & 0 deletions compiler/damlc/stable-packages/BUILD.bazel
Original file line number Diff line number Diff line change
@@ -0,0 +1,186 @@
# Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
# SPDX-License-Identifier: Apache-2.0

load("//bazel_tools:haskell.bzl", "da_haskell_binary", "da_haskell_library", "generate_and_track_cabal")
load(
"//daml-lf/language:daml-lf.bzl",
"LF_MAJOR_VERSIONS",
)

da_haskell_library(
name = "stable-packages-lib",
srcs = glob(["lib/**/*.hs"]),
hackage_deps = [
"base",
"bytestring",
"containers",
"text",
],
src_strip_prefix = "lib",
visibility = ["//visibility:public"],
deps = [
"//compiler/daml-lf-ast",
"//compiler/daml-lf-proto-encode",
"//compiler/damlc/daml-lf-util",
"//libs-haskell/da-hs-base",
],
)

da_haskell_binary(
name = "generate-stable-package",
srcs = glob(["src/**/*.hs"]),
hackage_deps = [
"base",
"bytestring",
"containers",
"optparse-applicative",
"text",
],
src_strip_prefix = "src",
visibility = ["//visibility:public"],
deps = [
"stable-packages-lib",
"//compiler/daml-lf-ast",
"//compiler/daml-lf-proto-encode",
"//libs-haskell/da-hs-base",
],
)

[
genrule(
name = "gen-stable-packages-v{}".format(majorLfVersion),
srcs = [],
outs = [
"lf-v{}/daml-prim/GHC-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/GHC-Prim.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/GHC-Tuple.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/DA-Internal-Erased.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/DA-Internal-NatSyn.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/DA-Internal-PromotedText.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/DA-Exception-GeneralError.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/DA-Exception-ArithmeticError.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/DA-Exception-AssertionFailed.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/DA-Exception-PreconditionFailed.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/DA-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Internal-Template.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Internal-Any.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Time-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-NonEmpty-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Date-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Semigroup-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Set-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Monoid-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Logic-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Validation-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Internal-Down.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Internal-Interface-AnyView-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Action-State-Type.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Random-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Stack-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Types-RoundingMode.dalf".format(majorLfVersion),
],
cmd = """
$(location :generate-stable-package) --major-version {major} --module GHC.Types -o $(location lf-v{major}/daml-prim/GHC-Types.dalf)
$(location :generate-stable-package) --major-version {major} --module GHC.Prim -o $(location lf-v{major}/daml-prim/GHC-Prim.dalf)
$(location :generate-stable-package) --major-version {major} --module GHC.Tuple -o $(location lf-v{major}/daml-prim/GHC-Tuple.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Internal.Erased -o $(location lf-v{major}/daml-prim/DA-Internal-Erased.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Internal.NatSyn -o $(location lf-v{major}/daml-prim/DA-Internal-NatSyn.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Internal.PromotedText -o $(location lf-v{major}/daml-prim/DA-Internal-PromotedText.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Exception.GeneralError -o $(location lf-v{major}/daml-prim/DA-Exception-GeneralError.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Exception.ArithmeticError -o $(location lf-v{major}/daml-prim/DA-Exception-ArithmeticError.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Exception.AssertionFailed -o $(location lf-v{major}/daml-prim/DA-Exception-AssertionFailed.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Exception.PreconditionFailed -o $(location lf-v{major}/daml-prim/DA-Exception-PreconditionFailed.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Types -o $(location lf-v{major}/daml-prim/DA-Types.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Time.Types -o $(location lf-v{major}/daml-stdlib/DA-Time-Types.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.NonEmpty.Types -o $(location lf-v{major}/daml-stdlib/DA-NonEmpty-Types.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Date.Types -o $(location lf-v{major}/daml-stdlib/DA-Date-Types.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Semigroup.Types -o $(location lf-v{major}/daml-stdlib/DA-Semigroup-Types.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Set.Types -o $(location lf-v{major}/daml-stdlib/DA-Set-Types.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Monoid.Types -o $(location lf-v{major}/daml-stdlib/DA-Monoid-Types.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Logic.Types -o $(location lf-v{major}/daml-stdlib/DA-Logic-Types.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Validation.Types -o $(location lf-v{major}/daml-stdlib/DA-Validation-Types.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Internal.Down -o $(location lf-v{major}/daml-stdlib/DA-Internal-Down.dalf)
# These types are not serializable but they leak into typeclass methods so they need to be stable.
$(location :generate-stable-package) --major-version {major} --module DA.Internal.Any -o $(location lf-v{major}/daml-stdlib/DA-Internal-Any.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Internal.Template -o $(location lf-v{major}/daml-stdlib/DA-Internal-Template.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Internal.Interface.AnyView.Types -o $(location lf-v{major}/daml-stdlib/DA-Internal-Interface-AnyView-Types.dalf)
# These types are not serializable but they need to be stable so users can reuse functions from data-dependencies.
$(location :generate-stable-package) --major-version {major} --module DA.Action.State.Type -o $(location lf-v{major}/daml-stdlib/DA-Action-State-Type.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Random.Types -o $(location lf-v{major}/daml-stdlib/DA-Random-Types.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Stack.Types -o $(location lf-v{major}/daml-stdlib/DA-Stack-Types.dalf)
$(location :generate-stable-package) --major-version {major} --module DA.Types.RoundingMode -o $(location lf-v{major}/daml-stdlib/DA-Types-RoundingMode.dalf)
""".format(major = majorLfVersion),
tools = [":generate-stable-package"],
visibility = ["//visibility:public"],
)
for majorLfVersion in LF_MAJOR_VERSIONS
]

# If you change this you also need to update generateStablePackages in Development.IDE.Core.Rules.Daml
filegroup(
name = "stable-packages",
srcs = [
dalf
for dalfs in [
[
"lf-v{}/daml-prim/DA-Exception-ArithmeticError.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/DA-Exception-AssertionFailed.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/DA-Exception-GeneralError.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/DA-Exception-PreconditionFailed.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/DA-Internal-Erased.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/DA-Internal-NatSyn.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/DA-Internal-PromotedText.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/DA-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/GHC-Prim.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/GHC-Tuple.dalf".format(majorLfVersion),
"lf-v{}/daml-prim/GHC-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Action-State-Type.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Date-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Internal-Any.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Internal-Down.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Internal-Interface-AnyView-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Internal-Template.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Logic-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Monoid-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-NonEmpty-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Random-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Semigroup-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Set-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Stack-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Types-RoundingMode.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Time-Types.dalf".format(majorLfVersion),
"lf-v{}/daml-stdlib/DA-Validation-Types.dalf".format(majorLfVersion),
]
for majorLfVersion in LF_MAJOR_VERSIONS
]
for dalf in dalfs
],
visibility = ["//visibility:public"],
)

genrule(
name = "stable-packages-list-srcs",
outs = ["DA/Daml/StablePackagesList.hs"],
cmd = """
$(location :generate-stable-package) gen-package-list -o $(location DA/Daml/StablePackagesList.hs)
""",
tools = [":generate-stable-package"],
)

# We generate this as a library rather than depending on :stable-packages-lib
# to avoid a cyclical dependency between the daml-lf-proto and :stable-packages-lib
# and to avoid having to encode the packages at runtime to get their package id.
da_haskell_library(
name = "stable-packages-list",
srcs = ["DA/Daml/StablePackagesList.hs"],
hackage_deps = [
"base",
"containers",
],
visibility = ["//visibility:public"],
deps = [
"//compiler/daml-lf-ast",
],
)

generate_and_track_cabal("stable-packages-lib", "generate-stable-package")
2 changes: 1 addition & 1 deletion sdk/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Util.hs
Original file line number Diff line number Diff line change
Expand Up @@ -171,7 +171,7 @@ pattern TDate = TBuiltin BTDate
pattern TArrow = TBuiltin BTArrow
pattern TAny = TBuiltin BTAny
pattern TTypeRep = TBuiltin BTTypeRep
pattern TRoundingMode = TBuiltin BTRoundingMode
pattern TRoundingMode = TCon (Qualified (PRImport (PackageId "46102a82d38452c2c8ff0ce0ec68932a24d9987db316473249a065de870716d1")) (ModuleName ["DA", "Types", "RoundingMode"]) (TypeConName ["RoundingMode"]))
pattern TBigNumeric = TBuiltin BTBigNumeric
pattern TAnyException = TBuiltin BTAnyException

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -626,6 +626,7 @@ generateStablePackages lfVersion fp = do
, "DA-Action-State-Type.dalf"
, "DA-Random-Types.dalf"
, "DA-Stack-Types.dalf"
, "DA-Types-RoundingMode.dalf"
]
]
forM dalfs $ \dalf -> do
Expand Down
7 changes: 0 additions & 7 deletions sdk/compiler/damlc/daml-prim-src/GHC/Classes.daml
Original file line number Diff line number Diff line change
Expand Up @@ -211,8 +211,6 @@ instance Eq (Numeric n) where
#ifdef DAML_BIGNUMERIC
instance Eq BigNumeric where
(==) = primitive @"BEEqual"
instance Eq RoundingMode where
(==) = primitive @"BEEqual"
#endif

instance Eq Text where
Expand Down Expand Up @@ -345,11 +343,6 @@ instance Ord BigNumeric where
(<=) = primitive @"BELessEq"
(>=) = primitive @"BEGreaterEq"
(>) = primitive @"BEGreater"
instance Ord RoundingMode where
(<) = primitive @"BELess"
(<=) = primitive @"BELessEq"
(>=) = primitive @"BEGreaterEq"
(>) = primitive @"BEGreater"
#endif

instance Ord Text where
Expand Down
10 changes: 0 additions & 10 deletions sdk/compiler/damlc/daml-prim-src/GHC/Show.daml
Original file line number Diff line number Diff line change
Expand Up @@ -122,16 +122,6 @@ instance Show (Numeric n) where
#ifdef DAML_BIGNUMERIC
instance Show BigNumeric where
show = primitive @"BEToText"
instance Show RoundingMode where
show = \case
RoundingUp -> "RoundingUp"
RoundingDown -> "RoundingDown"
RoundingCeiling -> "RoundingCeiling"
RoundingFloor -> "RoundingFloor"
RoundingHalfUp -> "RoundingHalfUp"
RoundingHalfDown -> "RoundingHalfDown"
RoundingHalfEven -> "RoundingHalfEven"
RoundingUnnecessary -> "RoundingUnnecessary"
#endif

instance Show Text where
Expand Down
20 changes: 0 additions & 20 deletions sdk/compiler/damlc/daml-prim-src/GHC/Types.daml
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,6 @@ module GHC.Types (
Nat, Numeric,
#ifdef DAML_BIGNUMERIC
BigNumeric,
RoundingMode(..),
#endif
) where

Expand Down Expand Up @@ -217,23 +216,4 @@ data BigNumeric =
-- | HIDE
BigNumeric Opaque

-- | Rounding modes for `BigNumeric` operations like `div` and `round` from `DA.BigNumeric`.
data RoundingMode
= RoundingUp -- ^ Round away from zero.
| RoundingDown -- ^ Round towards zero.
| RoundingCeiling -- ^ Round towards positive infinity.
| RoundingFloor -- ^ Round towards negative infinity.
| RoundingHalfUp
-- ^ Round towards the nearest neighbor unless both neighbors
-- are equidistant, in which case round away from zero.
| RoundingHalfDown
-- ^ Round towards the nearest neighbor unless both neighbors
-- are equidistant, in which case round towards zero.
| RoundingHalfEven
-- ^ Round towards the nearest neighbor unless both neighbors
-- are equidistant, in which case round towards the even neighbor.
| RoundingUnnecessary
-- ^ Do not round. Raises an error if the result cannot
-- be represented without rounding at the targeted scale.

#endif
7 changes: 2 additions & 5 deletions sdk/compiler/damlc/daml-stdlib-src/DA/BigNumeric.daml
Original file line number Diff line number Diff line change
Expand Up @@ -23,11 +23,8 @@ module DA.BigNumeric (
, roundToNumeric
) where

import GHC.Types (
primitive
, BigNumeric
, RoundingMode(..)
)
import GHC.Types (primitive, BigNumeric)
import DA.Types.RoundingMode (RoundingMode(..))
import Prelude hiding (round)

-- | Calculate the scale of a `BigNumeric` number. The `BigNumeric` number is
Expand Down
25 changes: 25 additions & 0 deletions sdk/compiler/damlc/daml-stdlib-src/DA/Types/RoundingMode.daml
Original file line number Diff line number Diff line change
@@ -0,0 +1,25 @@
-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

module DA.Types.RoundingMode (RoundingMode (..)) where

-- | Rounding modes for `BigNumeric` operations like `div` and `round` from `DA.BigNumeric`.
data RoundingMode
= RoundingUp -- ^ Round away from zero.
| RoundingDown -- ^ Round towards zero.
| RoundingCeiling -- ^ Round towards positive infinity.
| RoundingFloor -- ^ Round towards negative infinity.
| RoundingHalfUp
-- ^ Round towards the nearest neighbor unless both neighbors
-- are equidistant, in which case round away from zero.
| RoundingHalfDown
-- ^ Round towards the nearest neighbor unless both neighbors
-- are equidistant, in which case round towards zero.
| RoundingHalfEven
-- ^ Round towards the nearest neighbor unless both neighbors
-- are equidistant, in which case round towards the even neighbor.
| RoundingUnnecessary
-- ^ Do not round. Raises an error if the result cannot
-- be represented without rounding at the targeted scale.


1 change: 1 addition & 0 deletions sdk/compiler/damlc/lib/DA/Cli/Damlc/Packaging.hs
Original file line number Diff line number Diff line change
Expand Up @@ -503,6 +503,7 @@ baseImports =
, "DA.Validation.Types"
, "DA.Date.Types"
, "DA.Time.Types"
, "DA.Types.RoundingMode"
, "DA.Internal.Interface.AnyView.Types"
, "DA.Action.State.Type"
, "DA.Random.Types"
Expand Down
1 change: 1 addition & 0 deletions sdk/compiler/damlc/stable-packages/defs.bzl
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,7 @@ STABLE_PACKAGES = {
"DA.Logic.Types": "lf-v{major}/daml-stdlib/DA-Logic-Types.dalf",
"DA.Validation.Types": "lf-v{major}/daml-stdlib/DA-Validation-Types.dalf",
"DA.Internal.Down": "lf-v{major}/daml-stdlib/DA-Internal-Down.dalf",
"DA.Types.RoundingMode" : "lf-v{major}/daml-stdlib/DA-Types-RoundingMode.dalf",
# These types are not serializable but they leak into typeclass methods so they need to be stable.,
"DA.Internal.Any": "lf-v{major}/daml-stdlib/DA-Internal-Any.dalf",
"DA.Internal.Template": "lf-v{major}/daml-stdlib/DA-Internal-Template.dalf",
Expand Down
29 changes: 29 additions & 0 deletions sdk/compiler/damlc/stable-packages/lib/DA/Daml/StablePackages.hs
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,7 @@ allV2StablePackages =
, daActionStateType version2_1 (encodePackageHash (daTypes version2_1))
, daRandomTypes version2_1
, daStackTypes version2_1
, daTypesRoundingMode version2_1
]

allStablePackages :: MS.Map PackageId Package
Expand Down Expand Up @@ -400,6 +401,34 @@ daStackTypes version = Package
$ mkWorkerDef modName srcLocTyCon [] fields
: fmap (uncurry (mkSelectorDef modName srcLocTyCon [])) fields

daTypesRoundingMode :: Version -> Package
daTypesRoundingMode version = Package
{ packageLfVersion = version
, packageModules = NM.singleton (emptyModule modName)
{ moduleDataTypes = types
}
, packageMetadata = PackageMetadata
{ packageName = PackageName "daml-stdlib-DA-Types-RoundingMode"
, packageVersion = PackageVersion "1.0.0"
, upgradedPackageId = Nothing
}
}
where
modName = mkModName ["DA", "Types", "RoundingMode"]
types = NM.fromList
[ DefDataType Nothing (mkTypeCon ["RoundingMode"]) (IsSerializable True) [] $
DataEnum $ map mkVariantCon
[ "RoundingUp"
, "RoundingDown"
, "RoundingCeiling"
, "RoundingFloor"
, "RoundingHalfUp"
, "RoundingHalfDown"
, "RoundngHalfEven"
, "RoundingUnnecessary"
]
]

daTimeTypes :: Version -> Package
daTimeTypes version = Package
{ packageLfVersion = version
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -251,7 +251,9 @@ class DecodeV1Spec
forEveryVersionSuchThat(_ >= Features.bigNumeric) { version =>
val decoder = moduleDecoder(version)
decoder.uncheckedDecodeTypeForTest(buildPrimType(BIGNUMERIC)) shouldBe TBigNumeric
decoder.uncheckedDecodeTypeForTest(buildPrimType(ROUNDING_MODE)) shouldBe TRoundingMode
decoder.uncheckedDecodeTypeForTest(buildPrimType(ROUNDING_MODE)) shouldBe Ast.TBuiltin(
Ast.BTRoundingMode
)
}
}

Expand Down
Loading

0 comments on commit c4a9318

Please sign in to comment.