Update protobuf to throw exceptions directly.

Part of #8020. This PR changes the exception protobuf and AST (Haskell
side) to make exceptions be thrown directly via a primitive expression
(EThrow), instead of wrapping them up via AnyException.

changelog_begin
changelog_end

compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Alpha.hs

@@ -196,13 +196,20 @@ alphaExpr' env = \case
     ETypeRep t1 -> \case
         ETypeRep t2 -> alphaType' env t1 t2
         _ -> False
-    EMakeAnyException t1 e1a e1b -> \case
-        EMakeAnyException t2 e2a e2b -> alphaType' env t1 t2
-            && alphaExpr' env e1a e2a
-            && alphaExpr' env e1b e2b
+    EMakeAnyException t1 e1 -> \case
+        EMakeAnyException t2 e2
+            -> alphaType' env t1 t2
+            && alphaExpr' env e1 e2
         _ -> False
     EFromAnyException t1 e1 -> \case
-        EFromAnyException t2 e2 -> alphaType' env t1 t2
+        EFromAnyException t2 e2
+            -> alphaType' env t1 t2
+            && alphaExpr' env e1 e2
+        _ -> False
+    EThrow t1a t1b e1 -> \case
+        EThrow t2a t2b e2
+            -> alphaType' env t1a t2a
+            && alphaType' env t1b t2b
             && alphaExpr' env e1 e2
         _ -> False
     EUpdate u1 -> \case

compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Base.hs

@@ -236,7 +236,6 @@ data BuiltinExpr
 
   -- Exceptions
   | BEError                      -- :: ∀a. Text -> a
-  | BEThrow                      -- :: ∀a. AnyException -> a
   | BEAnyExceptionMessage        -- :: AnyException -> Text
   | BEGeneralErrorMessage        -- :: GeneralError -> Text
   | BEArithmeticErrorMessage     -- :: ArithmeticError -> Text
@@ -518,14 +517,19 @@ data Expr
   -- | Construct an 'AnyException' value from a value of an exception type.
   | EMakeAnyException
     { makeAnyExceptionType :: !Type
-    , makeAnyExceptionMessage :: !Expr
     , makeAnyExceptionValue :: !Expr
     }
   -- | Convert 'AnyException' back to its underlying value, if possible.
   | EFromAnyException
     { fromAnyExceptionType :: !Type
     , fromAnyExceptionValue :: !Expr
     }
+  -- | Throw an exception.
+  | EThrow
+    { throwReturnType :: !Type
+    , throwExceptionType :: !Type
+    , throwExceptionValue :: !Expr
+    }
   -- | Update expression.
   | EUpdate !Update
   -- | Scenario expression.
@@ -831,6 +835,7 @@ data Template = Template
 data DefException = DefException
   { exnLocation :: !(Maybe SourceLoc)
   , exnName :: !TypeConName
+  , exnMessage :: !Expr
   }
   deriving (Eq, Data, Generic, NFData, Show)
 

compiler/daml-lf-ast/src/DA/Daml/LF/Ast/FreeVars.hs

@@ -101,8 +101,9 @@ freeVarsStep = \case
     EToAnyF t e -> freeVarsInType t <> e
     EFromAnyF t e -> freeVarsInType t <> e
     ETypeRepF t -> freeVarsInType t
-    EMakeAnyExceptionF t e1 e2 -> freeVarsInType t <> e1 <> e2
+    EMakeAnyExceptionF t e -> freeVarsInType t <> e
     EFromAnyExceptionF t e -> freeVarsInType t <> e
+    EThrowF t1 t2 e -> freeVarsInType t1 <> freeVarsInType t2 <> e
 
   where
 

compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Pretty.hs

@@ -211,7 +211,6 @@ instance Pretty BuiltinExpr where
     BEUnit -> keyword_ "unit"
     BEBool b -> keyword_ $ case b of { False -> "false"; True -> "true" }
     BEError -> "ERROR"
-    BEThrow -> "THROW"
     BEAnyExceptionMessage -> "ANY_EXCEPTION_MESSAGE"
     BEGeneralErrorMessage -> "GENERAL_ERROR_MESSAGE"
     BEArithmeticErrorMessage -> "ARITHMETIC_ERROR_MESSAGE"
