Add EViewInterface to LF - stub compilation/interpretation in speedy

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

@@ -284,6 +284,11 @@ alphaExpr' env = \case
     ELocation _ e1 -> \case
         ELocation _ e2 -> alphaExpr' env e1 e2
         _ -> False
+    EViewInterface iface1 expr1 -> \case
+        EViewInterface iface2 expr2
+            -> alphaTypeCon iface1 iface2
+            && alphaExpr' env expr1 expr2
+        _ -> False
     EExperimental n1 t1 -> \case
         EExperimental n2 t2 -> n1 == n2 && alphaType t1 t2
         _ -> False

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

@@ -603,6 +603,11 @@ data Expr
   | EScenario !Scenario
   -- | An expression annotated with a source location.
   | ELocation !SourceLoc !Expr
+  -- | Obtain an interface view
+  | EViewInterface
+    { viewInterfaceInterface :: !(Qualified TypeConName)
+    , viewInterfaceExpr :: !Expr
+    }
   -- | Experimental Expression Hook
   | EExperimental !T.Text !Type
   deriving (Eq, Data, Generic, NFData, Ord, Show)

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

@@ -114,6 +114,7 @@ freeVarsStep = \case
     EInterfaceTemplateTypeRepF _ e -> e
     ESignatoryInterfaceF _ e -> e
     EObserverInterfaceF _ e -> e
+    EViewInterfaceF _ e -> e
     EExperimentalF _ t -> freeVarsInType t
 
   where

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

@@ -552,6 +552,8 @@ instance Pretty Expr where
         [interfaceArg ty, TmArg expr]
     EObserverInterface ty expr -> pPrintAppKeyword lvl prec "observer_interface"
         [interfaceArg ty, TmArg expr]
+    EViewInterface iface expr -> pPrintAppKeyword lvl prec "view"
+        [interfaceArg iface, TmArg expr]
     EExperimental name _ ->  pPrint $ "$" <> name
 
 instance Pretty DefTypeSyn where

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

@@ -60,6 +60,7 @@ data ExprF expr
   | EInterfaceTemplateTypeRepF !(Qualified TypeConName) !expr
   | ESignatoryInterfaceF !(Qualified TypeConName) !expr
   | EObserverInterfaceF !(Qualified TypeConName) !expr
+  | EViewInterfaceF !(Qualified TypeConName) !expr
   | EExperimentalF !T.Text !Type
   deriving (Foldable, Functor, Traversable)
 
@@ -221,6 +222,7 @@ instance Recursive Expr where
     EInterfaceTemplateTypeRep a b -> EInterfaceTemplateTypeRepF a b
     ESignatoryInterface a b -> ESignatoryInterfaceF a b
     EObserverInterface a b -> EObserverInterfaceF a b
+    EViewInterface a b -> EViewInterfaceF a b
     EExperimental a b -> EExperimentalF a b
 
 instance Corecursive Expr where
@@ -265,4 +267,5 @@ instance Corecursive Expr where
     EInterfaceTemplateTypeRepF a b -> EInterfaceTemplateTypeRep a b
     ESignatoryInterfaceF a b -> ESignatoryInterface a b
     EObserverInterfaceF a b -> EObserverInterface a b
+    EViewInterfaceF a b -> EViewInterface a b
     EExperimentalF a b -> EExperimental a b

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

@@ -221,6 +221,9 @@ applySubstInExpr subst@Subst{..} = \case
     ELocation l e -> ELocation
         l
         (applySubstInExpr subst e)
+    EViewInterface iface expr -> EViewInterface
+        iface
+        (applySubstInExpr subst expr)
     EExperimental name ty ->
         EExperimental name (applySubstInType subst ty)
 

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

@@ -709,6 +709,9 @@ decodeExprSum exprSum = mayDecode "exprSum" exprSum $ \case
   LF1.ExprSumObserverInterface LF1.Expr_ObserverInterface {..} -> EObserverInterface
     <$> mayDecode "expr_ObserverInterfaceInterface" expr_ObserverInterfaceInterface decodeTypeConName
     <*> mayDecode "expr_ObserverInterfaceExpr" expr_ObserverInterfaceExpr decodeExpr
