Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

add prefetchContracts primitive to the compiler #20415

Draft
wants to merge 1 commit into
base: main
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions sdk/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Alpha.hs
Original file line number Diff line number Diff line change
Expand Up @@ -519,6 +519,9 @@ alphaUpdate env = \case
&& alphaExpr' env e1a e2a
&& alphaExpr' (bindExprVar x1 x2 env) e1b e2b
_ -> structuralMismatch
UPrefetchContracts e1 -> \case
UPrefetchContracts e2 -> alphaExpr' env e1 e2
_ -> structuralMismatch

alphaScenario :: AlphaEnv reason -> Scenario -> Scenario -> Mismatches reason
alphaScenario env = \case
Expand Down
3 changes: 3 additions & 0 deletions sdk/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Base.hs
Original file line number Diff line number Diff line change
Expand Up @@ -762,6 +762,9 @@ data Update
, tryCatchVar :: !ExprVarName
, tryCatchHandler :: !Expr
}
| UPrefetchContracts
{ contracts :: !Expr
}
deriving (Eq, Data, Generic, NFData, Ord, Show)

-- | Expression in the scenario monad
Expand Down
1 change: 1 addition & 0 deletions sdk/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/FreeVars.hs
Original file line number Diff line number Diff line change
Expand Up @@ -158,6 +158,7 @@ freeVarsStep = \case
UFetchByKeyF _ -> mempty
ULookupByKeyF _ -> mempty
UTryCatchF t e1 x e2 -> freeVarsInType t <> e1 <> bindExprVar x e2
UPrefetchContractsF e -> e

goScenario :: ScenarioF FreeVars -> FreeVars
goScenario = \case
Expand Down
1 change: 1 addition & 0 deletions sdk/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Pretty.hs
Original file line number Diff line number Diff line change
Expand Up @@ -422,6 +422,7 @@ instance Pretty Update where
pPrintAppKeyword lvl prec "ulookup_by_key" [tplArg tmplId]
UTryCatch t e1 x e2 -> keyword_ "try" <-> pPrintTyArg lvl t <-> pPrintTmArg lvl e1
<-> keyword_ "catch" <-> pPrintPrec lvl precParam x <-> keyword_ "." <-> pPrintTmArg lvl e2
UPrefetchContracts e -> pPrintAppKeyword lvl prec "prefetch_contracts" [TmArg e]

instance Pretty Scenario where
pPrintPrec lvl prec = \case
Expand Down
3 changes: 3 additions & 0 deletions sdk/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Recursive.hs
Original file line number Diff line number Diff line change
Expand Up @@ -86,6 +86,7 @@ data UpdateF expr
| UFetchByKeyF !(Qualified TypeConName)
| ULookupByKeyF !(Qualified TypeConName)
| UTryCatchF !Type !expr !ExprVarName !expr
| UPrefetchContractsF !expr
deriving (Foldable, Functor, Traversable)

data ScenarioF expr
Expand Down Expand Up @@ -130,6 +131,7 @@ projectUpdate = \case
ULookupByKey a -> ULookupByKeyF a
UFetchByKey a -> UFetchByKeyF a
UTryCatch a b c d -> UTryCatchF a b c d
UPrefetchContracts a -> UPrefetchContractsF a

embedUpdate :: UpdateF Expr -> Update
embedUpdate = \case
Expand All @@ -148,6 +150,7 @@ embedUpdate = \case
UFetchByKeyF a -> UFetchByKey a
ULookupByKeyF a -> ULookupByKey a
UTryCatchF a b c d -> UTryCatch a b c d
UPrefetchContractsF a -> UPrefetchContracts a