@@ -509,10 +508,12 @@ instance Pretty Expr where
     EToAny ty body -> pPrintAppKeyword lvl prec "to_any" [TyArg ty, TmArg body]
     EFromAny ty body -> pPrintAppKeyword lvl prec "from_any" [TyArg ty, TmArg body]
     ETypeRep ty -> pPrintAppKeyword lvl prec "type_rep" [TyArg ty]
-    EMakeAnyException ty msg val -> pPrintAppKeyword lvl prec "make_any_exception"
-        [TyArg ty, TmArg msg, TmArg val]
+    EMakeAnyException ty val -> pPrintAppKeyword lvl prec "make_any_exception"
+        [TyArg ty, TmArg val]
     EFromAnyException ty val -> pPrintAppKeyword lvl prec "from_any_exception"
         [TyArg ty, TmArg val]
+    EThrow ty1 ty2 val -> pPrintAppKeyword lvl prec "throw"
+        [TyArg ty1, TyArg ty2, TmArg val]
 
 instance Pretty DefTypeSyn where
   pPrintPrec lvl _prec (DefTypeSyn mbLoc syn params typ) =
@@ -521,8 +522,10 @@ instance Pretty DefTypeSyn where
       lhsDoc = pPrint syn <-> hsep (map (pPrintAndKind lvl precParam) params) <-> "="
 
 instance Pretty DefException where
-  pPrintPrec lvl _prec (DefException mbLoc tycon) =
-    withSourceLoc lvl mbLoc (keyword_ "exception" <-> pPrint tycon)
+  pPrintPrec lvl _prec (DefException mbLoc tycon msg) =
+    withSourceLoc lvl mbLoc
+      $ (keyword_ "exception" <-> pPrint tycon <-> "where")
+      $$ nest 2 ("message =" <-> pPrintPrec lvl 0 msg)
 
 instance Pretty DefDataType where
   pPrintPrec lvl _prec (DefDataType mbLoc tcon (IsSerializable serializable) params dataCons) =

compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Recursive.hs

@@ -46,8 +46,9 @@ data ExprF expr
   | EToAnyF !Type !expr
   | EFromAnyF !Type !expr
   | ETypeRepF !Type
-  | EMakeAnyExceptionF !Type !expr !expr
+  | EMakeAnyExceptionF !Type !expr
   | EFromAnyExceptionF !Type !expr
+  | EThrowF !Type !Type !expr
   deriving (Foldable, Functor, Traversable)
 
 data BindingF expr = BindingF !(ExprVarName, Type) !expr
@@ -186,7 +187,7 @@ instance Recursive Expr where
     EToAny a b  -> EToAnyF a b
     EFromAny a b -> EFromAnyF a b
     ETypeRep a -> ETypeRepF a
-    EMakeAnyException a b c -> EMakeAnyExceptionF a b c
+    EMakeAnyException a b -> EMakeAnyExceptionF a b
     EFromAnyException a b -> EFromAnyExceptionF a b
 
 instance Corecursive Expr where
@@ -218,5 +219,6 @@ instance Corecursive Expr where
     EToAnyF a b  -> EToAny a b
     EFromAnyF a b -> EFromAny a b
     ETypeRepF a -> ETypeRep a
-    EMakeAnyExceptionF a b c -> EMakeAnyException a b c
+    EMakeAnyExceptionF a b -> EMakeAnyException a b
     EFromAnyExceptionF a b -> EFromAnyException a b
+    EThrowF a b c -> EThrow a b c

compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Subst.hs

@@ -182,13 +182,16 @@ applySubstInExpr subst@Subst{..} = \case
         (applySubstInExpr subst e)
     ETypeRep t -> ETypeRep
         (applySubstInType subst t)
-    EMakeAnyException t e1 e2 -> EMakeAnyException
+    EMakeAnyException t e -> EMakeAnyException
         (applySubstInType subst t)
-        (applySubstInExpr subst e1)
-        (applySubstInExpr subst e2)
+        (applySubstInExpr subst e)
     EFromAnyException t e -> EFromAnyException
         (applySubstInType subst t)
         (applySubstInExpr subst e)
+    EThrow t1 t2 e -> EThrow
+        (applySubstInType subst t1)
+        (applySubstInType subst t2)
+        (applySubstInExpr subst e)
     EUpdate u -> EUpdate
         (applySubstInUpdate subst u)
     EScenario s -> EScenario

compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/DecodeV1.hs

@@ -249,6 +249,7 @@ decodeDefException LF1.DefException{..} =
   DefException
     <$> traverse decodeLocation defExceptionLocation
     <*> decodeDottedNameId TypeConName defExceptionNameInternedDname
+    <*> mayDecode "exceptionMessage" defExceptionMessage decodeExpr
 
 decodeDefDataType :: LF1.DefDataType -> Decode DefDataType
 decodeDefDataType LF1.DefDataType{..} =
@@ -441,7 +442,6 @@ decodeBuiltinFunction = pure . \case
   LF1.BuiltinFunctionAPPEND_TEXT    -> BEAppendText
 
   LF1.BuiltinFunctionERROR          -> BEError
-  LF1.BuiltinFunctionTHROW -> BEThrow
   LF1.BuiltinFunctionANY_EXCEPTION_MESSAGE -> BEAnyExceptionMessage
   LF1.BuiltinFunctionGENERAL_ERROR_MESSAGE -> BEGeneralErrorMessage
   LF1.BuiltinFunctionARITHMETIC_ERROR_MESSAGE -> BEArithmeticErrorMessage
@@ -606,11 +606,14 @@ decodeExprSum exprSum = mayDecode "exprSum" exprSum $ \case
     ETypeRep <$> decodeType typ
   LF1.ExprSumMakeAnyException LF1.Expr_MakeAnyException {..} -> EMakeAnyException
     <$> mayDecode "expr_MakeAnyExceptionType" expr_MakeAnyExceptionType decodeType
-    <*> mayDecode "expr_MakeAnyExceptionMessage" expr_MakeAnyExceptionMessage decodeExpr
     <*> mayDecode "expr_MakeAnyExceptionExpr" expr_MakeAnyExceptionExpr decodeExpr
   LF1.ExprSumFromAnyException LF1.Expr_FromAnyException {..} -> EFromAnyException
     <$> mayDecode "expr_FromAnyExceptionType" expr_FromAnyExceptionType decodeType
     <*> mayDecode "expr_FromAnyExceptionExpr" expr_FromAnyExceptionExpr decodeExpr
+  LF1.ExprSumThrow LF1.Expr_Throw {..} -> EThrow
+    <$> mayDecode "expr_ThrowReturnType" expr_ThrowReturnType decodeType
+    <*> mayDecode "expr_ThrowExceptionType" expr_ThrowExceptionType decodeType
+    <*> mayDecode "expr_ThrowExceptionExpr" expr_ThrowExceptionExpr decodeExpr
 
 decodeUpdate :: LF1.Update -> Decode Expr
 decodeUpdate LF1.Update{..} = mayDecode "updateSum" updateSum $ \case

compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/EncodeV1.hs

@@ -517,7 +517,6 @@ encodeBuiltinExpr = \case
     BESha256Text -> builtin P.BuiltinFunctionSHA256_TEXT
 
     BEError -> builtin P.BuiltinFunctionERROR
-    BEThrow -> builtin P.BuiltinFunctionTHROW
     BEAnyExceptionMessage -> builtin P.BuiltinFunctionANY_EXCEPTION_MESSAGE
     BEGeneralErrorMessage -> builtin P.BuiltinFunctionGENERAL_ERROR_MESSAGE
     BEArithmeticErrorMessage -> builtin P.BuiltinFunctionARITHMETIC_ERROR_MESSAGE
@@ -673,15 +672,19 @@ encodeExpr' = \case
         pureExpr $ P.ExprSumFromAny P.Expr_FromAny{..}
     ETypeRep ty -> do
         expr . P.ExprSumTypeRep <$> encodeType' ty
-    EMakeAnyException ty msg val -> do
+    EMakeAnyException ty val -> do
         expr_MakeAnyExceptionType <- encodeType ty
-        expr_MakeAnyExceptionMessage <- encodeExpr msg
         expr_MakeAnyExceptionExpr <- encodeExpr val
         pureExpr $ P.ExprSumMakeAnyException P.Expr_MakeAnyException{..}
     EFromAnyException ty val -> do
         expr_FromAnyExceptionType <- encodeType ty
         expr_FromAnyExceptionExpr <- encodeExpr val
         pureExpr $ P.ExprSumFromAnyException P.Expr_FromAnyException{..}