+  LF1.ExprSumViewInterface LF1.Expr_ViewInterface {..} -> EViewInterface
+    <$> mayDecode "expr_ViewInterfaceInterface" expr_ViewInterfaceInterface decodeTypeConName
+    <*> mayDecode "expr_ViewInterfaceExpr" expr_ViewInterfaceExpr decodeExpr
   LF1.ExprSumExperimental (LF1.Expr_Experimental name mbType) -> do
     ty <- mayDecode "expr_Experimental" mbType decodeType
     pure $ EExperimental (decodeString name) ty

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

@@ -736,6 +736,10 @@ encodeExpr' = \case
         expr_ObserverInterfaceInterface <- encodeQualTypeConName ty
         expr_ObserverInterfaceExpr <- encodeExpr val
         pureExpr $ P.ExprSumObserverInterface P.Expr_ObserverInterface{..}
+    EViewInterface iface expr -> do
+        expr_ViewInterfaceInterface <- encodeQualTypeConName iface
+        expr_ViewInterfaceExpr <- encodeExpr expr
+        pureExpr $ P.ExprSumViewInterface P.Expr_ViewInterface{..}
     EExperimental name ty -> do
         let expr_ExperimentalName = encodeString name
         expr_ExperimentalType <- encodeType ty

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

@@ -217,6 +217,7 @@ safetyStep = \case
   EInterfaceTemplateTypeRepF _ s -> s <> Safe 0
   ESignatoryInterfaceF _ s -> s <> Safe 0
   EObserverInterfaceF _ s -> s <> Safe 0
+  EViewInterfaceF _ _ -> Unsafe
   EExperimentalF _ _ -> Unsafe
 
 isTypeClassDictionary :: DefValue -> Bool

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

@@ -793,6 +793,10 @@ typeOf' = \case
   EUpdate upd -> typeOfUpdate upd
   EScenario scen -> typeOfScenario scen
   ELocation _ expr -> typeOf' expr
+  EViewInterface ifaceId expr -> do
+    iface <- inWorld (lookupInterface ifaceId)
+    checkExpr expr (TCon ifaceId)
+    pure (intView iface)
   EExperimental name ty -> do
     checkFeature featureExperimental
     checkExperimentalType name ty

compiler/damlc/daml-lf-conversion/src/DA/Daml/LFConversion.hs

@@ -1193,6 +1193,8 @@ internalFunctions = listToUFM $ map (bimap mkModuleNameFS mkUniqSet)
         ])
     , ("DA.Internal.Desugar",
         [ "mkMethod"
+        , "mkInterfaceView"
+        , "view"
         ])
     ]
 

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

@@ -971,6 +971,13 @@ message Expr {
     Expr interface_expr = 3;
   }
 