projectScenario :: Scenario -> ScenarioF Expr
projectScenario = \case
Expand Down
2 changes: 2 additions & 0 deletions sdk/compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Subst.hs
Original file line number Diff line number Diff line change
Expand Up @@ -315,6 +315,8 @@ applySubstInUpdate subst = \case
(applySubstInExpr subst e1)
x'
(applySubstInExpr subst' e2)
UPrefetchContracts e -> UPrefetchContracts
(applySubstInExpr subst e)

applySubstInScenario :: Subst -> Scenario -> Scenario
applySubstInScenario subst = \case
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -645,6 +645,8 @@ decodeUpdate LF2.Update{..} = mayDecode "updateSum" updateSum $ \case
<*> mayDecode "update_TryCatchTryExpr" update_TryCatchTryExpr decodeExpr
<*> decodeNameId ExprVarName update_TryCatchVarInternedStr
<*> mayDecode "update_TryCatchCatchExpr" update_TryCatchCatchExpr decodeExpr
LF2.UpdateSumPrefetchContracts LF2.Update_PrefetchContracts{..} ->
fmap EUpdate $ UPrefetchContracts <$> mayDecode "update_PrefetchContractsExpr" update_PrefetchContractsExpr decodeExpr

decodeRetrieveByKey :: LF2.Update_RetrieveByKey -> Decode (Qualified TypeConName)
decodeRetrieveByKey LF2.Update_RetrieveByKey{..} =
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -724,6 +724,9 @@ encodeUpdate = fmap (P.Update . Just) . \case
update_TryCatchVarInternedStr <- encodeNameId unExprVarName tryCatchVar
update_TryCatchCatchExpr <- encodeExpr tryCatchHandler
pure $ P.UpdateSumTryCatch P.Update_TryCatch{..}
UPrefetchContracts{..} -> do
update_PrefetchContractsExpr <- encodeExpr contracts
pure $ P.UpdateSumPrefetchContracts P.Update_PrefetchContracts{..}

encodeRetrieveByKey :: Qualified TypeConName -> Encode P.Update_RetrieveByKey
encodeRetrieveByKey tmplId = do
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -657,6 +657,9 @@ typeOfUpdate = \case
introExprVar var TAnyException $ do
checkExpr handler (TOptional (TUpdate typ))
pure (TUpdate typ)
UPrefetchContracts expr -> do
checkExpr expr (TList (TContractId TUnit))
pure (TUpdate TUnit)

typeOfScenario :: MonadGamma m => Scenario -> m Type
typeOfScenario = \case
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -1462,6 +1462,10 @@ message Update {
Expr catch_expr = 4;
}

message PrefetchContracts {
Expr expr = 1;
}

oneof Sum {
Pure pure = 1;
Block block = 2;
Expand All @@ -1481,6 +1485,7 @@ message Update {
DynamicExercise dynamic_exercise = 15; // *Available in versions >= 1.dev*
SoftFetch soft_fetch = 16; // *Available in versions >= 1.dev*
SoftExercise soft_exercise = 17; // *Available in versions >= 1.dev*
PrefetchContracts prefetch_contracts = 18; // *Available in versions >= 1.17*
}
}

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -1100,6 +1100,10 @@ message Update {
Expr catch_expr = 4;
}

message PrefetchContracts {
Expr expr = 1;
}

oneof Sum {
Pure pure = 1;
Block block = 2;
Expand All @@ -1115,6 +1119,7 @@ message Update {
CreateInterface create_interface = 12;
ExerciseInterface exercise_interface = 13;
FetchInterface fetch_interface = 14;
PrefetchContracts prefetch_contracts = 15; // *Available in versions >= 2.dev*

DynamicExercise dynamic_exercise = 1001; // *Available in versions >= 2.dev*
SoftFetch soft_fetch = 1002; // *Available in versions >= 2.dev*
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -1400,6 +1400,13 @@ private[archive] class DecodeV2(minor: LV.Minor) {
}
}

case PLF.Update.SumCase.PREFETCH_CONTRACTS =>
assertSince(LV.Features.prefetch, "Update.prefetch_contracts")
val prefetch = lfUpdate.getPrefetchContracts
decodeExpr(prefetch.getExpr, definition) { contracts =>
Ret(UpdatePrefetchContracts(contracts))
}

case PLF.Update.SumCase.SUM_NOT_SET =>
throw Error.Parsing("Update.SUM_NOT_SET")
}
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -759,6 +759,9 @@ private[lf] final class PhaseOne(
}
}
}
case UpdatePrefetchContracts(_) =>
// TODO: Implement prefetching
???
}