+    EThrow ty1 ty2 val -> do
+        expr_ThrowReturnType <- encodeType ty1
+        expr_ThrowExceptionType <- encodeType ty2
+        expr_ThrowExceptionExpr <- encodeExpr val
+        pureExpr $ P.ExprSumThrow P.Expr_Throw{..}
   where
     expr = P.Expr Nothing . Just
     pureExpr = pure . expr
@@ -856,6 +859,7 @@ encodeDefException :: DefException -> Encode P.DefException
 encodeDefException DefException{..} = do
     defExceptionNameInternedDname <- encodeDottedNameId unTypeConName exnName
     defExceptionLocation <- traverse encodeSourceLoc exnLocation
+    defExceptionMessage <- encodeExpr exnMessage
     pure P.DefException{..}
 
 encodeTemplate :: Template -> Encode P.DefTemplate

compiler/daml-lf-tools/src/DA/Daml/LF/Simplifier.hs

@@ -83,7 +83,6 @@ safetyStep = \case
       BEUnit              -> Safe 0
       BEBool _            -> Safe 0
       BEError             -> Safe 0
-      BEThrow -> Safe 0
       BEAnyExceptionMessage -> Safe 1
       BEGeneralErrorMessage -> Safe 1
       BEArithmeticErrorMessage -> Safe 1
@@ -216,12 +215,13 @@ safetyStep = \case
     | Safe _ <- s -> Safe 0
     | otherwise -> Unsafe
   ETypeRepF _ -> Safe 0
-  EMakeAnyExceptionF _ s1 s2
-    | Safe _ <- min s1 s2 -> Safe 0
+  EMakeAnyExceptionF _ s
+    | Safe _ <- s -> Safe 0
     | otherwise -> Unsafe
   EFromAnyExceptionF _ s
     | Safe _ <- s -> Safe 0
     | otherwise -> Unsafe
+  EThrowF _ _ _ -> Unsafe
 
 isTypeClassDictionary :: DefValue -> Bool
 isTypeClassDictionary DefValue{..}

compiler/daml-lf-tools/src/DA/Daml/LF/TypeChecker/Check.hs

@@ -214,7 +214,6 @@ typeOfBuiltin = \case
   BEUnit             -> pure TUnit
   BEBool _           -> pure TBool
   BEError            -> pure $ TForall (alpha, KStar) (TText :-> tAlpha)
-  BEThrow            -> pure $ TForall (alpha, KStar) (TAnyException :-> tAlpha)
   BEAnyExceptionMessage -> pure $ TAnyException :-> TText
   BEGeneralErrorMessage -> pure $ TGeneralError :-> TText
   BEArithmeticErrorMessage -> pure $ TArithmeticError :-> TText
@@ -699,15 +698,19 @@ typeOf' = \case
   ETypeRep ty -> do
     checkGroundType ty
     pure $ TBuiltin BTTypeRep
-  EMakeAnyException ty msg val -> do
+  EMakeAnyException ty val -> do
     checkExceptionType ty
-    checkExpr msg TText
     checkExpr val ty
     pure TAnyException
   EFromAnyException ty val -> do
     checkExceptionType ty
     checkExpr val TAnyException
     pure (TOptional ty)
+  EThrow ty1 ty2 val -> do
+    checkType ty1 KStar
+    checkExceptionType ty2
+    checkExpr val ty2
+    pure ty1
   EUpdate upd -> typeOfUpdate upd
   EScenario scen -> typeOfScenario scen
   ELocation _ expr -> typeOf' expr
@@ -837,6 +840,7 @@ checkDefException m DefException{..} = do
         tcon = Qualified PRSelf modName exnName
     DefDataType _loc _name _serializable tyParams dataCons <- inWorld (lookupDataType tcon)
     unless (null tyParams) $ throwWithContext (EExpectedExceptionTypeHasNoParams modName exnName)
+    checkExpr exnMessage (TCon tcon :-> TText)
     _ <- match _DataRecord (EExpectedExceptionTypeIsRecord modName exnName) dataCons
     case NM.lookup exnName (moduleTemplates m) of
         Nothing -> pure ()

daml-lf/archive/src/main/protobuf/com/daml/daml_lf_dev/daml_lf_1.proto