+  // Obtain an interface view
+  // *Available in versions >= 1.dev*
+  message ViewInterface {
+    TypeConName interface = 1;
+    Expr expr = 2;
+  }
+
   // Obtain the type representation of a contract through an interface
   // *Available in versions >= 1.dev*
   message InterfaceTemplateTypeRep {
@@ -1137,6 +1144,10 @@ message Expr {
     // Unsafe downcast interface payloads.
     UnsafeFromRequiredInterface unsafe_from_required_interface = 45;
 
+    // Invoke an interface method.
+    // *Available in versions >= 1.dev*
+    ViewInterface view_interface = 46;
+
     Experimental experimental = 9999; // *Available only in 1.dev*
   }
 

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

@@ -1227,6 +1227,14 @@ private[archive] class DecodeV1(minor: LV.Minor) {
         case PLF.Expr.SumCase.SUM_NOT_SET =>
           throw Error.Parsing("Expr.SUM_NOT_SET")
 
+        case PLF.Expr.SumCase.VIEW_INTERFACE =>
+          assertSince(LV.Features.interfaces, "Expr.view_interface")
+          val viewInterface = lfExpr.getViewInterface
+          EViewInterface(
+            ifaceId = decodeTypeConName(viewInterface.getInterface),
+            expr = decodeExpr(viewInterface.getExpr, definition),
+          )
+
         case PLF.Expr.SumCase.EXPERIMENTAL =>
           assertSince(LV.v1_dev, "Expr.experimental")
           val experimental = lfExpr.getExperimental

daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/PhaseOne.scala

@@ -367,6 +367,10 @@ private[lf] final class PhaseOne(
         compileExp(env, exp) { exp =>
           Return(SBObserverInterface(ifaceId)(exp))
         }
+      case EViewInterface(ifaceId, exp) =>
+        compileExp(env, exp) { exp =>
+          Return(SBViewInterface(ifaceId)(exp))
+        }
       case EExperimental(name, _) =>
         Return(SBExperimental(name))
     }

daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/SBuiltin.scala

@@ -1338,6 +1338,16 @@ private[lf] object SBuiltin {
     }
   }
 
+  final case class SBViewInterface(
+      ifaceId: TypeConName
+  ) extends SBuiltin(1) {
+    override private[speedy] def execute(args: util.ArrayList[SValue], machine: Machine): Unit = {
+      crash(
+        s"Tried to run unsupported view with interface ${ifaceId}."
+      )
+    }
+  }
+
   /** $insertFetch[tid]
     *    :: ContractId a
     *    -> List Party    (signatories)

daml-lf/language/src/main/scala/com/digitalasset/daml/lf/language/Ast.scala

@@ -217,6 +217,12 @@ object Ast {
       body: Expr,
   ) extends Expr
 
+  /** Obtain the view of an interface. */
+  final case class EViewInterface(
+      ifaceId: TypeConName,
+      expr: Expr,
+  ) extends Expr
+
   //
   // Kinds
   //

daml-lf/parser/src/main/scala/com/digitalasset/daml/lf/testing/parser/AstRewriter.scala

@@ -148,6 +148,8 @@ private[daml] class AstRewriter(
           EInterfaceTemplateTypeRep(apply(ifaceId), apply(body))
         case ESignatoryInterface(ifaceId, body) =>
           ESignatoryInterface(apply(ifaceId), apply(body))
+        case EViewInterface(ifaceId, expr) =>
+          EViewInterface(apply(ifaceId), apply(expr))
         case EObserverInterface(ifaceId, body) =>
           EObserverInterface(apply(ifaceId), apply(body))
       }

daml-lf/validation/src/main/scala/com/digitalasset/daml/lf/validation/Typing.scala

@@ -1261,6 +1261,10 @@ private[validation] object Typing {
         discard(handleLookup(ctx, pkgInterface.lookupInterface(ifaceId)))
         checkExpr(body, TTyCon(ifaceId))
         TList(TParty)
+      case EViewInterface(ifaceId, expr) =>
+        val iface = handleLookup(ctx, pkgInterface.lookupInterface(ifaceId))
+        checkExpr(expr, TTyCon(ifaceId))
+        iface.view
       case EExperimental(_, typ) =>
         typ
     }

daml-lf/validation/src/main/scala/com/digitalasset/daml/lf/validation/iterable/ExprIterable.scala

@@ -82,6 +82,8 @@ private[validation] object ExprIterable {
         iterator(body)
       case ESignatoryInterface(iface @ _, body) =>
         iterator(body)
+      case EViewInterface(ifaceId @ _, expr) =>
+        iterator(expr)
       case EObserverInterface(iface @ _, body) =>
         iterator(body)
     }

daml-lf/validation/src/main/scala/com/digitalasset/daml/lf/validation/iterable/TypeIterable.scala

@@ -99,6 +99,9 @@ private[validation] object TypeIterable {
         Iterator(TTyCon(ifaceId)) ++ iterator(body)
       case EObserverInterface(ifaceId, body) =>
         Iterator(TTyCon(ifaceId)) ++ iterator(body)
+      case EViewInterface(ifaceId, expr) =>
+        Iterator(TTyCon(ifaceId)) ++
+          iterator(expr)
       case EVar(_) | EVal(_) | EBuiltin(_) | EPrimCon(_) | EPrimLit(_) | EApp(_, _) | ECase(_, _) |
           ELocation(_, _) | EStructCon(_) | EStructProj(_, _) | EStructUpd(_, _, _) | ETyAbs(_, _) |
           EExperimental(_, _) =>