@tailrec
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -608,6 +608,7 @@ object Ast {
binder: ExprVarName,
handler: Expr,
) extends Update
final case class UpdatePrefetchContracts(contracts: Expr) extends Update

//
// Scenario expressions
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -106,6 +106,8 @@ object LanguageVersion {
val scenarios = v2_dev
val contractKeys = v2_dev

val prefetch = v2_dev

/** Unstable, experimental features. This should stay in x.dev forever.
* Features implemented with this flag should be moved to a separate
* feature flag once the decision to add them permanently has been made.
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -127,6 +127,8 @@ private[lf] object ExprIterable {
Iterator(body)
case UpdateTryCatch(typ @ _, body, binder @ _, handler) =>
Iterator(body, handler)
case UpdatePrefetchContracts(contracts) =>
Iterator(contracts)
}
}

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -162,7 +162,9 @@ private[lf] object TypeIterable {
case UpdateEmbedExpr(typ, body) =>
Iterator(typ) ++
iterator(body)
case UpdateGetTime | UpdateFetchByKey(_) | UpdateLookupByKey(_) =>
case UpdateGetTime | UpdateFetchByKey(_) | UpdateLookupByKey(_) | UpdatePrefetchContracts(
_
) =>
ExprIterable.iterator(update).flatMap(iterator(_))
case UpdateTryCatch(typ, body, binder @ _, handler) =>
Iterator(typ) ++
Expand Down
6 changes: 6 additions & 0 deletions sdk/daml-lf/spec/daml-lf-2.rst
Original file line number Diff line number Diff line change
Expand Up @@ -734,6 +734,7 @@ Then we can define our kinds, types, and expressions::
| 'lookup_by_key' @τ e -- UpdateLookUpByKey
| 'embed_expr' @τ e -- UpdateEmbedExpr
| 'try' @τ e₁ 'catch' x. e₂ -- UpdateTryCatch [Daml-LF ≥ 1.14]
| 'prefetch_contracts' e -- UpdatePrefetchContracts

Scenario
s ::= 'spure' @τ e -- ScenarioPure
Expand Down Expand Up @@ -2062,6 +2063,7 @@ need to be evaluated further. ::
| 'lookup_by_key' @Mod:T v -- ValUpdateLookupByKey
| 'embed_expr' @τ e -- ValUpdateEmbedExpr
| 'try' @τ e₁ 'catch' x. e₂ -- ValUpdateTryCatch
| 'prefetch_contracts' v -- ValPrefetchContracts

┌────┐
Scenario Values │ sv │
Expand Down Expand Up @@ -2378,6 +2380,7 @@ grammar below. ::
| 'exercise_interface' @Mod:I Ch v₁ v₂ E₃
| 'fetch_by_key' @τ E
| 'lookup_by_key' @τ E
| 'prefetch_contracts' E

Scenario Evaluation Context
SE ::= 'spure' @τ E
Expand Down Expand Up @@ -3625,6 +3628,9 @@ as described by the ledger model::
⇓ᵤ
(Err err, ('rollback' tr₁))

—————————————————————————————————————————————————————————————————————— EvUpdPrefetchContracts
'prefetch_contracts' v ‖ (st, keys) ⇓ᵤ (Ok (), ε) ‖ (st, keys)


Transaction normalization
~~~~~~~~~~~~~~~~~~~~~~~~~
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -1389,6 +1389,10 @@ private[validation] object Typing {
Ret(updTyp)
}
}
case UpdatePrefetchContracts(contracts) =>
checkExpr(contracts, TList(TContractId(TUnit))) {
Ret(TUpdate(TUnit))
}
}

private def typeOfCommit(typ: Type, party: Expr, update: Expr): Work[Type] = {
Expand Down
Loading