@@ -485,7 +485,6 @@ enum BuiltinFunction {
   APPEND_TEXT = 24;
 
   ERROR = 25;
-  THROW = 137;                      // *Available in versions >= 1.dev*
   ANY_EXCEPTION_MESSAGE = 138;      // *Available in versions >= 1.dev*
   MAKE_GENERAL_ERROR = 139;         // *Available in versions >= 1.dev*
   GENERAL_ERROR_MESSAGE = 140;      // *Available in versions >= 1.dev*
@@ -885,19 +884,27 @@ message Expr {
     Type type = 1;
     // argument
     Expr expr = 2;
-    // error message
-    Expr message = 3;
   }
 
   // Extract the given exception type from AnyException or return None on type-mismatch
-  // *Available in versions >= 1.7*
+  // *Available in versions >= 1.dev*
   message FromAnyException {
     // type that should be extracted. Must be an exception type.
     Type type = 1;
     // Value of type AnyException
     Expr expr = 2;
   }
 
+  // Throw an exception.
+  // *Available in versions >= 1.dev*
+  message Throw {
+    // Overall type of the "throw" expression.
+    Type return_type = 1;
+    // Type of exception to throw. Must be an exception type.
+    Type exception_type = 2;
+    // Value of type "exception_type".
+    Expr exception_expr = 3;
+  }
 
   // Location of the expression in the DAML code source.
   // Optional
@@ -1004,6 +1011,10 @@ message Expr {
     // Extract an arbitrary exception from an AnyException ('ExpFromAnyException').
     // *Available in versions >= 1.dev*
     FromAnyException from_any_exception = 34;
+
+    // Throw an exception ('ExpThrow').
+    // *Available in versions >= 1.dev*
+    Throw throw = 35;
   }
 
   reserved 19; // This was equals. Removed in favour of BuiltinFunction.EQUAL_*
@@ -1418,6 +1429,7 @@ message DefException {
   // *Must be a valid interned dotted name*
   int32 name_interned_dname = 1;
   Location location = 2;
+  Expr message = 3;
 }
 
 // Data type definition

daml-lf/archive/src/main/scala/com/digitalasset/daml/lf/archive/DecodeV1.scala

@@ -988,10 +988,13 @@ private[archive] class DecodeV1(minor: LV.Minor) extends Decode.OfPackage[PLF.Pa
           ETypeRep(decodeType(lfExpr.getTypeRep))
 
         case PLF.Expr.SumCase.MAKE_ANY_EXCEPTION =>
-          throw ParseError("Expr.MAKE_ANY_EXCEPTION") // TODO #8020
+          throw ParseError("Expr.MAKE_ANY_EXCEPTION") // TODO https://github.com/digital-asset/daml/issues/8020
 
         case PLF.Expr.SumCase.FROM_ANY_EXCEPTION =>
-          throw ParseError("Expr.FROM_ANY_EXCEPTION") // TODO #8020
+          throw ParseError("Expr.FROM_ANY_EXCEPTION") // TODO https://github.com/digital-asset/daml/issues/8020
+
+        case PLF.Expr.SumCase.THROW =>
+          throw ParseError("Expr.THROW") // TODO https://github.com/digital-asset/daml/issues/8020
 
         case PLF.Expr.SumCase.SUM_NOT_SET =>
           throw ParseError("Expr.SUM_NOT_SET")
@@ -1698,7 +1701,6 @@ private[lf] object DecodeV1 {
       BuiltinFunctionInfo(EQUAL_CONTRACT_ID, BEqualContractId, maxVersion = Some(genMap)),
       BuiltinFunctionInfo(TRACE, BTrace),
       BuiltinFunctionInfo(COERCE_CONTRACT_ID, BCoerceContractId),
-      BuiltinFunctionInfo(THROW, BTextToUpper, minVersion = exceptions), // TODO #8020
       BuiltinFunctionInfo(MAKE_GENERAL_ERROR, BTextToUpper, minVersion = exceptions), // TODO #8020
       BuiltinFunctionInfo(MAKE_ARITHMETIC_ERROR, BTextToUpper, minVersion = exceptions), // TODO #8020
       BuiltinFunctionInfo(MAKE_CONTRACT_ERROR, BTextToUpper, minVersion = exceptions), // TODO #8020