Disambiguate consuming vs pre-consuming choices (digital-asset#4164)

changelog_begin - [DAML Compiler] Choices marked explicitly as `preconsuming` are now equivalent to a non-consuming choice that calles `archive self` at the beginning. changelog_end Co-authored-by: Shayne Fletcher <shayne.fletcher@digitalasset.com>
FlashSheridan · Jan 22, 2020 · e9d67ba · e9d67ba
1 parent 8e1e91d
commit e9d67ba
Show file tree

Hide file tree

Showing 3 changed files with 21 additions and 13 deletions.
diff --git a/compiler/damlc/daml-lf-conversion/src/DA/Daml/LFConversion.hs b/compiler/damlc/daml-lf-conversion/src/DA/Daml/LFConversion.hs
@@ -402,6 +402,7 @@ convertModule lfVersion pkgMap stablePackages isGenerated file x = runConvertM (
           }
 
 data Consuming = PreConsuming
+               | Consuming
                | NonConsuming
                | PostConsuming
                deriving (Eq)
@@ -590,20 +591,26 @@ convertChoice env tbinds (ChoiceData ty expr)
         TConApp (Qualified { qualObject = TypeConName con }) _
             | con == ["NonConsuming"] -> pure NonConsuming
             | con == ["PreConsuming"] -> pure PreConsuming
+            | con == ["Consuming"] -> pure Consuming
             | con == ["PostConsuming"] -> pure PostConsuming
         _ -> unhandled "choice consumption type" (show consumingTy)
     let update = action `ETmApp` EVar self `ETmApp` EVar this `ETmApp` EVar arg
     archiveSelf <- useSingleMethodDict env fArchive (`ETmApp` EVar self)
-    update <- pure $ if consuming /= PostConsuming
-        then update
-        else EUpdate $ UBind (Binding (res, choiceRetTy) update) $
-            EUpdate $ UBind (Binding (mkVar "_", TUnit) archiveSelf) $
-            EUpdate $ UPure choiceRetTy $ EVar res
-
+    update <- pure $
+      case consuming of
+        Consuming -> update
+        NonConsuming -> update
+        PreConsuming ->
+          EUpdate $ UBind (Binding (mkVar "_", TUnit) archiveSelf) $
+          update
+        PostConsuming ->
+          EUpdate $ UBind (Binding (res, choiceRetTy) update) $
+          EUpdate $ UBind (Binding (mkVar "_", TUnit) archiveSelf) $
+          EUpdate $ UPure choiceRetTy $ EVar res
     pure TemplateChoice
         { chcLocation = Nothing
         , chcName = choiceName
-        , chcConsuming = consuming == PreConsuming
+        , chcConsuming = consuming == Consuming
         , chcControllers = controllers `ETmApp` EVar this `ETmApp` EVar (arg)
         , chcSelfBinder = self
         , chcArgBinder = (arg, choiceTy)
@@ -664,7 +671,7 @@ internalTypes :: UniqSet FastString
 internalTypes = mkUniqSet ["Scenario","Update","ContractId","Time","Date","Party","Pair", "TextMap", "Map", "Any", "TypeRep"]
 
 consumingTypes :: UniqSet FastString
-consumingTypes = mkUniqSet ["PreConsuming", "PostConsuming", "NonConsuming"]
+consumingTypes = mkUniqSet ["Consuming", "PreConsuming", "PostConsuming", "NonConsuming"]
 
 internalFunctions :: UniqFM (UniqSet FastString)
 internalFunctions = listToUFM $ map (bimap mkModuleNameFS mkUniqSet)

diff --git a/compiler/damlc/daml-stdlib-src/DA/Internal/Desugar.daml b/compiler/damlc/daml-stdlib-src/DA/Internal/Desugar.daml
@@ -13,7 +13,7 @@ module DA.Internal.Desugar (
     Bool(..), Text, Optional,
     concat, magic,
     Party, ContractId, Update, Any,
-    NonConsuming(..), PreConsuming(..), PostConsuming(..)
+    NonConsuming(..), PreConsuming(..), PostConsuming(..), Consuming(..)
 ) where
 
 import DA.Internal.Prelude
@@ -25,4 +25,5 @@ import GHC.Types (magic)
 -- These are only used as markers by desugaring, we do not translate them to LF.
 data NonConsuming t = NonConsuming {}
 data PreConsuming t = PreConsuming {}
+data Consuming t = Consuming {}
 data PostConsuming t = PostConsuming {}
diff --git a/stack-snapshot.yaml b/stack-snapshot.yaml
@@ -1,9 +1,9 @@
 resolver: lts-14.1
 packages:
-  - archive: http://digitalassetsdk.bintray.com/ghc-lib/ghc-lib-parser-8.8.1.20200115.tar.gz
-    sha256: "36644a5d2bb672b1c2c887e0df129b4152631dfb5c672d835e826b0886c63b1e"
-  - archive: http://digitalassetsdk.bintray.com/ghc-lib/ghc-lib-8.8.1.20200115.tar.gz
-    sha256: "b62b2853fb5b65046557dfe3163e1d4a5d271614c58331695434c6b4602d098b"
+  - archive: http://digitalassetsdk.bintray.com/ghc-lib/ghc-lib-parser-8.8.1.20200122.tar.gz
+    sha256: "7b77b8c6a9528e8e3856d783685dddc253c1e17d2b4bd52f7fd4363b65ce5adf"
+  - archive: http://digitalassetsdk.bintray.com/ghc-lib/ghc-lib-8.8.1.20200122.tar.gz
+    sha256: "50d6942d35cef80a8159b4f593bca467e9186c7efcdbe010dfd2e654d90888bd"
   - github: digital-asset/hlint
     commit: "2de70183ba81d71faa67a339fc72f8fe86a2f6d1"
     sha256: "3dff215c25e1e4afdd949930c483b5e56394a8091784da18766ae85492c7b370"