From 431a6b824f6d291201960105aca5ddc2bc6ddf08 Mon Sep 17 00:00:00 2001 From: Craig Disselkoen Date: Tue, 30 Jul 2024 19:30:56 +0000 Subject: [PATCH 1/8] main PE soundness theorems Signed-off-by: Craig Disselkoen --- cedar-lean/Cedar/Partial/Authorizer.lean | 18 +- cedar-lean/Cedar/Partial/Evaluator.lean | 214 +++--- cedar-lean/Cedar/Partial/Response.lean | 19 +- cedar-lean/Cedar/Thm/Data/Control.lean | 29 + cedar-lean/Cedar/Thm/Data/List/Lemmas.lean | 6 +- cedar-lean/Cedar/Thm/Data/Map.lean | 56 ++ cedar-lean/Cedar/Thm/Partial.lean | 1 + .../Cedar/Thm/Partial/Authorization.lean | 81 +- .../Authorization/PartialOnConcrete.lean | 13 +- .../Cedar/Thm/Partial/EvaluatePolicy.lean | 128 ++++ cedar-lean/Cedar/Thm/Partial/Evaluation.lean | 2 + .../Thm/Partial/Evaluation/Evaluate.lean | 206 +++++- .../Partial/Evaluation/Evaluate/AndOr.lean | 28 +- .../Partial/Evaluation/Evaluate/Binary.lean | 2 +- .../Thm/Partial/Evaluation/Evaluate/Call.lean | 2 +- .../Partial/Evaluation/Evaluate/GetAttr.lean | 41 +- .../Partial/Evaluation/Evaluate/HasAttr.lean | 13 +- .../Thm/Partial/Evaluation/Evaluate/Ite.lean | 12 +- .../Partial/Evaluation/Evaluate/Lemmas.lean | 80 ++ .../Partial/Evaluation/Evaluate/Record.lean | 13 +- .../Thm/Partial/Evaluation/Evaluate/Set.lean | 8 + .../Partial/Evaluation/Evaluate/Unary.lean | 16 +- .../Thm/Partial/Evaluation/Evaluate/Var.lean | 198 ++--- .../Partial/Evaluation/EvaluateBinaryApp.lean | 10 +- .../Thm/Partial/Evaluation/EvaluateCall.lean | 7 +- .../Partial/Evaluation/EvaluateGetAttr.lean | 308 +++----- .../Partial/Evaluation/EvaluateHasAttr.lean | 69 +- .../Evaluation/EvaluatePartialGetAttr.lean | 307 ++++++++ .../Partial/Evaluation/EvaluateUnaryApp.lean | 56 +- .../Thm/Partial/Evaluation/EvaluateValue.lean | 690 ++++++++++++++++++ .../Cedar/Thm/Partial/Evaluation/Props.lean | 15 + .../Partial/Evaluation/ReevaluateGetAttr.lean | 89 +++ .../Evaluation/ReevaluatePartialGetAttr.lean | 181 +++++ .../Evaluation/ReevaluateUnaryApp.lean | 73 ++ .../Partial/Evaluation/ReevaluateValue.lean | 687 +++++++++++++++++ .../Thm/Partial/Evaluation/Reevaluation.lean | 108 +++ .../Evaluation/Reevaluation/AndOr.lean | 163 +++++ .../Evaluation/Reevaluation/Binary.lean | 113 +++ .../Partial/Evaluation/Reevaluation/Call.lean | 167 +++++ .../Evaluation/Reevaluation/GetAttr.lean | 107 +++ .../Evaluation/Reevaluation/HasAttr.lean | 99 +++ .../Partial/Evaluation/Reevaluation/Ite.lean | 168 +++++ .../Evaluation/Reevaluation/Record.lean | 479 ++++++++++++ .../Partial/Evaluation/Reevaluation/Set.lean | 345 +++++++++ .../Evaluation/Reevaluation/Unary.lean | 81 ++ .../Partial/Evaluation/Reevaluation/Var.lean | 323 ++++++++ cedar-lean/Cedar/Thm/Partial/Subst.lean | 242 +++++- cedar-lean/Cedar/Thm/Partial/WellFormed.lean | 37 +- 48 files changed, 5616 insertions(+), 494 deletions(-) create mode 100644 cedar-lean/Cedar/Thm/Partial/EvaluatePolicy.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Lemmas.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluatePartialGetAttr.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateValue.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateGetAttr.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluatePartialGetAttr.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateUnaryApp.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/AndOr.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Binary.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Call.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/GetAttr.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/HasAttr.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Ite.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Record.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Set.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Unary.lean create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Var.lean diff --git a/cedar-lean/Cedar/Partial/Authorizer.lean b/cedar-lean/Cedar/Partial/Authorizer.lean index b6adbbab0..7f6dbb9c1 100644 --- a/cedar-lean/Cedar/Partial/Authorizer.lean +++ b/cedar-lean/Cedar/Partial/Authorizer.lean @@ -23,6 +23,7 @@ import Cedar.Partial.Value namespace Cedar.Partial open Cedar.Data +open Cedar.Partial (Residual) open Cedar.Spec (Policy Policies) def knownSatisfied (policy : Policy) (req : Partial.Request) (entities : Partial.Entities) : Bool := @@ -36,12 +37,21 @@ def knownErroring (policy : Policy) (req : Partial.Request) (entities : Partial. | .ok _ => false | .error _ => true +/-- + Not to be confused with `Partial.evaluate`, which evaluates a `Spec.Expr` + and returns a `Partial.Value`, this function `Partial.evaluatePolicy` + evaluates a `Policy` and returns a `Residual`, or `none` if the policy is + definitely not satisfied (residual `false`). +-/ +def evaluatePolicy (policy : Policy) (req : Partial.Request) (entities : Partial.Entities) : Option Residual := + match Partial.evaluate policy.toExpr req entities with + | .ok (.value false) => none + | .ok pv => some (.residual policy.id policy.effect pv) + | .error _ => some (.error policy.id) + def isAuthorized (req : Partial.Request) (entities : Partial.Entities) (policies : Policies) : Partial.Response := { - residuals := policies.filterMap λ policy => match Partial.evaluate policy.toExpr req entities with - | .ok (.value (.prim (.bool false))) => none - | .ok pv => some (.residual policy.id policy.effect pv) - | .error e => some (.error policy.id e) + residuals := policies.filterMap (evaluatePolicy · req entities), entities, } diff --git a/cedar-lean/Cedar/Partial/Evaluator.lean b/cedar-lean/Cedar/Partial/Evaluator.lean index ded856429..1c8320b83 100644 --- a/cedar-lean/Cedar/Partial/Evaluator.lean +++ b/cedar-lean/Cedar/Partial/Evaluator.lean @@ -38,7 +38,7 @@ def evaluateUnaryApp (op₁ : UnaryOp) : Partial.Value → Result Partial.Value | .value v₁ => do let val ← Spec.apply₁ op₁ v₁ .ok (.value val) - | pv => .ok (.residual (.unaryApp op₁ pv)) + | .residual r₁ => .ok (.residual (.unaryApp op₁ (.residual r₁))) /-- Analogous to Spec.inₑ but for partial entities -/ def inₑ (uid₁ uid₂ : EntityUID) (es : Partial.Entities) : Bool := @@ -97,38 +97,18 @@ def evaluateHasAttr (pv : Partial.Value) (a : Attr) (es : Partial.Entities) : Re | .value v₁ => do let val ← Partial.hasAttr v₁ a es .ok (.value val) - | .residual r => .ok (.residual (.hasAttr (.residual r) a)) -- could be more precise; see cedar-spec#395 + | .residual r₁ => .ok (.residual (.hasAttr (.residual r₁) a)) -- could be more precise; see cedar-spec#395 /-- Analogous to Spec.getAttr but for partial entities -/ def getAttr (v : Spec.Value) (a : Attr) (es : Partial.Entities) : Result Partial.Value := do let r ← Partial.attrsOf v es.attrs r.findOrErr a attrDoesNotExist -/-- - Partial-evaluate `pv[a]`. No analogue in Spec.Evaluator; this logic (that sits - between `Partial.evaluate` and `Partial.getAttr`) is not needed in the equivalent - Spec.Evaluator position --/ -def evaluateGetAttr (pv : Partial.Value) (a : Attr) (es : Partial.Entities) : Result Partial.Value := do - match pv with - | .value v₁ => Partial.getAttr v₁ a es - | .residual r => .ok (.residual (.getAttr (.residual r) a)) -- could be more precise; see cedar-spec#395 - /-- Analogous to Spec.bindAttr but for partial values -/ def bindAttr (a : Attr) (res : Result Partial.Value) : Result (Attr × Partial.Value) := do let v ← res .ok (a, v) -/-- Partial-evaluate a Var. No analogue in Spec.Evaluator; Spec.evaluate handles the `.var` case inline -/ -def evaluateVar (v : Var) (req : Partial.Request) : Result Partial.Value := - match v with - | .principal => .ok req.principal - | .action => .ok req.action - | .resource => .ok req.resource - | .context => match req.context.mapMOnValues λ v => match v with | .value v => some v | .residual _ => none with - | some m => .ok (.value m) - | none => .ok (.residual (.record req.context.kvs)) - /-- Call an extension function with partial values as arguments -/ def evaluateCall (xfn : ExtFun) (args : List Partial.Value) : Result Partial.Value := match args.mapM (λ pval => match pval with | .value v => some v | .residual _ => none) with @@ -137,73 +117,40 @@ def evaluateCall (xfn : ExtFun) (args : List Partial.Value) : Result Partial.Val .ok (.value val) | none => .ok (.residual (.call xfn args)) -/-- Analogous to Spec.evaluate but performs partial evaluation given partial request/entities -/ -def evaluate (x : Expr) (req : Partial.Request) (es : Partial.Entities) : Result Partial.Value := - match x with - | .lit l => .ok (.value l) - | .var v => evaluateVar v req - | .ite x₁ x₂ x₃ => do - let pval ← Partial.evaluate x₁ req es - match pval with - | .value v => do - let b ← v.asBool - if b then Partial.evaluate x₂ req es else Partial.evaluate x₃ req es - | .residual r => .ok (.residual (.ite (.residual r) (x₂.substToPartialValue req) (x₃.substToPartialValue req))) - | .and x₁ x₂ => do - let pval ← Partial.evaluate x₁ req es - match pval with - | .value v => do - let b ← v.asBool - if !b then .ok (.value b) else do - let pval ← Partial.evaluate x₂ req es - match pval with - | .value v => do - let b ← v.asBool - .ok (.value b) - | .residual r => .ok (.residual r) - | .residual r => .ok (.residual (.and (.residual r) (x₂.substToPartialValue req))) - | .or x₁ x₂ => do - let pval ← Partial.evaluate x₁ req es - match pval with - | .value v => do - let b ← v.asBool - if b then .ok (.value b) else do - let pval ← Partial.evaluate x₂ req es - match pval with - | .value v => do - let b ← v.asBool - .ok (.value b) - | .residual r => .ok (.residual r) - | .residual r => .ok (.residual (.or (.residual r) (x₂.substToPartialValue req))) - | .unaryApp op₁ x₁ => do - let pval ← Partial.evaluate x₁ req es - evaluateUnaryApp op₁ pval - | .binaryApp op₂ x₁ x₂ => do - let pval₁ ← Partial.evaluate x₁ req es - let pval₂ ← Partial.evaluate x₂ req es - evaluateBinaryApp op₂ pval₁ pval₂ es - | .hasAttr x₁ a => do - let pval₁ ← Partial.evaluate x₁ req es - evaluateHasAttr pval₁ a es - | .getAttr x₁ a => do - let pval₁ ← Partial.evaluate x₁ req es - evaluateGetAttr pval₁ a es - | .set xs => do - let pvs ← xs.mapM₁ (λ ⟨x₁, _⟩ => Partial.evaluate x₁ req es) - match pvs.mapM (λ pval => match pval with | .value v => some v | .residual _ => none) with - | some vs => .ok (.value (Set.make vs)) - | none => .ok (.residual (.set pvs)) - | .record axs => do - let apvs ← axs.mapM₂ (λ ⟨(a₁, x₁), _⟩ => Partial.bindAttr a₁ (Partial.evaluate x₁ req es)) - match apvs.mapM (λ (a, pval) => match pval with | .value v => some (a, v) | .residual _ => none) with - | some avs => .ok (.value (Map.make avs)) - | none => .ok (.residual (.record apvs)) - | .call xfn xs => do - let pvs ← xs.mapM₁ (λ ⟨x₁, _⟩ => Partial.evaluate x₁ req es) - evaluateCall xfn pvs - mutual +/-- + Partial-evaluate `pv[a]`. No analogue in Spec.Evaluator; this logic (that sits + between `Partial.evaluate` and `Partial.getAttr`) is not needed in the equivalent + Spec.Evaluator position +-/ +def evaluateGetAttr (pv : Partial.Value) (a : Attr) (es : Partial.Entities) : Result Partial.Value := do + match pv with + | .value v₁ => do + let attr ← Partial.getAttr v₁ a es + -- any attribute value we get from `es` could be a nontrivial residual in + -- need of further evaluation (e.g., because a substitution was recently + -- performed). Thus we call `evaluateValue` on the attribute value. + evaluateValue attr es + | .residual r₁ => .ok (.residual (.getAttr (.residual r₁) a)) -- could be more precise; see cedar-spec#395 +termination_by 0 +decreasing_by sorry + +/-- Partial-evaluate a Var. No analogue in Spec.Evaluator; Spec.evaluate handles the `.var` case inline -/ +def evaluateVar (v : Var) (req : Partial.Request) (es : Partial.Entities) : Result Partial.Value := + match v with + | .principal => .ok req.principal + | .action => .ok req.action + | .resource => .ok req.resource + | .context => do + -- any value we get from `req.context` could be a nontrivial residual in + -- need of further evaluation (e.g., because a substitution was recently + -- performed). Thus we call `evaluateValue` on each context value. + let evaluated ← req.context.mapMOnValues (evaluateValue · es) + match evaluated.mapMOnValues λ v => match v with | .value v => some v | .residual _ => none with + | some m => .ok (.value m) + | none => .ok (.residual (.record evaluated.kvs)) + /-- Evaluate a `Partial.Value`, possibly reducing it. For instance, `3 + 5` will evaluate to `8`. This can be relevant if a substitution was recently made on @@ -213,6 +160,8 @@ def evaluateValue (pv : Partial.Value) (es : Partial.Entities) : Result Partial. match pv with | .value v => .ok (.value v) | .residual r => evaluateResidual r es +termination_by 0 +decreasing_by sorry /-- Evaluate a `ResidualExpr`, possibly reducing it. For instance, `3 + 5` will @@ -240,7 +189,12 @@ def evaluateResidual (x : Partial.ResidualExpr) (es : Partial.Entities) : Result | .value v₂' => do let b ← v₂'.asBool .ok (.value b) - | .residual r₂' => .ok (.residual r₂') + | .residual r₂' => + -- you might think we could just return `pv₂'`, but this fails + -- soundness. Consider the case where `pv₂'` is a single unknown, and + -- that we substitute it with `37`. We need the + -- substitute-and-reevaluate operation to return type-error, not 37. + .ok (.residual (.and (.value true) (.residual r₂'))) | .residual r₁' => .ok (.residual (.and (.residual r₁') pv₂)) | .or pv₁ pv₂ => do let pv₁' ← Partial.evaluateValue pv₁ es @@ -253,7 +207,12 @@ def evaluateResidual (x : Partial.ResidualExpr) (es : Partial.Entities) : Result | .value v₂' => do let b ← v₂'.asBool .ok (.value b) - | .residual r₂' => .ok (.residual r₂') + | .residual r₂' => + -- you might think we could just return `pv₂'`, but this fails + -- soundness. Consider the case where `pv₂'` is a single unknown, and + -- that we substitute it with `37`. We need the + -- substitute-and-reevaluate operation to return type-error, not 37. + .ok (.residual (.or (.value false) (.residual r₂'))) | .residual r₁' => .ok (.residual (.or (.residual r₁') pv₂)) | .unaryApp op₁ pv₁ => do let pv₁' ← Partial.evaluateValue pv₁ es @@ -281,7 +240,84 @@ def evaluateResidual (x : Partial.ResidualExpr) (es : Partial.Entities) : Result | .call xfn pvs => do let pvs' ← pvs.mapM₁ (λ ⟨pv, _⟩ => Partial.evaluateValue pv es) evaluateCall xfn pvs' +termination_by 0 +decreasing_by all_goals sorry end +/-- Analogous to Spec.evaluate but performs partial evaluation given partial request/entities -/ +def evaluate (x : Expr) (req : Partial.Request) (es : Partial.Entities) : Result Partial.Value := + match x with + | .lit l => .ok (.value l) + | .var v => evaluateVar v req es + | .ite x₁ x₂ x₃ => do + let pval ← Partial.evaluate x₁ req es + match pval with + | .value v => do + let b ← v.asBool + if b then Partial.evaluate x₂ req es else Partial.evaluate x₃ req es + | .residual r => .ok (.residual (.ite (.residual r) (x₂.substToPartialValue req) (x₃.substToPartialValue req))) + | .and x₁ x₂ => do + let pval ← Partial.evaluate x₁ req es + match pval with + | .value v => do + let b ← v.asBool + if !b then .ok (.value b) else do + let pval ← Partial.evaluate x₂ req es + match pval with + | .value v => do + let b ← v.asBool + .ok (.value b) + | .residual r => + -- you might think we could just return `pval`, but this fails + -- soundness. Consider the case where `pval` is a single unknown, and + -- that we substitute it with `37`. We need the + -- substitute-and-reevaluate operation to return type-error, not 37. + .ok (.residual (.and (.value true) (.residual r))) + | .residual r => .ok (.residual (.and (.residual r) (x₂.substToPartialValue req))) + | .or x₁ x₂ => do + let pval ← Partial.evaluate x₁ req es + match pval with + | .value v => do + let b ← v.asBool + if b then .ok (.value b) else do + let pval ← Partial.evaluate x₂ req es + match pval with + | .value v => do + let b ← v.asBool + .ok (.value b) + | .residual r => + -- you might think we could just return `pval`, but this fails + -- soundness. Consider the case where `pval` is a single unknown, and + -- that we substitute it with `37`. We need the + -- substitute-and-reevaluate operation to return type-error, not 37. + .ok (.residual (.or (.value false) (.residual r))) + | .residual r => .ok (.residual (.or (.residual r) (x₂.substToPartialValue req))) + | .unaryApp op₁ x₁ => do + let pval ← Partial.evaluate x₁ req es + evaluateUnaryApp op₁ pval + | .binaryApp op₂ x₁ x₂ => do + let pval₁ ← Partial.evaluate x₁ req es + let pval₂ ← Partial.evaluate x₂ req es + evaluateBinaryApp op₂ pval₁ pval₂ es + | .hasAttr x₁ a => do + let pval₁ ← Partial.evaluate x₁ req es + evaluateHasAttr pval₁ a es + | .getAttr x₁ a => do + let pval₁ ← Partial.evaluate x₁ req es + evaluateGetAttr pval₁ a es + | .set xs => do + let pvs ← xs.mapM₁ (λ ⟨x₁, _⟩ => Partial.evaluate x₁ req es) + match pvs.mapM (λ pval => match pval with | .value v => some v | .residual _ => none) with + | some vs => .ok (.value (Set.make vs)) + | none => .ok (.residual (.set pvs)) + | .record axs => do + let apvs ← axs.mapM₂ (λ ⟨(a₁, x₁), _⟩ => Partial.bindAttr a₁ (Partial.evaluate x₁ req es)) + match apvs.mapM (λ (a, pval) => match pval with | .value v => some (a, v) | .residual _ => none) with + | some avs => .ok (.value (Map.make avs)) + | none => .ok (.residual (.record apvs)) + | .call xfn xs => do + let pvs ← xs.mapM₁ (λ ⟨x₁, _⟩ => Partial.evaluate x₁ req es) + evaluateCall xfn pvs + end Cedar.Partial diff --git a/cedar-lean/Cedar/Partial/Response.lean b/cedar-lean/Cedar/Partial/Response.lean index babb186d1..e5f0a4472 100644 --- a/cedar-lean/Cedar/Partial/Response.lean +++ b/cedar-lean/Cedar/Partial/Response.lean @@ -37,18 +37,22 @@ inductive Residual where constant `false` (definitely not satisfied), or a nontrivial expression -/ | residual (id : PolicyID) (effect : Effect) (condition : Partial.Value) - /-- definitely results in this error, for any substitution of the unknowns -/ - | error (id : PolicyID) (error : Error) + /-- + definitely results in an error, for any substitution of the unknowns. + We don't say which error, in order to produce the desired equivalence + semantics on `Residual` + -/ + | error (id : PolicyID) deriving instance Repr, DecidableEq, Inhabited for Residual def Residual.id : Residual → PolicyID | .residual id _ _ => id - | .error id _ => id + | .error id => id def Residual.effect : Residual → Option Effect | .residual _ effect _ => effect - | .error _ _ => none + | .error _ => none /-- if this policy must be satisfied (for any substitution of the unknowns), and @@ -126,7 +130,7 @@ def Response.forbids (resp : Partial.Response) : Set PolicyID := -/ def Response.errorPolicies (resp : Partial.Response) : Set PolicyID := Set.make (resp.residuals.filterMap λ residual => match residual with - | .error id _ => some id + | .error id => some id | _ => none ) @@ -217,13 +221,12 @@ def Response.underapproximateDeterminingPolicies (resp : Partial.Response) : Set Assumes that `entities` have already been substituted. -/ def Residual.reEvaluateWithSubst (subsmap : Subsmap) (entities : Partial.Entities) : Residual → Option Residual - | .error id e => some (.error id e) + | .error id => some (.error id) | .residual id effect cond => match Partial.evaluateValue (cond.subst subsmap) entities with | .ok (.value false) => none - | .ok (.value v) => some (.residual id effect v) | .ok cond' => some (.residual id effect cond') - | .error e => some (.error id e) + | .error _ => some (.error id) /-- Re-evaluate with the given substitution for unknowns, giving a new diff --git a/cedar-lean/Cedar/Thm/Data/Control.lean b/cedar-lean/Cedar/Thm/Data/Control.lean index 89eea6410..66e218bde 100644 --- a/cedar-lean/Cedar/Thm/Data/Control.lean +++ b/cedar-lean/Cedar/Thm/Data/Control.lean @@ -56,3 +56,32 @@ theorem do_ok {res : Except ε α} {f : α → β} : (do let v ← res ; .ok (f v)) = .ok b ↔ ∃ a, res = .ok a ∧ f a = b := by cases res <;> simp + +/-- + `apply do_eq_do` eliminates the first operation of a `do` block if the first + operations are definitionally equal, and your goal is to prove the entire `do` + blocks equal +-/ +theorem do_eq_do [Monad m] [LawfulMonad m] {res : m α} {f g : α → m β} : + (∀ v, f v = g v) → (do let v ← res ; f v) = (do let v ← res ; g v) +:= by + intro h₁ ; simp [h₁] + +/-- + Specialization of `do_eq_do` to the `Except` monad, accepts a somewhat weaker + hypothesis, namely that `f` and `g` only need to agree when `res` is `.ok` +-/ +theorem do_eq_do_except {res : Except ε α} {f g : α → Except ε β} : + (∀ v, res = .ok v → f v = g v) → (do let v ← res ; f v) = (do let v ← res ; g v) +:= by + intro h₁ ; cases res <;> simp [h₁] + +/-- + `apply do_eq_do'` eliminates the last operation of a `do` block if the last + operations are definitionally equal, and your goal is to prove the entire `do` + blocks equal +-/ +theorem do_eq_do' [Monad m] [LawfulMonad m] {res res' : m α} {f : α → m β} : + res = res' → (do let v ← res ; f v) = (do let v ← res' ; f v) +:= by + intro _ ; subst res' ; rfl diff --git a/cedar-lean/Cedar/Thm/Data/List/Lemmas.lean b/cedar-lean/Cedar/Thm/Data/List/Lemmas.lean index edbaca0c3..7101fe38b 100644 --- a/cedar-lean/Cedar/Thm/Data/List/Lemmas.lean +++ b/cedar-lean/Cedar/Thm/Data/List/Lemmas.lean @@ -598,13 +598,13 @@ theorem mapM'_ok_eq_filterMap {α β} {f : α → Except ε β} {xs : List α} { case cons hd tl ih => simp only [filterMap_cons] simp only [mapM'_cons, pure, Except.pure] at h - cases h₂ : f hd <;> simp only [h₂, Except.bind_ok, Except.bind_err] at h + cases hhd : f hd <;> simp only [hhd, Except.bind_ok, Except.bind_err] at h case ok hd' => simp only - cases h₃ : tl.mapM' f <;> simp only [h₃, Except.bind_ok, Except.bind_err, Except.ok.injEq] at h + cases htl : tl.mapM' f <;> simp only [htl, Except.bind_ok, Except.bind_err, Except.ok.injEq] at h case ok tl' => subst ys - simp only [ih h₃] + simp only [ih htl] theorem mapM_ok_eq_filterMap {α β} {f : α → Except ε β} {xs : List α} {ys : List β} : xs.mapM f = .ok ys → diff --git a/cedar-lean/Cedar/Thm/Data/Map.lean b/cedar-lean/Cedar/Thm/Data/Map.lean index 8307b8af6..7c60f0077 100644 --- a/cedar-lean/Cedar/Thm/Data/Map.lean +++ b/cedar-lean/Cedar/Thm/Data/Map.lean @@ -139,6 +139,10 @@ theorem mk_kvs_id (m : Map α β) : mk m.kvs = m := by simp only [kvs] +theorem kvs_mk_id (xs : List (α × β)) : + (Map.mk xs).kvs = xs +:= by simp only [kvs] + theorem in_list_in_map {α : Type u} (k : α) (v : β) (m : Map α β) : (k, v) ∈ m.kvs → k ∈ m := by @@ -376,6 +380,11 @@ theorem mapOnValues_empty {α β γ} [LT α] [DecidableLT α] [DecidableEq α] { := by simp [mapOnValues, empty] +theorem mapOnValues_id [LT α] [DecidableLT α] {m : Map α β} : + m.mapOnValues id = m +:= by + simp [mapOnValues] + theorem find?_mapOnValues {α β γ} [LT α] [DecidableLT α] [DecidableEq α] (f : β → γ) (m : Map α β) (k : α) : (m.find? k).map f = (m.mapOnValues f).find? k := by @@ -722,6 +731,27 @@ theorem mapMOnValues_cons {α : Type 0} [LT α] [DecidableLT α] {f : β → Opt subst mtl' simp [h₃] +theorem mapMOnValues_pure [LT α] [DecidableLT α] [Monad m] [LawfulMonad m] {f : β → γ} {m₁ : Map α β} : + m₁.mapMOnValues ((λ b => pure (f b)) : β → m γ) = pure (m₁.mapOnValues f) +:= by + simp [mapMOnValues, List.mapM_pure, mapOnValues] + +/-- Corollary: it's true for `m` = `Except` -/ +theorem mapMOnValues_ok [LT α] [DecidableLT α] {f : β → γ} {m₁ : Map α β} : + m₁.mapMOnValues ((λ b => Except.ok (f b)) : β → Except ε γ) = Except.ok (m₁.mapOnValues f) +:= mapMOnValues_pure + +/-- Corollary: it's true for `m` = `Option` -/ +theorem mapMOnValues_some [LT α] [DecidableLT α] {f : β → γ} {m₁ : Map α β} : + m₁.mapMOnValues (λ b => some (f b)) = some (m₁.mapOnValues f) +:= mapMOnValues_pure + +theorem mapMOnValues_mapOnValues [LT α] [DecidableLT α] [Monad m] [LawfulMonad m] {f : β → γ} {g : γ → m ε} {m₁ : Map α β} : + (m₁.mapOnValues f).mapMOnValues g = m₁.mapMOnValues λ v => g (f v) +:= by + simp only [mapMOnValues, mapOnValues] + rw [List.mapM_map] + theorem mapMOnValues_some_implies_forall₂ [LT α] [DecidableLT α] {f : β → Option γ} {m₁ : Map α β} {m₂ : Map α γ} : m₁.mapMOnValues f = some m₂ → List.Forall₂ (λ kv₁ kv₂ => kv₁.fst = kv₂.fst ∧ f kv₁.snd = some kv₂.snd) m₁.kvs m₂.kvs @@ -923,6 +953,13 @@ theorem all_ok_implies_mapMOnValues_ok [LT α] [DecidableLT α] {f : β → Exce replace ⟨v', h₁⟩ := h₁ (k, v) hkv simp only [h₁, Except.bind_ok] at h₂ +/-- + The converse is not true: + counterexample `m` is `[("foo", 1), ("bar", 2)]` and `f` is `Except.error`. + In that case, `f 2 = .error 2` but `m.mapMOnValues f = .error 1`. + + But for a limited converse, see `element_error_implies_mapMOnValues_error` +-/ theorem mapMOnValues_error_implies_exists_error [LT α] [DecidableLT α] {f : β → Except ε γ} {m : Map α β} {e : ε} : m.mapMOnValues f = .error e → ∃ v ∈ m.values, f v = .error e := by @@ -934,4 +971,23 @@ theorem mapMOnValues_error_implies_exists_error [LT α] [DecidableLT α] {f : β have h_values := in_list_in_values hkv exists v +/-- + If applying `f` to any of `m.values` produces an error, then `m.mapMOnValues f` + must also produce an error (not necessarily the same error) + + Limited converse of `mapMOnValues_error_implies_exists_error` +-/ +theorem element_error_implies_mapMOnValues_error [LT α] [DecidableLT α] {v : β} {f : β → Except ε γ} {m : Map α β} {e : ε} : + v ∈ m.values → + f v = .error e → + ∃ e', m.mapMOnValues f = .error e' +:= by + intro h₁ h₂ + cases h₃ : m.mapMOnValues f <;> simp + case ok pvals => + replace ⟨k, h₁⟩ := in_values_exists_key h₁ + replace ⟨pval, _, h₃⟩ := mapMOnValues_ok_implies_all_ok h₃ (k, v) h₁ + simp [h₂] at h₃ + + end Cedar.Data.Map diff --git a/cedar-lean/Cedar/Thm/Partial.lean b/cedar-lean/Cedar/Thm/Partial.lean index a30935bee..e89eda9f0 100644 --- a/cedar-lean/Cedar/Thm/Partial.lean +++ b/cedar-lean/Cedar/Thm/Partial.lean @@ -15,5 +15,6 @@ -/ import Cedar.Thm.Partial.Authorization +import Cedar.Thm.Partial.EvaluatePolicy import Cedar.Thm.Partial.Evaluation import Cedar.Thm.Partial.Subst diff --git a/cedar-lean/Cedar/Thm/Partial/Authorization.lean b/cedar-lean/Cedar/Thm/Partial/Authorization.lean index 91986684d..d08a288ab 100644 --- a/cedar-lean/Cedar/Thm/Partial/Authorization.lean +++ b/cedar-lean/Cedar/Thm/Partial/Authorization.lean @@ -16,9 +16,17 @@ import Cedar.Partial.Authorizer import Cedar.Partial.Response +import Cedar.Partial.Value import Cedar.Spec.Authorizer import Cedar.Spec.Response +import Cedar.Spec.Value import Cedar.Thm.Authorization.Authorizer +import Cedar.Thm.Data.Control +import Cedar.Thm.Data.List +import Cedar.Thm.Data.Map +import Cedar.Thm.Data.Set +import Cedar.Thm.Partial.EvaluatePolicy +import Cedar.Thm.Partial.Evaluation import Cedar.Thm.Partial.Authorization.PartialOnConcrete import Cedar.Thm.Partial.Authorization.PartialResponse @@ -27,7 +35,78 @@ import Cedar.Thm.Partial.Authorization.PartialResponse namespace Cedar.Thm.Partial.Authorization open Cedar.Data -open Cedar.Spec (Policies PolicyID) +open Cedar.Partial (Residual Subsmap Unknown) +open Cedar.Spec (Policies Policy PolicyID) + +/-- + Re-evaluating a residual with any substitution for the unknowns, gives the + same result as first performing the substitution and then evaluating the + original policy. +-/ +theorem Residual.reeval_eqv_substituting_first {policy : Policy} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + req.subst subsmap = some req' → + Partial.evaluatePolicy policy req entities = some residual → + residual.reEvaluateWithSubst subsmap (entities.subst subsmap) = Partial.evaluatePolicy policy req' (entities.subst subsmap) +:= by + unfold Residual.reEvaluateWithSubst + intro h_req h₁ + split + · exact (EvaluatePolicy.subst_preserves_err wf_r wf_e wf_s h_req h₁).symm + · rename_i pid eff cond + unfold Partial.evaluatePolicy at * + split at h₁ <;> simp at h₁ + replace ⟨h₁, h₁', h₁''⟩ := h₁ ; subst pid eff cond ; rename_i pv h₂ h₁ + cases pv <;> simp only [Partial.Value.value.injEq, imp_false, imp_self] at h₂ + case value v => + rw [Subst.subst_concrete_value, Partial.Evaluation.EvaluateValue.eval_spec_value v] + rw [Partial.Evaluation.Evaluate.subst_preserves_evaluation_to_value wf_r wf_e wf_s h_req h₁] + rfl + case residual r => + have h₂ := Partial.Evaluation.Reevaluation.reeval_eqv_substituting_first policy.toExpr req' subsmap wf_r wf_e wf_s h_req + simp only at h₂ + split at h₂ <;> rename_i h₂' + <;> simp at h₂' <;> replace ⟨h₂', h₂''⟩ := h₂' + · -- the case where h₂' says they're both errors + rename_i e e' + simp only [h₁, Except.bind_ok] at h₂' + simp only [h₂', h₂''] + · rename_i hₑ -- the case where hₑ says they're not both errors + subst h₂' h₂'' + simp only [h₁, Except.bind_ok] at h₂ + simp only [h₂] + rfl + +/-- + Main PE soundness theorem (for authorization): + + Partial-authorizing with any partial inputs, then performing any (valid) + substitution for the unknowns and authorizing using the residuals, gives the + same result as first performing the substitution and then authorizing using + the original policies. + + Also implied by this: if a substitution is valid for the Partial.Request, then + it is valid for `reEvaluateWithSubst` +-/ +theorem authz_on_residuals_eqv_substituting_first {policies : Policies} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + req.subst subsmap = some req' → + (Partial.isAuthorized req entities policies).reEvaluateWithSubst subsmap = some (Partial.isAuthorized req' (entities.subst subsmap) policies) +:= by + intro h_req + unfold Partial.Response.reEvaluateWithSubst Partial.isAuthorized + simp only [Option.bind_eq_bind, Option.bind_eq_some, Option.some.injEq, Partial.Response.mk.injEq, + and_true, exists_eq_right_right] + rw [List.filterMap_filterMap] + apply List.filterMap_congr _ + intro policy _ + cases h₁ : Partial.evaluatePolicy policy req entities <;> simp + case none => exact (EvaluatePolicy.subst_preserves_none wf_r wf_e wf_s h_req h₁).symm + case some r => exact Residual.reeval_eqv_substituting_first wf_r wf_e wf_s h_req h₁ /-- Partial-authorizing with concrete inputs gives the same concrete decision as diff --git a/cedar-lean/Cedar/Thm/Partial/Authorization/PartialOnConcrete.lean b/cedar-lean/Cedar/Thm/Partial/Authorization/PartialOnConcrete.lean index 12728a342..c55427ac7 100644 --- a/cedar-lean/Cedar/Thm/Partial/Authorization/PartialOnConcrete.lean +++ b/cedar-lean/Cedar/Thm/Partial/Authorization/PartialOnConcrete.lean @@ -45,7 +45,7 @@ theorem mayBeSatisfied_eq_satisfiedPolicies {policies : Policies} {req : Spec.Re (wf : req.context.WellFormed) : (Partial.isAuthorized req entities policies).mayBeSatisfied eff = Spec.satisfiedPolicies eff policies req entities := by - unfold Partial.Response.mayBeSatisfied Spec.satisfiedPolicies Spec.satisfiedWithEffect Spec.satisfied Partial.isAuthorized + unfold Partial.Response.mayBeSatisfied Spec.satisfiedPolicies Spec.satisfiedWithEffect Spec.satisfied Partial.isAuthorized Partial.evaluatePolicy simp only [List.filterMap_filterMap, Bool.and_eq_true, beq_iff_eq, decide_eq_true_eq] simp only [Partial.Evaluation.Evaluate.on_concrete_eqv_concrete_eval _ req entities wf, Except.map] simp only [Set.make_make_eqv, List.Equiv, List.subset_def] @@ -108,7 +108,7 @@ theorem all_residuals_are_true_residuals {policies : Policies} {req : Spec.Reque (Residual.residual id eff cond) ∈ (Partial.isAuthorized req entities policies).residuals → cond = .value true := by - unfold Partial.isAuthorized + unfold Partial.isAuthorized Partial.evaluatePolicy simp only [Partial.Evaluation.Evaluate.on_concrete_eqv_concrete_eval _ req entities wf, Except.map, List.mem_filterMap, forall_exists_index, and_imp] intro policy _ @@ -199,9 +199,9 @@ theorem errorPolicies_eq_errorPolicies {policies : Policies} {req : Spec.Request case left => intro pid r h₁ h₂ cases r <;> simp only [Option.some.injEq] at h₂ - case error pid' e => + case error pid' => subst pid' - simp only [Partial.isAuthorized, Spec.errored, Spec.hasError, + simp only [Partial.isAuthorized, Partial.evaluatePolicy, Spec.errored, Spec.hasError, List.mem_filterMap, ite_some_none_eq_some] at * replace ⟨policy, h₁, h₂⟩ := h₁ exists policy @@ -219,9 +219,9 @@ theorem errorPolicies_eq_errorPolicies {policies : Policies} {req : Spec.Request subst pid split at h₂ <;> simp only at h₂ case h_2 e h₃ => - exists (.error policy.id e) + exists (.error policy.id) simp only [and_true] - unfold Partial.isAuthorized + unfold Partial.isAuthorized Partial.evaluatePolicy simp only [Partial.Evaluation.Evaluate.on_concrete_eqv_concrete_eval _ req entities wf, List.mem_filterMap] exists policy @@ -229,6 +229,5 @@ theorem errorPolicies_eq_errorPolicies {policies : Policies} {req : Spec.Request split <;> simp only [Option.some.injEq, Residual.error.injEq, true_and] <;> rename_i h₄ <;> simp only [Except.map, h₃, Except.error.injEq] at h₄ - exact h₄.symm end Cedar.Thm.Partial.Authorization.PartialOnConcrete diff --git a/cedar-lean/Cedar/Thm/Partial/EvaluatePolicy.lean b/cedar-lean/Cedar/Thm/Partial/EvaluatePolicy.lean new file mode 100644 index 000000000..e6e4ed66f --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/EvaluatePolicy.lean @@ -0,0 +1,128 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Authorizer +import Cedar.Thm.Partial.Evaluation + +/-! + This file contains lemmas about `Partial.evaluatePolicy`. +-/ + +namespace Cedar.Thm.Partial.EvaluatePolicy + +open Cedar.Data +open Cedar.Partial (Residual Subsmap Unknown) +open Cedar.Spec (Effect Policies Policy PolicyID) + +/-- + if `Partial.evaluatePolicy` produces `some residual` after substitution, it + must have produced `some` with a residual with the same id and effect before + substitution + + (or, if the residual after substitution is an evaluation error, then it must + have produced `some` with a residual with the same id before substitution) +-/ +theorem subst_doesn't_increase_residuals {p : Policy} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + req.subst subsmap = some req' → + Partial.evaluatePolicy p req' (entities.subst subsmap) = some r' → + ∃ r, Partial.evaluatePolicy p req entities = some r ∧ r.id = r'.id ∧ (r.effect = r'.effect ∨ r'.effect = none) +:= by + unfold Partial.evaluatePolicy + intro h_req h₁ + split at h₁ <;> simp only [Option.some.injEq] at h₁ <;> subst h₁ + case h_2 v' h₁ h₂ => + -- after subst, partial eval of the policy produced a .value other than False + have h₃ := Partial.Evaluation.Evaluate.subst_preserves_errors_mt (expr := p.toExpr) (entities := entities) wf_r wf_e wf_s h_req (by + simp only [Except.isOk, Except.toBool] + split <;> simp only [Bool.false_eq_true] + · rename_i h₃ ; simp only [h₃] at h₂ + ) + simp [Except.isOk, Except.toBool] at h₃ + split at h₃ <;> simp at h₃ + clear h₃ <;> rename_i pval h₃ + · exists (Residual.residual p.id p.effect pval) + constructor + · simp only [h₃] + split <;> rename_i h <;> simp only [Option.some.injEq, Residual.residual.injEq, true_and] + <;> simp only [Except.ok.injEq] at h <;> subst h + case h_1 h₃ _ => + -- before subst, partial eval of the policy produced False + have h₅ := Partial.Evaluation.Evaluate.subst_preserves_evaluation_to_value wf_r wf_e wf_s h_req h₃ + simp only [h₅, Except.ok.injEq, Partial.Value.value.injEq] at h₂ + exact h₁ h₂.symm + case h_2 h₃ _ v _ => + -- before subst, partial eval of the policy produced a .value other than False + simp only + · simp only [Residual.id, Residual.effect, or_false, and_self] + case h_3 e' h₁ => + -- after subst, partial eval of the policy produced an error + cases h₂ : Partial.evaluate p.toExpr req entities + case error e => + exists (Residual.error p.id) + constructor + · split <;> simp at * + · exact And.intro (rfl) (by left ; rfl) + case ok pval => + exists (Residual.residual p.id p.effect pval) + constructor + · split <;> rename_i h₃ <;> simp only [Option.some.injEq, Residual.residual.injEq, true_and] + <;> simp at h₃ <;> subst h₃ + · -- before subst, partial eval of the policy produced False + have h₃ := Partial.Evaluation.Evaluate.subst_preserves_evaluation_to_value wf_r wf_e wf_s h_req h₂ + simp only [h₃] at h₁ + · rfl + · simp only [Residual.id, Residual.effect, or_true, and_self] + +/-- + if `Partial.evaluatePolicy` produces `none` before substitution, then it also + does after any substitution +-/ +theorem subst_preserves_none {p : Policy} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + req.subst subsmap = some req' → + Partial.evaluatePolicy p req entities = none → + Partial.evaluatePolicy p req' (entities.subst subsmap) = none +:= by + unfold Partial.evaluatePolicy + intro h_req h₁ + split at h₁ <;> simp at h₁ + · rename_i h₂ + simp only [Partial.Evaluation.Evaluate.subst_preserves_evaluation_to_value wf_r wf_e wf_s h_req h₂] + +/-- + if `Partial.evaluatePolicy` produces an error-residual before substitution, + then it also does after any substitution +-/ +theorem subst_preserves_err {p : Policy} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + req.subst subsmap = some req' → + Partial.evaluatePolicy p req entities = some (Residual.error pid) → + Partial.evaluatePolicy p req' (entities.subst subsmap) = some (Residual.error pid) +:= by + unfold Partial.evaluatePolicy + intro h_req h₁ + split at h₁ <;> simp at h₁ + subst pid + rename_i e h₂ + have ⟨e', h₃⟩ := Partial.Evaluation.Evaluate.subst_preserves_errors wf_r wf_e wf_s h_req h₂ + simp only [h₃] diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation.lean index 4f66f64ee..008ca1200 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation.lean @@ -15,3 +15,5 @@ -/ import Cedar.Thm.Partial.Evaluation.Evaluate +import Cedar.Thm.Partial.Evaluation.EvaluateValue +import Cedar.Thm.Partial.Evaluation.Reevaluation diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate.lean index 2bab92c2b..d63c1a323 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate.lean @@ -17,6 +17,7 @@ import Cedar.Partial.Evaluator import Cedar.Partial.Value import Cedar.Spec.Evaluator +import Cedar.Thm.Partial.Evaluation.EvaluateValue import Cedar.Thm.Partial.Evaluation.Evaluate.And import Cedar.Thm.Partial.Evaluation.Evaluate.AndOr import Cedar.Thm.Partial.Evaluation.Evaluate.Binary @@ -24,6 +25,7 @@ import Cedar.Thm.Partial.Evaluation.Evaluate.Call import Cedar.Thm.Partial.Evaluation.Evaluate.GetAttr import Cedar.Thm.Partial.Evaluation.Evaluate.HasAttr import Cedar.Thm.Partial.Evaluation.Evaluate.Ite +import Cedar.Thm.Partial.Evaluation.Evaluate.Lemmas import Cedar.Thm.Partial.Evaluation.Evaluate.Or import Cedar.Thm.Partial.Evaluation.Evaluate.Record import Cedar.Thm.Partial.Evaluation.Evaluate.Set @@ -32,6 +34,7 @@ import Cedar.Thm.Partial.Evaluation.Evaluate.Var import Cedar.Thm.Partial.Evaluation.Props import Cedar.Thm.Partial.WellFormed import Cedar.Thm.Data.Control +import Cedar.Thm.Data.List /-! This file contains theorems about the `Partial.evaluate` function specifically. -/ @@ -39,7 +42,7 @@ namespace Cedar.Thm.Partial.Evaluation.Evaluate open Cedar.Data open Cedar.Partial (Subsmap Unknown) -open Cedar.Spec (Error Expr Prim Result) +open Cedar.Spec (Attr Error Expr Prim Result) /-- Partial evaluation with concrete inputs gives the same output as @@ -53,7 +56,7 @@ theorem on_concrete_eqv_concrete_eval' (expr : Expr) (request : Spec.Request) (e cases expr case lit p => simp [Partial.evaluate, Spec.evaluate, Except.map] case var v => - have h := Var.on_concrete_eqv_concrete_eval v request entities wf + have h := Var.on_concrete_eqv_concrete_eval v request entities unfold PartialEvalEquivConcreteEval at h ; exact h case and x₁ x₂ | or x₁ x₂ => have ih₁ := on_concrete_eqv_concrete_eval' x₁ request entities wf @@ -158,42 +161,47 @@ theorem partial_eval_wf {expr : Expr} {request : Partial.Request} {entities : Pa intro pval intro h₁ ; simp at h₁ ; subst h₁ simp [Partial.Value.WellFormed, Spec.Value.WellFormed, Prim.WellFormed] - case var v => exact Var.partial_eval_wf wf_r + case var v => exact Var.partial_eval_wf wf_r wf_e (EvaluateValue.evalValue_wf) case and x₁ x₂ | or x₁ x₂ => intro pval - have := AndOr.partial_eval_wf x₁ x₂ request entities + have := AndOr.partial_eval_wf x₁ x₂ request entities wf_r + (partial_eval_wf wf_r wf_e (expr := x₁)) + (partial_eval_wf wf_r wf_e (expr := x₂)) first | exact this.left pval | exact this.right pval - case unaryApp op x₁ => exact Unary.partial_eval_wf + case unaryApp op x₁ => + apply Unary.partial_eval_wf + · exact partial_eval_wf wf_r wf_e case binaryApp op x₁ x₂ => - have ih₁ := partial_eval_wf wf_r wf_e (expr := x₁) (request := request) (entities := entities) - have ih₂ := partial_eval_wf wf_r wf_e (expr := x₂) (request := request) (entities := entities) - exact Binary.partial_eval_wf ih₁ ih₂ - case hasAttr x₁ attr => exact HasAttr.partial_eval_wf + apply Binary.partial_eval_wf + · exact partial_eval_wf wf_r wf_e + · exact partial_eval_wf wf_r wf_e + case hasAttr x₁ attr => + apply HasAttr.partial_eval_wf + · exact partial_eval_wf wf_r wf_e case getAttr x₁ attr => - have ih₁ := partial_eval_wf wf_r wf_e (expr := x₁) (request := request) (entities := entities) - exact GetAttr.partial_eval_wf ih₁ wf_e + apply GetAttr.partial_eval_wf _ _ wf_e + · exact partial_eval_wf wf_r wf_e + · intro _ _ wf₁ ; exact EvaluateValue.evalValue_wf wf₁ wf_e case ite x₁ x₂ x₃ => - have ih₂ := partial_eval_wf wf_r wf_e (expr := x₂) (request := request) (entities := entities) - have ih₃ := partial_eval_wf wf_r wf_e (expr := x₃) (request := request) (entities := entities) - exact Ite.partial_eval_wf ih₂ ih₃ + apply Ite.partial_eval_wf wf_r + · exact partial_eval_wf wf_r wf_e + · exact partial_eval_wf wf_r wf_e + · exact partial_eval_wf wf_r wf_e case set xs => - have ih : ∀ x ∈ xs, EvaluatesToWellFormed x request entities := by - intro x h₁ + apply Set.partial_eval_wf + · intro x h₁ have := List.sizeOf_lt_of_mem h₁ - apply partial_eval_wf wf_r wf_e - exact Set.partial_eval_wf ih + exact partial_eval_wf wf_r wf_e case record attrs => - have ih : ∀ kv ∈ attrs, EvaluatesToWellFormed kv.snd request entities := by - intro kv h₁ + apply Record.partial_eval_wf + · intro kv h₁ have := List.sizeOf_lt_of_mem h₁ - apply partial_eval_wf wf_r wf_e - exact Record.partial_eval_wf ih + exact partial_eval_wf wf_r wf_e case call xfn xs => - have ih : ∀ x ∈ xs, EvaluatesToWellFormed x request entities := by - intro x h₁ + apply Call.partial_eval_wf + · intro x h₁ have := List.sizeOf_lt_of_mem h₁ - apply partial_eval_wf wf_r wf_e - exact Call.partial_eval_wf ih + exact partial_eval_wf wf_r wf_e termination_by expr decreasing_by all_goals simp_wf @@ -203,6 +211,38 @@ decreasing_by simp at this omega +/-- + `partial_eval_wf`, lifted to lists of `Spec.Expr` +-/ +theorem partial_eval_wf_mapM {exprs : List Spec.Expr} {request : Partial.Request} {entities : Partial.Entities} + (wf_r : request.WellFormed) + (wf_e : entities.WellFormed) : + ∀ pvals, + exprs.mapM (Partial.evaluate · request entities) = .ok pvals → + ∀ pval ∈ pvals, pval.WellFormed +:= by + intro pvals h₁ pval h_pval + replace ⟨x, _, h₁⟩ := List.mapM_ok_implies_all_from_ok h₁ pval h_pval + exact partial_eval_wf wf_r wf_e _ h₁ + +/-- + `partial_eval_wf`, lifted to lists of pairs `Attr × Spec.Expr` +-/ +theorem partial_eval_wf_mapM_snd {pairs : List (Attr × Spec.Expr)} {request : Partial.Request} {entities : Partial.Entities} + (wf_r : request.WellFormed) + (wf_e : entities.WellFormed) : + ∀ pairs', + pairs.mapM (λ pair => Partial.bindAttr pair.fst (Partial.evaluate pair.snd request entities)) = .ok pairs' → + ∀ pval ∈ pairs'.map Prod.snd, pval.WellFormed +:= by + intro pairs' h₁ pval h_pval + simp only [List.mem_map] at h_pval + replace ⟨(k, pval), hk, h_pval⟩ := h_pval ; simp only at h_pval ; subst h_pval + replace ⟨(k', x), _, h₁⟩ := List.mapM_ok_implies_all_from_ok h₁ _ hk + simp [Partial.bindAttr, do_ok] at h₁ + replace ⟨h₁, h₁'⟩ := h₁ ; subst k' + exact partial_eval_wf wf_r wf_e _ h₁ + /-- If partial evaluation returns a concrete value, then it returns the same value after any substitution of unknowns @@ -360,10 +400,11 @@ theorem subst_preserves_evaluation_to_value {expr : Expr} {req req' : Partial.Re exact ih₃ case getAttr x₁ attr => intro h_req h₁ - apply GetAttr.subst_preserves_evaluation_to_value wf_e wf_s _ h_req v h₁ + apply GetAttr.subst_preserves_evaluation_to_value wf_r wf_e wf_s _ _ h_req v h₁ · unfold SubstPreservesEvaluationToConcrete intro _ v₁' hx₁' exact subst_preserves_evaluation_to_value wf_r wf_e wf_s h_req hx₁' + · intro x r es pv wf_r wf_es ; exact partial_eval_wf wf_r wf_es _ case hasAttr x₁ attr => intro h_req h₁ apply HasAttr.subst_preserves_evaluation_to_value wf_e _ h_req v h₁ @@ -434,9 +475,7 @@ theorem subst_preserves_errors {expr : Expr} {req req' : Partial.Request} {entit := by cases expr <;> intro h_req h₁ case lit => simp only [Partial.evaluate] at h₁ - case var v => - have h := Var.subst_preserves_errors h_req h₁ - exists e + case var v => exact Var.subst_preserves_errors wf_r wf_e wf_s h_req h₁ case and x₁ x₂ => apply (AndOr.subst_preserves_errors (by intro x _ v ; exact subst_preserves_evaluation_to_value wf_r wf_e wf_s h_req) _ _).left h_req e h₁ all_goals { @@ -473,7 +512,7 @@ theorem subst_preserves_errors {expr : Expr} {req req' : Partial.Request} {entit exact subst_preserves_errors wf_r wf_e wf_s h_req } case getAttr x₁ attr => - apply GetAttr.subst_preserves_errors wf_e wf_s (by intro x _ v ; exact subst_preserves_evaluation_to_value wf_r wf_e wf_s h_req) _ h_req e h₁ + apply GetAttr.subst_preserves_errors wf_e wf_s (by intro x _ v ; exact subst_preserves_evaluation_to_value wf_r wf_e wf_s h_req) (by intro pv ; exact partial_eval_wf wf_r wf_e _) _ h_req e h₁ all_goals { unfold SubstPreservesEvaluationToError intro _ e' @@ -532,3 +571,108 @@ theorem subst_preserves_errors_mt {expr : Expr} {req req' : Partial.Request} {en case _ e h₄ => have ⟨e', h₅⟩ := subst_preserves_errors wf_r wf_e wf_s h₁ h₄ simp [h₅] at h₂ + +/-- + Possibly-surprising strong result: `Partial.evaluate` is equivalent to + `Expr.substToPartialValue` followed by `Partial.evaluateValue` + + (since this actually holds, should we just have defined `Partial.evaluate` + this way? does that make sense as the definition/spec?) +-/ +theorem evaluate_eqv_evalValue_substToPartialValue (expr : Expr) {req : Partial.Request} (entities : Partial.Entities) + (wf_r : req.WellFormed) : + Partial.evaluate expr req entities = Partial.evaluateValue (expr.substToPartialValue req) entities +:= by + cases expr + case' var v => cases v + all_goals simp [Partial.evaluate, Partial.evaluateValue, Partial.evaluateResidual, Expr.substToPartialValue] + case var.principal | var.action | var.resource => + simp [Partial.evaluateVar] + split <;> simp [Partial.evaluateValue, Partial.evaluateResidual] + case var.context => + simp [Partial.evaluateVar] + rw [Record.mapM₂_eq_mapM_partial_bindAttr (Partial.evaluateValue · entities)] + simp [Map.mapMOnValues, Partial.bindAttr, pure, Except.pure, Option.bind] + apply do_eq_do_except + intro apvs hapvs + have hsorted₁ : apvs.SortedBy Prod.fst := by + apply mapM_Except_on_snd_preserves_sortedBy_fst _ hapvs (f := (Partial.evaluateValue · entities)) + exact Map.wf_iff_sorted.mp wf_r.left + split <;> rename_i h₁ + rw [Map.kvs_mk_id] at h₁ + · rename_i m + split at h₁ <;> simp at h₁ ; subst m ; rename_i avs₁ h₁ + have hsorted₂ : avs₁.SortedBy Prod.fst := by + apply mapM_Option_on_snd_preserves_sortedBy_fst _ h₁ (f := λ pv => match pv with | Partial.Value.value v => some v | Partial.Value.residual _ => none) + exact hsorted₁ + split <;> rename_i h₂ <;> simp + · rename_i avs₂ + have hsorted₃ : avs₂.SortedBy Prod.fst := mapM_Option_on_snd_preserves_sortedBy_fst' hsorted₁ h₂ + rw [← Map.eq_iff_kvs_equiv (Map.mk_wf hsorted₂) (Map.make_wf avs₂), List.Equiv, List.subset_def] + rw [Map.kvs_mk_id] + and_intros <;> intro (k, v) h₃ + · apply Map.mem_list_mem_make hsorted₃ + replace ⟨(k', pv), h₄, h₁⟩ := List.mapM_some_implies_all_from_some h₁ (k, v) h₃ + split at h₁ <;> simp at h₁ ; replace ⟨h₁, h₁'⟩ := h₁ ; subst k' h₁' ; rename_i v h₁ + split at h₁ <;> simp at h₁ ; subst h₁ ; rename_i v h₁ + replace ⟨(k'', v'), h₅, h₂⟩ := List.mapM_some_implies_all_some h₂ (k, pv) h₄ + split at h₂ <;> simp at h₂ ; replace ⟨h₂, h₂'⟩ := h₂ ; subst k'' v' ; rename_i v' h₂ + simp only at * ; subst h₁ + simp only [Partial.Value.value.injEq] at h₂ ; subst v' + exact h₅ + · replace h₃ := Map.make_mem_list_mem h₃ + replace ⟨(k', pv), h₄, h₂⟩ := List.mapM_some_implies_all_from_some h₂ (k, v) h₃ + split at h₂ <;> simp at h₂ ; replace ⟨h₂, h₂'⟩ := h₂ ; subst k' v ; rename_i v h₂ + simp only at h₂ ; subst pv + replace ⟨(k', v'), h₅, h₁⟩ := List.mapM_some_implies_all_some h₁ (k, .value v) h₄ + split at h₁ <;> simp at h₁ ; replace ⟨h₁, h₁'⟩ := h₁ ; subst k' v' ; rename_i v' h₁ + split at h₁ <;> simp at h₁ ; subst v' ; rename_i v' h₁ + simp only [Partial.Value.value.injEq] at h₁ ; subst v' + exact h₅ + · replace ⟨(k, v), h₂, h₃⟩ := List.mapM_none_iff_exists_none.mp h₂ + split at h₃ <;> simp at h₃ ; rename_i r h₄ + simp only at h₄ ; subst v + replace h₁ := List.mapM_some_implies_all_some h₁ (k, .residual r) h₂ + simp at h₁ + · split at h₁ <;> simp at h₁ ; rename_i h₂ + rw [Map.kvs_mk_id] at h₂ + replace ⟨(k, v), h₂, h₃⟩ := List.mapM_none_iff_exists_none.mp h₂ + split at h₃ <;> simp at h₃ ; rename_i h₄ + split at h₄ <;> simp at h₄ ; rename_i r h₅ + simp only at h₅ ; subst v + split <;> rename_i h₅ + · replace ⟨(k', v), h₅, h₆⟩ := List.mapM_some_implies_all_some h₅ (k, .residual r) h₂ + split at h₆ + · rename_i h₇ ; simp at h₇ + · simp at h₆ + · simp [Map.kvs_mk_id] + case and x₁ x₂ | or x₁ x₂ | ite x₁ x₂ x₃ => + simp [evaluate_eqv_evalValue_substToPartialValue x₁ entities wf_r] + apply do_eq_do + intro pv + cases pv <;> simp + case a.value v => + cases v.asBool <;> simp [evaluate_eqv_evalValue_substToPartialValue _ entities wf_r] + case unaryApp op x₁ | getAttr x₁ attr | hasAttr x₁ attr => + simp [evaluate_eqv_evalValue_substToPartialValue x₁ entities wf_r] + case binaryApp op x₁ x₂ => + simp [evaluate_eqv_evalValue_substToPartialValue x₁ entities wf_r] + simp [evaluate_eqv_evalValue_substToPartialValue x₂ entities wf_r] + case set xs | call xfn xs => + simp [evaluate_eqv_evalValue_substToPartialValue _ entities wf_r] + rw [List.mapM₁_eq_mapM (Partial.evaluateValue · entities)] + rw [List.mapM₁_eq_mapM (λ x => Partial.evaluateValue (Expr.substToPartialValue req x) entities)] + rw [List.map₁_eq_map, List.mapM_map] + case record attrs => + simp [evaluate_eqv_evalValue_substToPartialValue _ entities wf_r] + rw [Record.mapM₂_eq_mapM_partial_bindAttr (Partial.evaluateValue · entities)] + rw [Record.mapM₂_eq_mapM_partial_bindAttr (λ x => Partial.evaluateValue (Expr.substToPartialValue req x) entities)] + rw [List.map_attach₂_snd, List.mapM_map] +termination_by expr +decreasing_by + all_goals simp_wf + all_goals try omega + all_goals sorry + + +end Cedar.Thm.Partial.Evaluation.Evaluate diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/AndOr.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/AndOr.lean index e2c16373b..b6f8df018 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/AndOr.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/AndOr.lean @@ -17,6 +17,7 @@ import Cedar.Partial.Evaluator import Cedar.Thm.Data.Control import Cedar.Thm.Partial.Evaluation.Props +import Cedar.Thm.Partial.Subst import Cedar.Thm.Partial.WellFormed namespace Cedar.Thm.Partial.Evaluation.Evaluate.AndOr @@ -62,10 +63,14 @@ theorem on_concrete_eqv_concrete_eval {x₁ x₂ : Expr} {request : Spec.Request } /-- - If partial-evaluating an `Expr.and` or `Expr.or` produces `ok` - with some value, that value is well-formed. + Inductive argument that if partial-evaluating an `Expr.and` or `Expr.or` + with well-formed arguments produces `ok` with some value, that value is + well-formed as well. -/ -theorem partial_eval_wf (x₁ x₂ : Expr) (request : Partial.Request) (entities : Partial.Entities) : +theorem partial_eval_wf (x₁ x₂ : Expr) (request : Partial.Request) (entities : Partial.Entities) + (wf_r : request.WellFormed) + (ih₁ : EvaluatesToWellFormed x₁ request entities) + (ih₂ : EvaluatesToWellFormed x₂ request entities) : EvaluatesToWellFormed (Expr.and x₁ x₂) request entities ∧ EvaluatesToWellFormed (Expr.or x₁ x₂) request entities := by @@ -76,7 +81,12 @@ theorem partial_eval_wf (x₁ x₂ : Expr) (request : Partial.Request) (entities case error => simp case ok pval₁ => cases pval₁ - case residual r₁ => simp [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + case residual r₁ => + simp [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + and_intros + · specialize ih₁ (.residual r₁) hx₁ + simpa [Partial.Value.WellFormed] using ih₁ + · exact Subst.substToPartialValue_wf x₂ wf_r case value v₁ => cases v₁ <;> simp [Spec.Value.asBool] case prim p₁ => @@ -91,7 +101,13 @@ theorem partial_eval_wf (x₁ x₂ : Expr) (request : Partial.Request) (entities cases hx₂ : Partial.evaluate x₂ request entities <;> simp [hx₂] case ok pval₂ => cases pval₂ <;> simp - case residual r₂ => intro h₁ ; subst h₁ ; simp [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + case residual r₂ => + intro h₁ ; subst h₁ + simp only [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + and_intros + · simp [Spec.Value.WellFormed, Prim.WellFormed] + · have h₁ := ih₂ (.residual r₂) hx₂ + simpa [Partial.Value.WellFormed] using h₁ case value v₂ => cases v₂ <;> try simp case prim p₂ => @@ -159,7 +175,7 @@ theorem subst_preserves_evaluation_to_value {x₁ x₂ : Expr} {req req' : Parti The proof of `subst_preserves_evaluation_to_value` for this request/entities/subsmap is passed in as an argument, because this file can't - import `Thm/Partial/Evaluation.lean` to access it. + import `Thm/Partial/Evaluation/Evaluate.lean` to access it. See #372. -/ theorem subst_preserves_errors {x₁ x₂ : Expr} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Binary.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Binary.lean index a86364a6a..ceb3e374f 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Binary.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Binary.lean @@ -121,7 +121,7 @@ theorem subst_preserves_evaluation_to_value {x₁ x₂ : Expr} {op : BinaryOp} { The proof of `subst_preserves_evaluation_to_value` for this request/entities/subsmap is passed in as an argument, because this file can't - import `Thm/Partial/Evaluation.lean` to access it. + import `Thm/Partial/Evaluation/Evaluate.lean` to access it. See #372. -/ theorem subst_preserves_errors {x₁ x₂ : Expr} {op : BinaryOp} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Call.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Call.lean index 890a5403c..6b86a1fe8 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Call.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Call.lean @@ -126,7 +126,7 @@ theorem subst_preserves_evaluation_to_value {args : List Expr} {req req' : Parti The proof of `subst_preserves_evaluation_to_value` for this request/entities/subsmap is passed in as an argument, because this file can't - import `Thm/Partial/Evaluation.lean` to access it. + import `Thm/Partial/Evaluation/Evaluate.lean` to access it. See #372. -/ theorem subst_preserves_errors {xs : List Expr} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} {xfn : ExtFun} diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/GetAttr.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/GetAttr.lean index 6feb382d5..342445241 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/GetAttr.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/GetAttr.lean @@ -21,6 +21,7 @@ import Cedar.Thm.Data.LT import Cedar.Thm.Data.Map import Cedar.Thm.Data.Set import Cedar.Thm.Partial.Evaluation.EvaluateGetAttr +import Cedar.Thm.Partial.Evaluation.EvaluateValue import Cedar.Thm.Partial.Evaluation.Props import Cedar.Thm.Partial.Subst import Cedar.Thm.Partial.WellFormed @@ -54,22 +55,29 @@ theorem on_concrete_eqv_concrete_eval {x₁ : Expr} {request : Spec.Request} {en -/ theorem partial_eval_wf {x₁ : Expr} {attr : Attr} {entities : Partial.Entities} {request : Partial.Request} (ih₁ : EvaluatesToWellFormed x₁ request entities) + (ih₂ : ∀ {pval pval' : Partial.Value}, pval.WellFormed → Partial.evaluateValue pval entities = .ok pval' → pval'.WellFormed) (wf_e : entities.WellFormed) : EvaluatesToWellFormed (Expr.getAttr x₁ attr) request entities := by unfold EvaluatesToWellFormed Partial.evaluate cases hx₁ : Partial.evaluate x₁ request entities <;> simp [hx₁] - case ok pval₁ => exact EvaluateGetAttr.evaluateGetAttr_wf (ih₁ pval₁ hx₁) wf_e + case ok pval₁ => exact EvaluateGetAttr.evaluateGetAttr_wf (ih₁ pval₁ hx₁) wf_e ih₂ /-- Inductive argument that if partial-evaluation of an `Expr.getAttr` returns a concrete value, then it returns the same value after any substitution of unknowns + + This takes the proof of `Evaluate.partial_eval_wf` as an argument, because this + file can't directly import `Thm/Partial/Evaluation/Evaluate.lean` to get it. + See #372. -/ theorem subst_preserves_evaluation_to_value {x₁ : Expr} {attr : Attr} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_r : req.WellFormed) (wf_e : entities.WellFormed) (wf_s : subsmap.WellFormed) - (ih₁ : SubstPreservesEvaluationToConcrete x₁ req req' entities subsmap) : + (ih₁ : SubstPreservesEvaluationToConcrete x₁ req req' entities subsmap) + (h_pewf : ∀ x r es pv, r.WellFormed → es.WellFormed → Partial.evaluate x r es = .ok pv → pv.WellFormed) : SubstPreservesEvaluationToConcrete (Expr.getAttr x₁ attr) req req' entities subsmap := by unfold SubstPreservesEvaluationToConcrete at * @@ -77,14 +85,18 @@ theorem subst_preserves_evaluation_to_value {x₁ : Expr} {attr : Attr} {req req intro h_req v specialize ih₁ h_req cases hx₁ : Partial.evaluate x₁ req entities - <;> simp only [hx₁, false_implies, forall_const, Except.bind_ok, Except.bind_err, Except.ok.injEq] at * - case ok pval₁ => - cases pval₁ - case residual r₁ => simp only [Partial.evaluateGetAttr, Except.ok.injEq, false_implies] + <;> simp only [hx₁, false_implies, implies_true, Except.ok.injEq] at ih₁ + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok pv₁ => + cases pv₁ + case residual r₁ => simp [Partial.evaluateGetAttr] case value v₁ => simp only [Partial.Value.value.injEq, forall_eq'] at * simp only [ih₁, Except.bind_ok] - exact EvaluateGetAttr.subst_preserves_evaluation_to_value wf_e wf_s + apply EvaluateGetAttr.subst_preserves_evaluation_to_value _ wf_e wf_s + intro v v' pv wf_v h₁ + apply EvaluateValue.subst_preserves_evaluation_to_value subsmap (EvaluateGetAttr.getAttr_wf wf_v wf_e _ h₁) + exact h_pewf _ _ _ (.value v₁) (Subst.req_subst_preserves_wf wf_r wf_s h_req) (Subst.entities_subst_preserves_wf wf_e wf_s) ih₁ /-- Inductive argument that if partial-evaluation of an `Expr.getAttr` @@ -93,13 +105,18 @@ theorem subst_preserves_evaluation_to_value {x₁ : Expr} {attr : Attr} {req req The proof of `subst_preserves_evaluation_to_value` for this request/entities/subsmap is passed in as an argument, because this file can't - import `Thm/Partial/Evaluation.lean` to access it. + import `Thm/Partial/Evaluation/Evaluate.lean` to access it. + See #372. + + The proof of `partial_eval_wf` for `x₁` is passed in as an argument, because + this file can't import `Thm/Partial/Evaluation/Evaluate.lean` to access it. See #372. -/ theorem subst_preserves_errors {x₁ : Expr} {attr : Attr} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} (wf_e : entities.WellFormed) (wf_s : subsmap.WellFormed) (h_spetv : ∀ x, SubstPreservesEvaluationToConcrete x req req' entities subsmap) + (h_pewf : ∀ pv, Partial.evaluate x₁ req entities = .ok pv → pv.WellFormed) (ih₁ : SubstPreservesEvaluationToError x₁ req req' entities subsmap) : SubstPreservesEvaluationToError (Expr.getAttr x₁ attr) req req' entities subsmap := by @@ -113,16 +130,20 @@ theorem subst_preserves_errors {x₁ : Expr} {attr : Attr} {req req' : Partial.R simp [ih₁] case ok pval₁ => simp only [Except.bind_ok] + specialize h_pewf pval₁ hx₁ intro e₁ h₁ cases hx₁' : Partial.evaluate x₁ req' (entities.subst subsmap) case error e₁' => exists e₁' case ok pval₁' => simp only [Except.bind_ok] cases pval₁ - case residual r₁ => exists e₁ + case residual r₁ => simp [Partial.evaluateGetAttr] at h₁ case value v₁ => simp only [h_spetv x₁ h_req v₁ hx₁, Except.ok.injEq] at hx₁' ; subst pval₁' - exact EvaluateGetAttr.subst_preserves_errors subsmap wf_e wf_s h₁ + apply EvaluateGetAttr.subst_preserves_errors h_pewf wf_e wf_s _ h₁ + intro v pv wf_v h₂ + apply EvaluateValue.subst_preserves_errors _ wf_e wf_s + exact EvaluateGetAttr.getAttr_wf wf_v wf_e _ h₂ end Cedar.Thm.Partial.Evaluation.Evaluate.GetAttr diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/HasAttr.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/HasAttr.lean index 34c3108fe..d7c4b7c09 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/HasAttr.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/HasAttr.lean @@ -47,16 +47,19 @@ theorem on_concrete_eqv_concrete_eval {x₁ : Expr} {request : Spec.Request} {en case ok v₁ => exact EvaluateHasAttr.on_concrete_eqv_concrete /-- - if partial-evaluating an `Expr.hasAttr` returns `ok` with some value, - that is a well-formed value + Inductive argument that if partial-evaluating an `Expr.hasAttr` on a + well-formed value returns `ok` with some value, that is a well-formed value as + well -/ -theorem partial_eval_wf {x₁ : Expr} {attr : Attr} {entities : Partial.Entities} {request : Partial.Request} : +theorem partial_eval_wf {x₁ : Expr} {attr : Attr} {entities : Partial.Entities} {request : Partial.Request} + (ih₁ : EvaluatesToWellFormed x₁ request entities) : EvaluatesToWellFormed (Expr.hasAttr x₁ attr) request entities := by unfold EvaluatesToWellFormed Partial.evaluate cases hx₁ : Partial.evaluate x₁ request entities <;> simp [hx₁] case ok pval₁ => - exact EvaluateHasAttr.evaluateHasAttr_wf + apply EvaluateHasAttr.evaluateHasAttr_wf + exact ih₁ pval₁ hx₁ /-- If partial-evaluating an `Expr.hasAttr` produces `ok` with a concrete @@ -108,7 +111,7 @@ theorem subst_preserves_evaluation_to_value {x₁ : Expr} {attr : Attr} {req req The proof of `subst_preserves_evaluation_to_value` for this request/entities/subsmap is passed in as an argument, because this file can't - import `Thm/Partial/Evaluation.lean` to access it. + import `Thm/Partial/Evaluation/Evaluate.lean` to access it. See #372. -/ theorem subst_preserves_errors {x₁ : Expr} {attr : Attr} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Ite.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Ite.lean index 0eaea160f..216aa0686 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Ite.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Ite.lean @@ -55,6 +55,8 @@ theorem on_concrete_eqv_concrete_eval {x₁ x₂ x₃ : Expr} {request : Spec.Re produces `ok` with some value, that value is well-formed as well -/ theorem partial_eval_wf {x₁ x₂ x₃ : Expr} {request : Partial.Request} {entities : Partial.Entities} + (wf_r : request.WellFormed) + (ih₁ : EvaluatesToWellFormed x₁ request entities) (ih₂ : EvaluatesToWellFormed x₂ request entities) (ih₃ : EvaluatesToWellFormed x₃ request entities) : EvaluatesToWellFormed (Expr.ite x₁ x₂ x₃) request entities @@ -63,7 +65,13 @@ theorem partial_eval_wf {x₁ x₂ x₃ : Expr} {request : Partial.Request} {ent cases hx₁ : Partial.evaluate x₁ request entities <;> simp [hx₁] case ok pval₁ => cases pval₁ <;> simp only [Except.ok.injEq, forall_eq'] - case residual r₁ => simp only [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + case residual r₁ => + simp only [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + and_intros + · have h₁ := ih₁ (.residual r₁) hx₁ + simpa [Partial.Value.WellFormed] using h₁ + · exact Subst.substToPartialValue_wf x₂ wf_r + · exact Subst.substToPartialValue_wf x₃ wf_r case value v₁ => cases v₁ <;> simp only [Spec.Value.asBool, Except.bind_err, false_implies, implies_true] case prim p₁ => @@ -152,7 +160,7 @@ theorem subst_preserves_evaluation_to_value {x₁ x₂ x₃ : Expr} {req req' : The proof of `subst_preserves_evaluation_to_value` for this request/entities/subsmap is passed in as an argument, because this file can't - import `Thm/Partial/Evaluation.lean` to access it. + import `Thm/Partial/Evaluation/Evaluate.lean` to access it. See #372. -/ theorem subst_preserves_errors {x₁ x₂ x₃ : Expr} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Lemmas.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Lemmas.lean new file mode 100644 index 000000000..d55a85ef1 --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Lemmas.lean @@ -0,0 +1,80 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Value +import Cedar.Thm.Data.List +import Cedar.Thm.Data.LT + +/-! + This file contains lemmas about `mapM` and `SortedBy` that seem a little too + specialized to go in `Thm/Data`, particularly because one of them uses + `Partial.Value`. +-/ + +namespace Cedar.Thm.Partial.Evaluation.Evaluate + +open Cedar.Data +open Cedar.Spec (Attr) + +theorem mapM_Option_on_snd_preserves_sortedBy_fst [LT α] [DecidableLT α] [StrictLT α] {abs : List (α × β)} {f : β → Option γ} : + abs.SortedBy Prod.fst → + abs.mapM (λ (a, b) => do some (a, ← f b)) = some ags → + ags.SortedBy Prod.fst +:= by + intro h₁ h₂ + replace h₂ := List.mapM_some_eq_filterMap h₂ + subst h₂ + apply List.filterMap_sortedBy _ h₁ + simp only [Option.bind_eq_bind, Option.bind_eq_some, Option.some.injEq, forall_exists_index, + and_imp, forall_apply_eq_imp_iff₂, implies_true] + +theorem mapM_Except_on_snd_preserves_sortedBy_fst [LT α] [DecidableLT α] [StrictLT α] {abs : List (α × β)} {f : β → Except ε γ} : + abs.SortedBy Prod.fst → + abs.mapM (λ (a, b) => do .ok (a, ← f b)) = .ok ags → + ags.SortedBy Prod.fst +:= by + intro h₁ h₂ + replace h₂ := List.mapM_ok_eq_filterMap h₂ + subst h₂ + apply List.filterMap_sortedBy _ h₁ + intro (a, b) (a', g) + split <;> rename_i h₂ <;> split at h₂ <;> rename_i h₃ + <;> simp only [Prod.mk.injEq] at h₃ <;> replace ⟨h₃, h₃'⟩ := h₃ <;> subst h₃ h₃' + · simp only [Option.some.injEq] + cases hb : f b <;> simp only [hb, Except.bind_err, Except.bind_ok, Except.ok.injEq] at h₂ + subst h₂ + simp only [Prod.mk.injEq, and_imp] + intro _ ; subst a' ; simp only [implies_true] + · simp only [false_implies] + +/-- + Not quite a pure specialization of the above to a particular `f`, because the + lambda has a different shape +-/ +theorem mapM_Option_on_snd_preserves_sortedBy_fst' {avs : List (Attr × Partial.Value)} : + avs.SortedBy Prod.fst → + avs.mapM (λ av => match av.snd with | .value v => some (av.fst, v) | .residual _ => none) = some ags → + ags.SortedBy Prod.fst +:= by + intro h₁ h₂ + replace h₂ := List.mapM_some_eq_filterMap h₂ + subst h₂ + apply List.filterMap_sortedBy _ h₁ + intro (a₁, pv) (a₂, v) + split <;> simp + · intro h₁ _ ; exact h₁ + +end Cedar.Thm.Partial.Evaluation.Evaluate diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Record.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Record.lean index b9116c7bf..d37d314de 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Record.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Record.lean @@ -29,6 +29,11 @@ open Cedar.Data open Cedar.Partial (Subsmap Unknown) open Cedar.Spec (Attr Error Expr Result) +theorem sizeOf_map_lt_of_val (m : Map Attr Spec.Value) : + sizeOf m < sizeOf (Spec.Value.record m) +:= by + sorry + /-- `Partial.bindAttr` on concrete arguments is the same as `Spec.bindAttr` on those arguments @@ -88,7 +93,7 @@ private theorem mapM₂_eq_mapM_spec_bindAttr [SizeOf β] `List.mapM₂_eq_mapM` specialized for a particular setting involving pairs and `Partial.bindAttr` -/ -private theorem mapM₂_eq_mapM_partial_bindAttr [SizeOf β] +theorem mapM₂_eq_mapM_partial_bindAttr [SizeOf β] (f : β → Result Partial.Value) (attrs : List (Attr × β)) : attrs.mapM₂ @@ -181,6 +186,12 @@ theorem partial_eval_wf {attrs: List (Attr × Expr)} {request : Partial.Request} subst k' pval' simpa [Partial.Value.WellFormed] using ih (k, v) h₅ (.value v') h₇ · simp only [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + intro (k, pv) hpv + replace ⟨(k', x), hx, hkv⟩ := hkv (k, pv) hpv + split at hkv <;> rename_i k'' x' hx' + simp only [Prod.mk.injEq] at hx' ; replace ⟨hx', hx''⟩ := hx' ; subst k'' x' + simp only [Partial.bindAttr, do_ok, Prod.mk.injEq, exists_eq_right_right] at hkv + exact ih (k', x) hx _ hkv.left /-- If partial-evaluating an `Expr.record` produces `ok` with a concrete diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Set.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Set.lean index 239689dee..f4d5093a3 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Set.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Set.lean @@ -29,6 +29,11 @@ open Cedar.Data open Cedar.Partial (Subsmap Unknown) open Cedar.Spec (Expr Result) +theorem sizeOf_set_lt_of_val (xs : Set Spec.Value) : + sizeOf xs < sizeOf (Spec.Value.set xs) +:= by + sorry + /-- Lemma (used for both the Set and Call cases): @@ -111,6 +116,9 @@ theorem partial_eval_wf {xs : List Expr} {request : Partial.Request} {entities : rename_i v' ; subst v' simpa [Partial.Value.WellFormed] using ih x h₅ (.value v) hx · simp only [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + intro pv hpv + replace ⟨x, hx, hx'⟩ := List.mapM_ok_implies_all_from_ok hx pv hpv + exact ih x hx _ hx' /-- If partial-evaluating an `Expr.set` produces `ok` with a concrete diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Unary.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Unary.lean index 6c69f2fcc..30fa04b5d 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Unary.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Unary.lean @@ -46,18 +46,20 @@ theorem on_concrete_eqv_concrete_eval {x₁ : Expr} {request : Spec.Request} {en case ok v₁ => rfl /-- - Inductive argument that if partial-evaluating an `Expr.unaryApp` - produces `ok` with some value, that value is well-formed - - This theorem does not actually require that x₁ is WellFormed + Inductive argument that if partial-evaluating an `Expr.unaryApp` on + well-formed arguments produces `ok` with some value, that is a well-formed + value as well -/ -theorem partial_eval_wf {x₁ : Expr} {op : UnaryOp} {request : Partial.Request} {entities : Partial.Entities} : +theorem partial_eval_wf {x₁ : Expr} {op : UnaryOp} {request : Partial.Request} {entities : Partial.Entities} + (ih₁ : EvaluatesToWellFormed x₁ request entities) : EvaluatesToWellFormed (Expr.unaryApp op x₁) request entities := by unfold EvaluatesToWellFormed Partial.evaluate intro pval cases hx₁ : Partial.evaluate x₁ request entities <;> simp [hx₁] - case ok pval₁ => exact EvaluateUnaryApp.evaluateUnaryApp_wf + case ok pval₁ => + apply EvaluateUnaryApp.evaluateUnaryApp_wf + exact ih₁ pval₁ hx₁ /-- If partial-evaluating an `Expr.unaryApp` produces `ok` with a concrete @@ -107,7 +109,7 @@ theorem subst_preserves_evaluation_to_value {x₁ : Expr} {op : UnaryOp} {req re The proof of `subst_preserves_evaluation_to_value` for this request/entities/subsmap is passed in as an argument, because this file can't - import `Thm/Partial/Evaluation.lean` to access it. + import `Thm/Partial/Evaluation/Evaluate.lean` to access it. See #372. -/ theorem subst_preserves_errors {x₁ : Expr} {op : UnaryOp} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Var.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Var.lean index 62e4bbe00..bb11a816a 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Var.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Var.lean @@ -20,6 +20,7 @@ import Cedar.Thm.Data.Control import Cedar.Thm.Data.LT import Cedar.Thm.Data.List import Cedar.Thm.Data.Map +import Cedar.Thm.Partial.Evaluation.EvaluateValue import Cedar.Thm.Partial.Evaluation.Props import Cedar.Thm.Partial.Subst import Cedar.Thm.Partial.WellFormed @@ -34,66 +35,41 @@ open Cedar.Spec (Attr Error Expr Prim Var) `Partial.evaluateVar` on concrete arguments gives the same output as `Spec.evaluate` on those arguments -/ -theorem evaluateVar_on_concrete_eqv_concrete_eval (v : Var) (request : Spec.Request) (entities : Spec.Entities) - (wf : request.context.WellFormed) : - Partial.evaluateVar v request = (Spec.evaluate (Expr.var v) request entities).map Partial.Value.value +theorem evaluateVar_on_concrete_eqv_concrete_eval (v : Var) (request : Spec.Request) (entities : Spec.Entities) : + Partial.evaluateVar v request entities = (Spec.evaluate (Expr.var v) request entities).map Partial.Value.value := by unfold Partial.evaluateVar Spec.evaluate cases v <;> simp only [Spec.Request.asPartialRequest, Except.map] case context => - split - case h_1 m h₁ => - simp only [Except.ok.injEq, Partial.Value.value.injEq, Spec.Value.record.injEq] - rw [← Map.eq_iff_kvs_equiv (wf₁ := Map.mapMOnValues_some_wf (Map.mapOnValues_wf.mp wf) h₁) (wf₂ := wf)] - simp only [List.Equiv, List.subset_def] - constructor - case left => - intro (k, v) h₂ - rw [Map.mapOnValues_eq_make_map _ wf] at h₁ - unfold Map.toList at h₁ - replace ⟨pv, h₁, h₃⟩ := Map.mapMOnValues_some_implies_all_from_some h₁ (k, v) h₂ - replace h₁ := Map.make_mem_list_mem h₁ - cases pv <;> simp only [Option.some.injEq] at h₃ - case value v => - subst v - rw [List.mem_map] at h₁ - replace ⟨(k', v'), h₁, h₃⟩ := h₁ - simp only [Prod.mk.injEq, Partial.Value.value.injEq] at h₃ - replace ⟨h₃, h₃'⟩ := h₃ - subst k' v' - exact h₁ - case right => - intro (k, v) h₂ - have ⟨v', h₃, h₄⟩ := Map.mapMOnValues_some_implies_all_some h₁ (k, v) (Map.in_kvs_in_mapOnValues h₂) - simp only [Option.some.injEq] at h₄ - subst h₄ - simp [h₃] - case h_2 h₁ => - exfalso - replace ⟨v, h₁, h₂⟩ := Map.mapMOnValues_none_iff_exists_none.mp h₁ - cases v <;> simp only at h₂ - case residual r => - rw [Map.mapOnValues_eq_make_map _ wf] at h₁ - replace h₁ := Map.mem_values_make h₁ - simp [List.mem_map] at h₁ + simp only [Map.mapMOnValues_mapOnValues, EvaluateValue.eval_spec_value] + rw [Map.mapMOnValues_ok (f := Partial.Value.value)] + simp only [Except.bind_ok, Map.mapMOnValues_mapOnValues] + rw [Map.mapMOnValues_some] + simp only [Except.ok.injEq, Partial.Value.value.injEq, Spec.Value.record.injEq] + exact Map.mapOnValues_id /-- Inductive argument that, for an `Expr.var` with concrete request/entities, partial evaluation and concrete evaluation give the same output -/ -theorem on_concrete_eqv_concrete_eval (v : Var) (request : Spec.Request) (entities : Spec.Entities) - (wf : request.context.WellFormed) : +theorem on_concrete_eqv_concrete_eval (v : Var) (request : Spec.Request) (entities : Spec.Entities) : PartialEvalEquivConcreteEval (Expr.var v) request entities := by unfold PartialEvalEquivConcreteEval Partial.evaluate - exact evaluateVar_on_concrete_eqv_concrete_eval v request entities wf + exact evaluateVar_on_concrete_eqv_concrete_eval v request entities /-- if `Partial.evaluateVar` returns `ok` with some value, it is a well-formed value + + This takes the proof of `EvaluateValue.evalValue_wf` as an argument, + because this file can't import `Thm/Partial/Evaluation/EvaluateValue` to get + it (that would be a circular import). See #372. -/ -theorem evaluateVar_wf {v : Var} {request : Partial.Request} - (wf_r : request.WellFormed) : - ∀ pval, Partial.evaluateVar v request = .ok pval → pval.WellFormed +theorem evaluateVar_wf {v : Var} {request : Partial.Request} {entities : Partial.Entities} + (wf_r : request.WellFormed) + (wf_e : entities.WellFormed) + (h_evwf : ∀ {pv pv'}, pv.WellFormed → entities.WellFormed → Partial.evaluateValue pv entities = .ok pv' → pv'.WellFormed) : + ∀ pval, Partial.evaluateVar v request entities = .ok pval → pval.WellFormed := by unfold Partial.evaluateVar cases v <;> simp @@ -107,27 +83,48 @@ theorem evaluateVar_wf {v : Var} {request : Partial.Request} cases request.resource <;> simp [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed, Spec.Value.WellFormed, Prim.WellFormed] case context => - split <;> simp [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed, Spec.Value.WellFormed] - · rename_i m h₁ - apply And.intro (Map.mapMOnValues_some_wf wf_r.left h₁) - intro (k, v) h₂ - replace wf_r := wf_r.right (.value v) - simp [Partial.Value.WellFormed] at wf_r - apply wf_r ; clear wf_r - replace ⟨pval, h₁, h₃⟩ := Map.mapMOnValues_some_implies_all_from_some h₁ (k, v) h₂ - cases pval <;> simp at h₃ ; subst v ; rename_i v - exact Map.in_list_in_values h₁ + cases h₁ : request.context.mapMOnValues (Partial.evaluateValue · entities) + <;> simp only [Except.bind_ok, Except.bind_err, false_implies, implies_true] + case ok context' => + split <;> simp [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed, Spec.Value.WellFormed] + · rename_i m h₂ + apply And.intro (Map.mapMOnValues_some_wf (Map.mapMOnValues_ok_wf wf_r.left h₁) h₂) + intro (k, v) h₃ + have ⟨pval, h₄, h₅⟩ := Map.mapMOnValues_some_implies_all_from_some h₂ (k, v) h₃ + have ⟨pval', h₆, h₇⟩ := Map.mapMOnValues_ok_implies_all_from_ok h₁ (k, pval) h₄ + split at h₅ <;> simp only [Option.some.injEq] at h₅ ; subst v ; rename_i v + simp only at * + cases pval' + case value v' => + simp [Partial.evaluateValue] at h₇ ; subst v' + replace wf_r := wf_r.right (.value v) + simp only [Partial.Value.WellFormed] at wf_r + exact wf_r (Map.in_list_in_values h₆) + case residual r' => + suffices (Partial.Value.value v).WellFormed by simpa [Partial.Value.WellFormed] using this + apply h_evwf (pv := .residual r') (pv' := .value v) _ wf_e h₇ + · exact wf_r.right (.residual r') (Map.in_list_in_values h₆) + · intro (k, pv') hpv' + unfold Partial.Request.WellFormed at wf_r + split at wf_r ; rename_i context ; simp only at * + replace ⟨pv, hpv, h₁⟩ := Map.mapMOnValues_ok_implies_all_from_ok h₁ (k, pv') hpv' + apply h_evwf _ wf_e h₁ + exact wf_r.right pv (Map.in_list_in_values hpv) /-- If partial-evaluating a `Var` expression returns `ok` with some value, it is a well-formed value + + `h_evwf`: see notes on `evaluateVar_wf` -/ theorem partial_eval_wf {v : Var} {request : Partial.Request} {entities : Partial.Entities} - (wf_r : request.WellFormed) : + (wf_r : request.WellFormed) + (wf_e : entities.WellFormed) + (h_evwf : ∀ {pv pv'}, pv.WellFormed → entities.WellFormed → Partial.evaluateValue pv entities = .ok pv' → pv'.WellFormed) : EvaluatesToWellFormed (Expr.var v) request entities := by unfold EvaluatesToWellFormed Partial.evaluate - exact evaluateVar_wf wf_r + exact evaluateVar_wf wf_r wf_e h_evwf /-- Lemma: If `context` has only concrete values before substitution, then it has @@ -197,12 +194,12 @@ theorem subst_preserves_evaluate_req_context_to_value {req req' : Partial.Reques If `Partial.evaluateVar` returns a concrete value, then it returns the same value after any substitution of unknowns -/ -theorem subst_preserves_evaluateVar_to_value {var : Var} {req req' : Partial.Request} {v : Spec.Value} {subsmap : Subsmap} +theorem subst_preserves_evaluateVar_to_value {var : Var} {req req' : Partial.Request} {entities : Partial.Entities} {v : Spec.Value} {subsmap : Subsmap} (wf_r : req.WellFormed) (wf_s : subsmap.WellFormed) : req.subst subsmap = some req' → - Partial.evaluateVar var req = .ok (.value v) → - Partial.evaluateVar var req' = .ok (.value v) + Partial.evaluateVar var req entities = .ok (.value v) → + Partial.evaluateVar var req' (entities.subst subsmap) = .ok (.value v) := by unfold Partial.evaluateVar intro h_req h₁ @@ -224,23 +221,29 @@ theorem subst_preserves_evaluateVar_to_value {var : Var} {req req' : Partial.Req simp [Subst.req_subst_preserves_known_resource h₂ h_req] case context => simp only - split at h₁ <;> simp only [Except.ok.injEq, Partial.Value.value.injEq] at h₁ ; subst h₁ - rename_i m h₁ - -- `m` is the `Spec.Value`-valued version of `req.context` (which we know has only concrete values from h₁) - split <;> simp only [Except.ok.injEq, Partial.Value.value.injEq, Spec.Value.record.injEq] - · rename_i m' h₂ - -- `m'` is the `Spec.Value`-valued version of `req'.context` (which we know has only concrete values from h₂) - replace h₁ := subst_preserves_evaluate_req_context_to_value wf_r wf_s h_req h₁ - suffices some m = some m' by simpa using this.symm - rw [← h₁, ← h₂] - rfl - · rename_i h₂ - replace ⟨pval, h₂, h₃⟩ := Map.mapMOnValues_none_iff_exists_none.mp h₂ - cases pval <;> simp only at h₃ - case residual r => - replace ⟨k, h₂⟩ := Map.in_values_exists_key h₂ - have ⟨v, h₄⟩ := subst_preserves_all_concrete wf_r wf_s h_req h₁ h₂ - simp at h₄ + cases h₂ : req.context.mapMOnValues (Partial.evaluateValue · entities) + <;> simp only [h₂, Except.bind_ok, Except.bind_err] at h₁ + case ok context' => + split at h₁ <;> simp only [Except.ok.injEq, Partial.Value.value.injEq] at h₁ ; subst h₁ + rename_i m h₁ + -- `m` is the `Spec.Value`-valued version of `context'` (which we know has only concrete values from h₁) + sorry + /- + split <;> simp only [Except.ok.injEq, Partial.Value.value.injEq, Spec.Value.record.injEq] + · rename_i m' h₂ + -- `m'` is the `Spec.Value`-valued version of `req'.context` (which we know has only concrete values from h₂) + replace h₁ := subst_preserves_evaluate_req_context_to_value wf_r wf_s h_req h₁ + suffices some m = some m' by simpa using this.symm + rw [← h₁, ← h₂] + rfl + · rename_i h₂ + replace ⟨pval, h₂, h₃⟩ := Map.mapMOnValues_none_iff_exists_none.mp h₂ + cases pval <;> simp only at h₃ + case residual r => + replace ⟨k, h₂⟩ := Map.in_values_exists_key h₂ + have ⟨v, h₄⟩ := subst_preserves_all_concrete wf_r wf_s h_req h₁ h₂ + simp at h₄ + -/ /-- If partial-evaluation of a `Var` returns a concrete value, then it returns the @@ -256,26 +259,47 @@ theorem subst_preserves_evaluation_to_value (var : Var) (req req' : Partial.Requ exact subst_preserves_evaluateVar_to_value wf_r wf_s h_req /-- - If `Partial.evaluateVar` returns an error, then it returns the same error - after any substitution of unknowns + If `Partial.evaluateVar` returns an error, then it also returns an error (not + necessarily the same error) after any substitution of unknowns -/ -theorem subst_preserves_evaluateVar_to_error {var : Var} {req req' : Partial.Request} {e : Error} {subsmap : Subsmap} : +theorem subst_preserves_evaluateVar_to_error {var : Var} {req req' : Partial.Request} {entities : Partial.Entities} {e : Error} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : req.subst subsmap = some req' → - Partial.evaluateVar var req = .error e → Partial.evaluateVar var req' = .error e + Partial.evaluateVar var req entities = .error e → + ∃ e', Partial.evaluateVar var req' (entities.subst subsmap) = .error e' := by - cases var <;> simp only [Partial.evaluateVar, imp_self, implies_true] - case context => split <;> split <;> simp + cases var <;> simp only [Partial.evaluateVar, exists_false, imp_self, implies_true] + case context => + intro h_req + cases h₁ : req.context.mapMOnValues (Partial.evaluateValue · entities) <;> simp + case ok => split <;> simp + case error e₂ => + intro _ ; subst e₂ + replace ⟨pv, hpv, h₁⟩ := Map.mapMOnValues_error_implies_exists_error h₁ + have ⟨e₂, h₂⟩ := EvaluateValue.subst_preserves_errors (wf_r.right pv hpv) wf_e wf_s h₁ + have hpv' : (pv.subst subsmap) ∈ req'.context.values := by + simp [Partial.Request.subst] at h_req + replace ⟨p, _, a, _, r, _, hc⟩ := h_req ; clear h_req ; subst req' + simp [Map.values_mapOnValues] + exists pv + have ⟨e₃, h₃⟩ := Map.element_error_implies_mapMOnValues_error hpv' h₂ (f := (Partial.evaluateValue · (entities.subst subsmap))) + simp [h₃] /-- - If partial-evaluation of a `Var` returns an error, then it returns the same - error after any sustitution of unknowns + If partial-evaluation of a `Var` returns an error, then it also returns an + error (not necessarily the same error) after any sustitution of unknowns -/ -theorem subst_preserves_errors {var : Var} {req req' : Partial.Request} {e : Error} {subsmap : Subsmap} : +theorem subst_preserves_errors {var : Var} {req req' : Partial.Request} {e : Error} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : req.subst subsmap = some req' → Partial.evaluate (Expr.var var) req entities = .error e → - Partial.evaluate (Expr.var var) req' (entities.subst subsmap) = .error e + ∃ e', Partial.evaluate (Expr.var var) req' (entities.subst subsmap) = .error e' := by simp only [Partial.evaluate] - exact subst_preserves_evaluateVar_to_error + exact subst_preserves_evaluateVar_to_error wf_r wf_e wf_s end Cedar.Thm.Partial.Evaluation.Evaluate.Var diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateBinaryApp.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateBinaryApp.lean index faeeba254..c975aa6e2 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateBinaryApp.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateBinaryApp.lean @@ -20,8 +20,8 @@ import Cedar.Thm.Data.Control import Cedar.Thm.Data.Map import Cedar.Thm.Data.Set import Cedar.Thm.Partial.Evaluation.Props -import Cedar.Thm.Partial.WellFormed import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed /-! Theorems about `Partial.evaluateBinaryApp` -/ @@ -165,10 +165,12 @@ theorem evaluateBinaryApp_wf {pval₁ pval₂ : Partial.Value} {op : BinaryOp} { split · rename_i v₁ v₂ h₁ simp at h₁ ; replace ⟨h₁, h₁'⟩ := h₁ ; subst h₁ h₁' - simp only [Partial.Value.WellFormed] at wf₁ wf₂ + simp [Partial.Value.WellFormed] at wf₁ wf₂ exact partialApply₂_wf wf₁ wf₂ - · intro pval h₁ ; simp only [Except.ok.injEq] at h₁ ; subst h₁ - simp only [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + · intro pval h₁ ; simp at h₁ ; subst h₁ ; rename_i h₁ + simp [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + simp only [Prod.mk.injEq] at h₁ ; replace ⟨h₁, h₁'⟩ := h₁ ; subst h₁ h₁' + exact And.intro wf₁ wf₂ /-- If `Partial.evaluateBinaryApp` produces `ok` with a concrete value, then so diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateCall.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateCall.lean index 904200417..90fc2e3ef 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateCall.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateCall.lean @@ -19,10 +19,10 @@ import Cedar.Spec.Evaluator import Cedar.Thm.Data.Control import Cedar.Thm.Data.List import Cedar.Thm.Data.Set -import Cedar.Thm.Partial.Evaluation.Props import Cedar.Thm.Partial.Evaluation.Evaluate.Set -import Cedar.Thm.Partial.WellFormed +import Cedar.Thm.Partial.Evaluation.Props import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed /-! Theorems about `Partial.evaluateCall` -/ @@ -82,6 +82,7 @@ theorem evaluateCall_wf {pvals : List Partial.Value} {xfn : ExtFun} cases pval <;> simp at wf h₂ case value v' => subst v' ; exact wf · simp only [Except.ok.injEq] at h₁ ; subst h₁ ; simp only + exact wf /-- If `Partial.evaluateCall` produces `ok` with a concrete value, then all of the @@ -103,7 +104,7 @@ theorem returns_concrete_then_args_concrete {args : List Partial.Value} {xfn : E cases arg' <;> simp only [Except.ok.injEq] at h₁ h₄ /-- - something akin to `Partial.Evaluation.EvaluateValue.eval_spec_value`, lifted to lists of `Partial.Value` + something akin to `EvaluateValue.eval_spec_value`, lifted to lists of `Partial.Value` -/ theorem mapM_eval_spec_value {pvals : List Partial.Value} (entities : Partial.Entities) : (pvals.mapM λ pval => match pval with | .value v => some v | .residual _ => none) = some vs → diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateGetAttr.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateGetAttr.lean index c0c22e036..7a7f16843 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateGetAttr.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateGetAttr.lean @@ -20,9 +20,11 @@ import Cedar.Thm.Data.Control import Cedar.Thm.Data.LT import Cedar.Thm.Data.Map import Cedar.Thm.Data.Set +import Cedar.Thm.Partial.Evaluation.EvaluatePartialGetAttr import Cedar.Thm.Partial.Evaluation.Props -import Cedar.Thm.Partial.WellFormed +import Cedar.Thm.Partial.Evaluation.ReevaluatePartialGetAttr import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed namespace Cedar.Thm.Partial.Evaluation.EvaluateGetAttr @@ -30,35 +32,6 @@ open Cedar.Data open Cedar.Partial (Subsmap Unknown) open Cedar.Spec (Attr EntityUID Error Expr Prim Result) -/-- - `Partial.attrsOf` on concrete arguments is the same as `Spec.attrsOf` on those - arguments --/ -theorem attrsOf_on_concrete_eqv_concrete {v : Spec.Value} {entities : Spec.Entities} : - Partial.attrsOf v (Partial.Entities.attrs entities) = (Spec.attrsOf v (Spec.Entities.attrs entities)).map λ m => m.mapOnValues Partial.Value.value -:= by - unfold Partial.attrsOf Spec.attrsOf Except.map - cases v <;> simp only - case prim p => - cases p <;> simp only - case entityUID uid => - unfold Partial.Entities.attrs Spec.Entities.attrs Spec.Entities.asPartialEntities - cases h₁ : entities.findOrErr uid Error.entityDoesNotExist - <;> simp only [h₁, Map.findOrErr_mapOnValues, Except.map, Spec.EntityData.asPartialEntityData, - Except.bind_ok, Except.bind_err] - -/-- - `Partial.getAttr` on concrete arguments is the same as `Spec.getAttr` on those - arguments --/ -theorem getAttr_on_concrete_eqv_concrete {v : Spec.Value} {entities : Spec.Entities} {attr : Attr} : - Partial.getAttr v attr entities = (Spec.getAttr v attr entities).map Partial.Value.value -:= by - unfold Partial.getAttr Spec.getAttr - simp only [attrsOf_on_concrete_eqv_concrete, Except.map] - cases Spec.attrsOf v entities.attrs <;> simp only [Except.bind_err, Except.bind_ok] - case ok m => simp only [Map.findOrErr_mapOnValues, Except.map] - /-- `Partial.evaluateGetAttr` on concrete arguments is the same as `Spec.getAttr` on those arguments @@ -68,76 +41,7 @@ theorem on_concrete_eqv_concrete {v : Spec.Value} {a : Attr} {entities : Spec.En := by simp only [Partial.evaluateGetAttr, getAttr_on_concrete_eqv_concrete, pure, Except.pure, Except.map] cases Spec.getAttr v a entities <;> simp only [Except.bind_ok, Except.bind_err] - -/-- - if `entities.attrs uid` is `ok` with some attrs, those attrs are a - well-formed `Map`, and all the values in those attrs are well-formed --/ -theorem partialEntities_attrs_wf {entities : Partial.Entities} {uid : EntityUID} {attrs: Map String Partial.Value} - (wf_e : entities.WellFormed) : - entities.attrs uid = .ok attrs → - attrs.WellFormed ∧ ∀ v ∈ attrs.values, v.WellFormed -:= by - unfold Partial.Entities.attrs - intro h₁ - cases h₂ : entities.es.findOrErr uid Error.entityDoesNotExist - <;> simp only [h₂, Except.bind_err, Except.bind_ok, Except.ok.injEq] at h₁ - case ok attrs => - subst h₁ - unfold Partial.Entities.WellFormed Partial.EntityData.WellFormed at wf_e - have ⟨wf_m, wf_edata⟩ := wf_e ; clear wf_e - constructor - · apply (wf_edata _ _).left - simp only [← Map.findOrErr_ok_iff_in_values (v := attrs) (e := Error.entityDoesNotExist) wf_m] - exists uid - · intro pval h₃ - replace h₂ := Map.findOrErr_ok_implies_in_values h₂ - exact (wf_edata attrs h₂).right.right pval h₃ - -/-- - if `Partial.attrsOf` returns `ok` with some attrs, those attrs are a - well-formed `Map`, and all the values in those attrs are well-formed --/ -theorem attrsOf_wf {entities : Partial.Entities} {v : Spec.Value} {attrs : Map String Partial.Value} - (wf₁ : v.WellFormed) - (wf_e : entities.WellFormed) : - Partial.attrsOf v entities.attrs = .ok attrs → - attrs.WellFormed ∧ ∀ v ∈ attrs.values, v.WellFormed -:= by - unfold Partial.attrsOf - cases v <;> try simp only [false_implies, Except.ok.injEq] - case prim p => - cases p <;> simp only [false_implies] - case entityUID uid => exact partialEntities_attrs_wf wf_e - case record m => - intro h₁ ; subst h₁ - unfold Spec.Value.WellFormed at wf₁ - replace ⟨wf₁, wf_vs⟩ := wf₁ - apply And.intro (Map.mapOnValues_wf.mp wf₁) - intro pval h₁ - have ⟨k, h₁'⟩ := Map.in_values_exists_key h₁ - rw [Map.values_mapOnValues] at h₁ - replace ⟨v, _, h₃⟩ := List.mem_map.mp h₁ - subst h₃ - simp [Partial.Value.WellFormed] - apply wf_vs (k, v) - exact Map.in_mapOnValues_in_kvs wf₁ h₁' (by simp) - -/-- - if `Partial.getAttr` on a well-formed value and well-formed entities returns - `ok` with some value, that is a well-formed value as well --/ -theorem getAttr_wf {v₁ : Spec.Value} {attr : Attr} {entities : Partial.Entities} - (wf₁ : v₁.WellFormed) - (wf_e : entities.WellFormed) : - ∀ v, Partial.getAttr v₁ attr entities = .ok v → v.WellFormed -:= by - unfold Partial.getAttr - cases h₁ : Partial.attrsOf v₁ entities.attrs <;> simp - case ok attrs => - have ⟨_, wf_vs⟩ := attrsOf_wf wf₁ wf_e h₁ - intro pval h₂ - exact wf_vs pval (Map.findOrErr_ok_implies_in_values h₂) + case ok v' => simp only [Partial.evaluateValue] /-- if `Partial.evaluateGetAttr` on a well-formed value and well-formed entities @@ -145,125 +49,147 @@ theorem getAttr_wf {v₁ : Spec.Value} {attr : Attr} {entities : Partial.Entitie -/ theorem evaluateGetAttr_wf {pval₁ : Partial.Value} {attr : Attr} {entities : Partial.Entities} (wf₁ : pval₁.WellFormed) - (wf_e : entities.WellFormed) : + (wf_e : entities.WellFormed) + (ih₂ : ∀ {pval pval' : Partial.Value}, pval.WellFormed → Partial.evaluateValue pval entities = .ok pval' → pval'.WellFormed) : ∀ pval, Partial.evaluateGetAttr pval₁ attr entities = .ok pval → pval.WellFormed := by unfold Partial.evaluateGetAttr cases pval₁ <;> simp only [Except.bind_ok] + <;> simp only [Partial.Value.WellFormed] at wf₁ case residual r₁ => - intro pval h_pval - simp only [Except.ok.injEq] at h_pval - subst pval - simp only [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + simp [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed, wf₁] case value v₁ => - simp [Partial.Value.WellFormed] at wf₁ - exact getAttr_wf wf₁ wf_e - -/-- - If `Partial.getAttr` returns a concrete value, then it returns the same value - after any substitution of unknowns in `entities` --/ -theorem getAttr_subst_preserves_evaluation_to_value {v₁ : Spec.Value} {attr : Attr} {entities : Partial.Entities} {subsmap : Subsmap} - (wf_e : entities.WellFormed) - (wf_s : subsmap.WellFormed) : - Partial.getAttr v₁ attr entities = .ok (.value v) → - Partial.getAttr v₁ attr (entities.subst subsmap) = .ok (.value v) -:= by - unfold Partial.getAttr - unfold Partial.attrsOf - cases v₁ - case prim p₁ => - cases p₁ <;> simp only [Except.bind_err, imp_self] - case entityUID uid₁ => - cases h₁ : entities.attrs uid₁ - <;> simp only [Except.bind_ok, Except.bind_err, false_implies] - case ok attrs => - intro h₂ - replace h₂ := Map.findOrErr_ok_implies_in_kvs h₂ - unfold Map.toList at h₂ - have ⟨attrs', h₃, h₄⟩ := Subst.entities_subst_preserves_concrete_attrs subsmap h₁ h₂ - simp only [h₃, Except.bind_ok] - apply (Map.findOrErr_ok_iff_in_kvs _).mpr h₄ - have wf' := Subst.entities_subst_preserves_wf wf_e wf_s - exact (partialEntities_attrs_wf wf' h₃).left - case set | record => simp - case ext x => cases x <;> simp + intro pval + cases h₁ : Partial.getAttr v₁ attr entities <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok v₁' => exact ih₂ (pval := v₁') (pval' := pval) (getAttr_wf wf₁ wf_e _ h₁) /-- If `Partial.evaluateGetAttr` returns a concrete value, then it returns the same value after any substitution of unknowns in `entities` + + The inductive hypothesis `ih` says that the theorem holds for `evaluateValue` + on all values in `entities` -/ theorem subst_preserves_evaluation_to_value {pval₁ : Partial.Value} {attr : Attr} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_pv : pval₁.WellFormed) (wf_e : entities.WellFormed) - (wf_s : subsmap.WellFormed) : + (wf_s : subsmap.WellFormed) + (ih : ∀ v v' pv, + v.WellFormed → + Partial.getAttr v attr entities = .ok pv → + Partial.evaluateValue pv entities = .ok (.value v') → + Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) = .ok (.value v')) : Partial.evaluateGetAttr pval₁ attr entities = .ok (.value v) → Partial.evaluateGetAttr pval₁ attr (entities.subst subsmap) = .ok (.value v) := by unfold Partial.evaluateGetAttr - cases pval₁ <;> simp only [Except.bind_ok] + cases pval₁ <;> simp only [Except.ok.injEq, imp_self] case value v₁ => exact match h₁ : Partial.getAttr v₁ attr entities with | .error _ => by simp only [Except.bind_err, false_implies] - | .ok (.residual r₁) => by simp only [Except.ok.injEq, false_implies] + | .ok (.residual r₁) => by + simp only [Partial.Value.WellFormed] at wf_pv + simp only [Except.bind_ok] + intro h₂ + specialize ih v₁ v (.residual r₁) wf_pv h₁ h₂ + have h₄ := ReevaluateGetAttr.reeval_eqv_substituting_first_partialGetAttr v₁ attr wf_pv wf_e wf_s + simp [ih, h₁] at h₄ + exact h₄.symm | .ok (.value v₁') => by - simp only [Except.bind_ok, getAttr_subst_preserves_evaluation_to_value wf_e wf_s h₁] + simp only [Partial.Value.WellFormed] at wf_pv + simp only [Except.bind_ok, getAttr_subst_preserves_evaluation_to_value wf_pv wf_e wf_s h₁] simp only [Partial.evaluateValue, Except.ok.injEq, Partial.Value.value.injEq, imp_self] - case residual r₁ => simp only [Except.ok.injEq, imp_self] - -/-- - If `Partial.getAttr` returns an error, then it also returns an error (not - necessarily the same error) after any substitution of unknowns in `entities` --/ -theorem getAttr_subst_preserves_errors {v₁ : Spec.Value} {attr : Attr} {entities : Partial.Entities} {subsmap : Subsmap} - (wf_e : entities.WellFormed) - (wf_s : subsmap.WellFormed) : - Partial.getAttr v₁ attr entities = .error e → - ∃ e', Partial.getAttr v₁ attr (entities.subst subsmap) = .error e' -:= by - simp only [Partial.getAttr, Partial.attrsOf] - exact match v₁ with - | .prim (.entityUID uid) => match ha : entities.attrs uid with - | .ok attrs => match ha' : (entities.subst subsmap).attrs uid with - | .ok attrs' => match e with - | .attrDoesNotExist => by - simp only [ha, ha', Except.bind_ok] - have wf_attrs := EvaluateGetAttr.partialEntities_attrs_wf wf_e ha - have wf_attrs' := EvaluateGetAttr.partialEntities_attrs_wf (Subst.entities_subst_preserves_wf wf_e wf_s) ha' - intro h₁ - exists .attrDoesNotExist - simp only [Map.findOrErr_err_iff_not_in_keys (wf_attrs.left)] at h₁ - simp only [Map.findOrErr_err_iff_not_in_keys (wf_attrs'.left)] - replace ⟨attrs'', ha'', h₁⟩ := Subst.entities_subst_preserves_absent_attrs subsmap ha h₁ - simp [ha'] at ha'' ; subst attrs'' - exact h₁ - | .entityDoesNotExist | .typeError | .arithBoundsError | .extensionError => by - simp only [ha, ha', Except.bind_ok] - intro h₁ ; rcases Map.findOrErr_returns attrs attr Error.attrDoesNotExist with h₂ | h₂ - · simp only [h₁, exists_const] at h₂ - · simp only [h₁, Except.error.injEq] at h₂ - | .error e => by - simp only [ha, ha', Except.bind_ok, Except.bind_err, Except.error.injEq, exists_eq', - implies_true] - | .error e' => by - simp only [ha, Except.bind_err, Except.error.injEq] - intro h ; subst e' - simp [(Subst.entities_subst_preserves_error_attrs subsmap).mp ha] - | .record attrs => by - simp only [Except.bind_ok] - intro _ ; exists e - | .prim (.bool _) | .prim (.int _) | .prim (.string _) => by simp - | .set _ | .ext _ => by simp /-- If `Partial.evaluateGetAttr` returns an error, then it also returns an error (not necessarily the same error) after any substitution of unknowns in `entities` + + The inductive hypothesis `ih` says that the theorem holds for `evaluateValue` + on all values in `entities` -/ -theorem subst_preserves_errors {pval₁ : Partial.Value} {attr : Attr} {entities : Partial.Entities} (subsmap : Subsmap) +theorem subst_preserves_errors {pval₁ : Partial.Value} {attr : Attr} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_v : pval₁.WellFormed) (wf_e : entities.WellFormed) - (wf_s : subsmap.WellFormed) : + (wf_s : subsmap.WellFormed) + (ih : ∀ v pv, + v.WellFormed → + Partial.getAttr v attr entities = .ok pv → + Partial.evaluateValue pv entities = .error e → + ∃ e', Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) = .error e') : Partial.evaluateGetAttr pval₁ attr entities = .error e → ∃ e', Partial.evaluateGetAttr pval₁ attr (entities.subst subsmap) = .error e' := by - simp only [Partial.evaluateGetAttr] - cases pval₁ <;> simp only [exists_false, imp_self] - case value v₁ => exact getAttr_subst_preserves_errors wf_e wf_s + cases pval₁ <;> simp [Partial.evaluateGetAttr] + case value v₁ => + simp only [Partial.Value.WellFormed] at wf_v + cases h₁ : Partial.getAttr v₁ attr entities <;> simp + case error e' => + intro _ ; subst e' + have ⟨e', h₂⟩ := getAttr_subst_preserves_errors wf_v wf_e wf_s h₁ + simp [h₂] + case ok pv₁ => + intro h₂ + replace ⟨e', ih⟩ := ih v₁ pv₁ wf_v h₁ h₂ + cases pv₁ <;> simp [Partial.evaluateValue] at * + case residual r₁ => + cases h₃ : Partial.getAttr v₁ attr (entities.subst subsmap) <;> simp + case ok pv₁ => + apply getAttr_subst_preserves_twostep_errors wf_v wf_e wf_s _ h₁ h₂ h₃ + intro _ ; simp [Partial.Value.subst] at ih ; simp [ih] + +/-- + Variant of `subst_preserves_errors` where `Partial.evaluateValue` is applied + to the argument first + + The inductive hypothesis `ih` says that `subst_preserves_errors` holds for + `evaluateValue` on all values in `entities` + + This takes the proof of `EvaluateValue.evalValue_wf` as an argument, because this + file can't directly import `Thm/Partial/Evaluation/EvaluateValue.lean` to get it. + See #372. + + This takes the proof of + `EvaluateValue.evalResidual_subst_preserves_evaluation_to_value` as an + argument, because this file can't directly import + `Thm/Partial/Evaluation/EvaluateValue.lean` to get it. + See #372. +-/ +theorem subst_and_reduce_preserves_errors {pval₁ : Partial.Value} {attr : Attr} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_v : pval₁.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) + (ih : ∀ v pv, + v.WellFormed → + Partial.getAttr v attr entities = .ok pv → + Partial.evaluateValue pv entities = .error e → + ∃ e', Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) = .error e') + (h_pevwf : ∀ pv es pv', pv.WellFormed → es.WellFormed → Partial.evaluateValue pv es = .ok pv' → pv'.WellFormed) + (h_erspetv : ∀ r es v, r.WellFormed → + Partial.evaluateResidual r es = .ok (.value v) → + Partial.evaluateValue (r.subst subsmap) (es.subst subsmap) = .ok (.value v) ) : + Partial.evaluateValue pval₁ entities = .ok pval₂ → + Partial.evaluateGetAttr pval₂ attr entities = .error e → + Partial.evaluateValue (pval₁.subst subsmap) (entities.subst subsmap) = .ok pval₃ → + ∃ e', Partial.evaluateGetAttr pval₃ attr (entities.subst subsmap) = .error e' +:= by + cases pval₁ <;> simp [Partial.evaluateValue] + case value v₁ => + intro _ ; subst pval₂ + simp [Subst.subst_concrete_value, Partial.evaluateValue] + intro h₁ h₂ ; subst pval₃ + exact subst_preserves_errors wf_v wf_e wf_s ih h₁ + case residual r₁ => + simp only [Partial.Value.WellFormed] at wf_v + specialize h_erspetv r₁ entities ; simp only [wf_v] at h_erspetv + intro h₁ h₂ h₃ + have wf₃ : pval₃.WellFormed := by + apply h_pevwf ((Partial.Value.residual r₁).subst subsmap) (entities.subst subsmap) pval₃ _ _ h₃ + · apply Subst.val_subst_preserves_wf _ wf_s + simp [Partial.Value.WellFormed, wf_v] + · exact Subst.entities_subst_preserves_wf wf_e wf_s + apply subst_preserves_errors wf₃ wf_e wf_s ih + cases pval₂ <;> simp [Partial.Value.subst] at * + case value v₂ => + simp [h_erspetv v₂ h₁] at h₃ ; subst pval₃ + exact h₂ + case residual r₂ => simp [Partial.evaluateGetAttr] at h₂ diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateHasAttr.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateHasAttr.lean index 43b2ad2aa..5ea930e4e 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateHasAttr.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateHasAttr.lean @@ -20,8 +20,8 @@ import Cedar.Thm.Data.Control import Cedar.Thm.Data.Map import Cedar.Thm.Data.Set import Cedar.Thm.Partial.Evaluation.Props -import Cedar.Thm.Partial.WellFormed import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed namespace Cedar.Thm.Partial.Evaluation.EvaluateHasAttr @@ -35,7 +35,7 @@ open Cedar.Spec (Attr Error Expr Prim Result) Note that the "concrete arguments" provided to `Partial.attrsOf` and `Spec.attrsOf` in this theorem are different from the "concrete arguments" - provided in the theorem of the same name in Partial/Evaluation/GetAttr.lean + provided in the theorem of the same name in Partial/Evaluation/EvaluateGetAttr.lean -/ theorem attrsOf_on_concrete_eqv_concrete {v : Spec.Value} {entities : Spec.Entities} : Partial.attrsOf v (λ uid => .ok (entities.asPartialEntities.attrsOrEmpty uid)) = @@ -94,22 +94,24 @@ theorem partialHasAttr_wf {v₁ : Spec.Value} {attr : Attr} {entities : Partial. case ok m => simp [Spec.Value.WellFormed, Prim.WellFormed] /-- - if `Partial.evaluateHasAttr` returns `ok` with some value, that is a - well-formed value + if `Partial.evaluateHasAttr` on a well-formed value returns `ok` with some + value, that is also a well-formed value -/ -theorem evaluateHasAttr_wf {pval₁ : Partial.Value} {attr : Attr} {entities : Partial.Entities} : +theorem evaluateHasAttr_wf {pval₁ : Partial.Value} {attr : Attr} {entities : Partial.Entities} + (wf : pval₁.WellFormed) : ∀ pval, Partial.evaluateHasAttr pval₁ attr entities = .ok pval → pval.WellFormed := by unfold Partial.evaluateHasAttr - split - · rename_i v - cases h₁ : Partial.hasAttr v attr entities + cases pval₁ <;> simp only [Except.ok.injEq, forall_eq'] + case value v₁ => + cases h₁ : Partial.hasAttr v₁ attr entities case error e => simp only [Except.bind_err, false_implies, implies_true] case ok v => simp only [Partial.Value.WellFormed, Except.bind_ok, Except.ok.injEq, forall_eq'] exact partialHasAttr_wf v h₁ - · intro pval h₁ ; simp only [Except.ok.injEq] at h₁ ; subst h₁ + case residual r₁ => simp only [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + simpa [Partial.Value.WellFormed] using wf /-- If `Partial.evaluateHasAttr` produces `ok` with a concrete value, then so @@ -186,3 +188,52 @@ theorem subst_preserves_errors {pval₁ : Partial.Value} {attr : Attr} {entities have ⟨e', h₂⟩ := hasAttr_subst_preserves_errors subsmap h₁ exists e' simp only [h₂, Except.bind_err] + +/-- + Variant of `subst_preserves_errors` where `Partial.evaluateValue` is applied + to the argument first + + This takes the proof of `EvaluateValue.evalValue_wf` as an argument, because this + file can't directly import `Thm/Partial/Evaluation/EvaluateValue.lean` to get it. + See #372. + + This takes the proof of + `EvaluateValue.evalResidual_subst_preserves_evaluation_to_value` as an + argument, because this file can't directly import + `Thm/Partial/Evaluation/EvaluateValue.lean` to get it. + See #372. +-/ +theorem subst_and_reduce_preserves_errors {pval₁ : Partial.Value} {attr : Attr} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_v : pval₁.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) + (h_pevwf : ∀ pv es pv', pv.WellFormed → es.WellFormed → Partial.evaluateValue pv es = .ok pv' → pv'.WellFormed) + (h_erspetv : ∀ r es v, r.WellFormed → + Partial.evaluateResidual r es = .ok (.value v) → + Partial.evaluateValue (r.subst subsmap) (es.subst subsmap) = .ok (.value v) ) : + Partial.evaluateValue pval₁ entities = .ok pval₂ → + Partial.evaluateHasAttr pval₂ attr entities = .error e → + Partial.evaluateValue (pval₁.subst subsmap) (entities.subst subsmap) = .ok pval₃ → + ∃ e', Partial.evaluateHasAttr pval₃ attr (entities.subst subsmap) = .error e' +:= by + cases pval₁ <;> simp [Partial.evaluateValue] + case value v₁ => + intro _ ; subst pval₂ + simp [Subst.subst_concrete_value, Partial.evaluateValue] + intro h₁ h₂ ; subst pval₃ + exact subst_preserves_errors subsmap h₁ + case residual r₁ => + simp only [Partial.Value.WellFormed] at wf_v + specialize h_erspetv r₁ entities ; simp only [wf_v] at h_erspetv + intro h₁ h₂ h₃ + have wf₃ : pval₃.WellFormed := by + apply h_pevwf ((Partial.Value.residual r₁).subst subsmap) (entities.subst subsmap) pval₃ _ _ h₃ + · apply Subst.val_subst_preserves_wf _ wf_s + simp [Partial.Value.WellFormed, wf_v] + · exact Subst.entities_subst_preserves_wf wf_e wf_s + apply subst_preserves_errors + cases pval₂ <;> simp [Partial.Value.subst] at * + case a.value v₂ => + simp [h_erspetv v₂ h₁] at h₃ ; subst pval₃ + exact h₂ + case a.residual r₂ => simp [Partial.evaluateHasAttr] at h₂ diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluatePartialGetAttr.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluatePartialGetAttr.lean new file mode 100644 index 000000000..a745d5446 --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluatePartialGetAttr.lean @@ -0,0 +1,307 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Spec.Evaluator +import Cedar.Thm.Data.Control +import Cedar.Thm.Data.LT +import Cedar.Thm.Data.Map +import Cedar.Thm.Data.Set +import Cedar.Thm.Partial.Evaluation.Props +import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed + +/-! Theorems about `Partial.getAttr` and `Partial.attrsOf` -/ + +namespace Cedar.Thm.Partial.Evaluation.EvaluateGetAttr + +open Cedar.Data +open Cedar.Partial (Subsmap Unknown) +open Cedar.Spec (Attr EntityUID Error Expr Prim Result) + +/-- + `Partial.attrsOf` on concrete arguments is the same as `Spec.attrsOf` on those + arguments +-/ +theorem attrsOf_on_concrete_eqv_concrete {v : Spec.Value} {entities : Spec.Entities} : + Partial.attrsOf v (Partial.Entities.attrs entities) = (Spec.attrsOf v (Spec.Entities.attrs entities)).map λ m => m.mapOnValues Partial.Value.value +:= by + unfold Partial.attrsOf Spec.attrsOf Except.map + cases v <;> simp only + case prim p => + cases p <;> simp only + case entityUID uid => + unfold Partial.Entities.attrs Spec.Entities.attrs Spec.Entities.asPartialEntities + cases h₁ : entities.findOrErr uid Error.entityDoesNotExist + <;> simp only [h₁, Map.findOrErr_mapOnValues, Except.map, Spec.EntityData.asPartialEntityData, + Except.bind_ok, Except.bind_err] + +/-- + `Partial.getAttr` on concrete arguments is the same as `Spec.getAttr` on those + arguments +-/ +theorem getAttr_on_concrete_eqv_concrete {v : Spec.Value} {entities : Spec.Entities} {attr : Attr} : + Partial.getAttr v attr entities = (Spec.getAttr v attr entities).map Partial.Value.value +:= by + unfold Partial.getAttr Spec.getAttr + simp only [attrsOf_on_concrete_eqv_concrete, Except.map] + cases Spec.attrsOf v entities.attrs <;> simp only [Except.bind_err, Except.bind_ok] + case ok m => simp only [Map.findOrErr_mapOnValues, Except.map] + +/-- + if `entities.attrs uid` is `ok` with some attrs, those attrs are a + well-formed `Map`, and all the values in those attrs are well-formed +-/ +theorem partialEntities_attrs_wf {entities : Partial.Entities} {uid : EntityUID} {attrs: Map String Partial.Value} + (wf_e : entities.WellFormed) : + entities.attrs uid = .ok attrs → + attrs.WellFormed ∧ ∀ v ∈ attrs.values, v.WellFormed +:= by + unfold Partial.Entities.attrs + intro h₁ + cases h₂ : entities.es.findOrErr uid Error.entityDoesNotExist + <;> simp only [h₂, Except.bind_err, Except.bind_ok, Except.ok.injEq] at h₁ + case ok attrs => + subst h₁ + unfold Partial.Entities.WellFormed Partial.EntityData.WellFormed at wf_e + have ⟨wf_m, wf_edata⟩ := wf_e ; clear wf_e + constructor + · apply (wf_edata _ _).left + simp only [← Map.findOrErr_ok_iff_in_values (v := attrs) (e := Error.entityDoesNotExist) wf_m] + exists uid + · intro pval h₃ + replace h₂ := Map.findOrErr_ok_implies_in_values h₂ + exact (wf_edata attrs h₂).right.right pval h₃ + +/-- + if `Partial.attrsOf` returns `ok` with some attrs, those attrs are a + well-formed `Map`, and all the values in those attrs are well-formed +-/ +theorem attrsOf_wf {entities : Partial.Entities} {v : Spec.Value} {attrs : Map String Partial.Value} + (wf₁ : v.WellFormed) + (wf_e : entities.WellFormed) : + Partial.attrsOf v entities.attrs = .ok attrs → + attrs.WellFormed ∧ ∀ v ∈ attrs.values, v.WellFormed +:= by + unfold Partial.attrsOf + cases v <;> try simp only [false_implies, Except.ok.injEq] + case prim p => + cases p <;> simp only [false_implies] + case entityUID uid => exact partialEntities_attrs_wf wf_e + case record m => + intro h₁ ; subst h₁ + unfold Spec.Value.WellFormed at wf₁ + replace ⟨wf₁, wf_vs⟩ := wf₁ + apply And.intro (Map.mapOnValues_wf.mp wf₁) + intro pval h₁ + have ⟨k, h₁'⟩ := Map.in_values_exists_key h₁ + rw [Map.values_mapOnValues] at h₁ + replace ⟨v, _, h₃⟩ := List.mem_map.mp h₁ + subst h₃ + simp [Partial.Value.WellFormed] + apply wf_vs (k, v) + exact Map.in_mapOnValues_in_kvs wf₁ h₁' (by simp) + +/-- + if `Partial.getAttr` on a well-formed value and well-formed entities returns + `ok` with some value, that is a well-formed value as well +-/ +theorem getAttr_wf {v₁ : Spec.Value} {attr : Attr} {entities : Partial.Entities} + (wf₁ : v₁.WellFormed) + (wf_e : entities.WellFormed) : + ∀ v, Partial.getAttr v₁ attr entities = .ok v → v.WellFormed +:= by + unfold Partial.getAttr + cases h₁ : Partial.attrsOf v₁ entities.attrs <;> simp + case ok attrs => + have ⟨_, wf_vs⟩ := attrsOf_wf wf₁ wf_e h₁ + intro pval h₂ + exact wf_vs pval (Map.findOrErr_ok_implies_in_values h₂) + +/-- + If `Partial.getAttr` returns any partial value, then after any substitution of + unknowns in `entities`, it returns the same value with that substitution + applied +-/ +theorem getAttr_subst_preserves_attrs {v₁ : Spec.Value} {attr : Attr} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_v : v₁.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + Partial.getAttr v₁ attr entities = .ok pv → + Partial.getAttr v₁ attr (entities.subst subsmap) = .ok (pv.subst subsmap) +:= by + cases v₁ <;> simp [Partial.getAttr, Partial.attrsOf] + case prim p₁ => + cases p₁ <;> simp + case entityUID uid₁ => + cases h₁ : entities.attrs uid₁ <;> simp + case ok attrs => + intro h₂ + replace h₂ := Map.findOrErr_ok_implies_in_kvs h₂ + unfold Map.toList at h₂ + have ⟨attrs', h₃, h₄⟩ := Subst.entities_subst_preserves_attrs subsmap h₁ h₂ + simp only [h₃, Except.bind_ok] + apply (Map.findOrErr_ok_iff_in_kvs _).mpr h₄ + have wf' := Subst.entities_subst_preserves_wf wf_e wf_s + exact (partialEntities_attrs_wf wf' h₃).left + case record attrs => + simp only [Spec.Value.WellFormed] at wf_v + simp [Map.findOrErr_ok_iff_in_kvs (Map.mapOnValues_wf.mp wf_v.left)] + cases pv + case value v => simp [Subst.subst_concrete_value] + case residual r => + intro h₁ + replace h₁ := Map.in_mapOnValues_in_kvs' wf_v.left h₁ + simp at h₁ + +/-- + If `Partial.getAttr` returns a concrete value, then it returns the same value + after any substitution of unknowns in `entities` +-/ +theorem getAttr_subst_preserves_evaluation_to_value {v₁ : Spec.Value} {attr : Attr} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_v : v₁.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + Partial.getAttr v₁ attr entities = .ok (.value v) → + Partial.getAttr v₁ attr (entities.subst subsmap) = .ok (.value v) +:= by + intro h₁ + have h₂ := getAttr_subst_preserves_attrs wf_v wf_e wf_s h₁ + simpa [Subst.subst_concrete_value] using h₂ + +/-- + If `Partial.attrsOf` returns an error, then it also returns the same error + after any substitution of unknowns in `entities` +-/ +theorem attrsOf_subst_preserves_errors {v₁ : Spec.Value} {entities : Partial.Entities} {subsmap : Subsmap} : + Partial.attrsOf v₁ entities.attrs = .error e → + Partial.attrsOf v₁ (entities.subst subsmap).attrs = .error e +:= by + simp only [Partial.attrsOf] + exact match v₁ with + | .prim (.entityUID uid) => match ha : entities.attrs uid with + | .ok attrs => match ha' : (entities.subst subsmap).attrs uid with + | .ok attrs' => by simp only [ha, ha', imp_self] + | .error e' => by simp only [ha, ha', Except.error.injEq, false_implies] + | .error e' => by + simp only [ha, Except.error.injEq] + intro h ; subst e' + simp only [(Subst.entities_subst_preserves_error_attrs subsmap).mp ha] + | .record attrs => by simp only [imp_self] + | .prim (.bool _) | .prim (.int _) | .prim (.string _) | .set _ | .ext _ => by + simp only [Except.error.injEq, imp_self] + +/-- + If `Partial.getAttr` returns an error, then it also returns an error (not + necessarily the same error) after any substitution of unknowns in `entities` +-/ +theorem getAttr_subst_preserves_errors {v₁ : Spec.Value} {attr : Attr} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_v : v₁.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + Partial.getAttr v₁ attr entities = .error e → + ∃ e', Partial.getAttr v₁ attr (entities.subst subsmap) = .error e' +:= by + simp only [Partial.getAttr] + /- progress on refactoring this to use `attrsOf_subst_preserves_errors` + instead of unfolding `Partial.attrsOf` directly and essentially repeating that + proof + cases h₁ : Partial.attrsOf v₁ entities.attrs <;> simp + case error e' => intro _ ; subst e' ; simp [attrsOf_subst_preserves_errors h₁] + case ok attrs => + cases h₂ : Partial.attrsOf v₁ (entities.subst subsmap).attrs <;> simp + case ok attrs' => + exact match e with + | .attrDoesNotExist => by + have wf_attrs := attrsOf_wf wf_v wf_e h₁ + have wf_attrs' := attrsOf_wf wf_v (Subst.entities_subst_preserves_wf wf_e wf_s) h₂ + intro h₃ ; exists .attrDoesNotExist + simp only [Map.findOrErr_err_iff_not_in_keys (wf_attrs.left)] at h₃ + simp only [Map.findOrErr_err_iff_not_in_keys (wf_attrs'.left)] + | .entityDoesNotExist | .typeError | .arithBoundsError | .extensionError => by + intro h₃ ; rcases Map.findOrErr_returns attrs attr Error.attrDoesNotExist with h₄ | h₄ + · simp only [h₃, exists_const] at h₄ + · simp only [h₃, Except.error.injEq] at h₄ + -/ + simp only [Partial.attrsOf] + exact match v₁ with + | .prim (.entityUID uid) => match ha : entities.attrs uid with + | .ok attrs => match ha' : (entities.subst subsmap).attrs uid with + | .ok attrs' => match e with + | .attrDoesNotExist => by + simp only [ha, ha', Except.bind_ok] + have wf_attrs := EvaluateGetAttr.partialEntities_attrs_wf wf_e ha + have wf_attrs' := EvaluateGetAttr.partialEntities_attrs_wf (Subst.entities_subst_preserves_wf wf_e wf_s) ha' + intro h₁ + exists .attrDoesNotExist + simp only [Map.findOrErr_err_iff_not_in_keys (wf_attrs.left)] at h₁ + simp only [Map.findOrErr_err_iff_not_in_keys (wf_attrs'.left)] + replace ⟨attrs'', ha'', h₁⟩ := Subst.entities_subst_preserves_absent_attrs subsmap ha h₁ + simp [ha'] at ha'' ; subst attrs'' + exact h₁ + | .entityDoesNotExist | .typeError | .arithBoundsError | .extensionError => by + simp only [ha, ha', Except.bind_ok] + intro h₁ ; rcases Map.findOrErr_returns attrs attr Error.attrDoesNotExist with h₂ | h₂ + · simp only [h₁, exists_const] at h₂ + · simp only [h₁, Except.error.injEq] at h₂ + | .error e' => by + simp only [ha, ha', Except.bind_ok, Except.bind_err, Except.error.injEq, exists_eq', + implies_true] + | .error e' => by + simp only [ha, Except.bind_err, Except.error.injEq] + intro h ; subst e' + simp [(Subst.entities_subst_preserves_error_attrs subsmap).mp ha] + | .record attrs => by + simp only [Except.bind_ok] + intro _ ; exists e + | .prim (.bool _) | .prim (.int _) | .prim (.string _) => by simp + | .set _ | .ext _ => by simp + +/-- + If `Partial.getAttr` returns a residual that evaluates to an error, and after + any substitution of unknowns in `entities` it still returns any `.ok`, then + `Partial.evaluateValue` on the returned value produces an error (not + necessarily the same error) + + The inductive hypothesis `ih` says that `subst_preserves_errors` holds for `r` +-/ +theorem getAttr_subst_preserves_twostep_errors {v₁ : Spec.Value} {attr : Attr} {entities : Partial.Entities} {subsmap : Subsmap} {r : Partial.ResidualExpr} {e : Error} + (wf_v : v₁.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) + (ih : + Partial.evaluateResidual r entities = .error e → + ∃ e', Partial.evaluateValue (r.subst subsmap) (entities.subst subsmap) = .error e') : + Partial.getAttr v₁ attr entities = .ok (.residual r) → + Partial.evaluateResidual r entities = .error e → + Partial.getAttr v₁ attr (entities.subst subsmap) = .ok pv' → + ∃ e', Partial.evaluateValue pv' (entities.subst subsmap) = .error e' +:= by + simp only [Partial.getAttr] + cases h₁ : Partial.attrsOf v₁ entities.attrs <;> simp + case ok attrs => + have wf_attrs : attrs.WellFormed := (attrsOf_wf wf_v wf_e h₁).left + rw [Map.findOrErr_ok_iff_in_kvs wf_attrs] + cases h₂ : Partial.attrsOf v₁ (entities.subst subsmap).attrs <;> simp + case ok attrs' => + have wf_attrs' : attrs'.WellFormed := (attrsOf_wf wf_v (Subst.entities_subst_preserves_wf wf_e wf_s) h₂).left + rw [Map.findOrErr_ok_iff_in_kvs wf_attrs'] + intro h₃ + have ⟨attrs'', hattrs'', h₄⟩ := Subst.attrsOf_subst_preserves_attrs subsmap wf_v h₁ h₃ + simp only [h₂, Except.ok.injEq] at hattrs'' ; subst attrs'' + intro h₅ h₆ + have h₇ := Map.key_maps_to_one_value attr _ _ attrs' wf_attrs' h₄ h₆ ; subst pv' ; clear h₆ + simp only [Partial.Value.subst, ih h₅] diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateUnaryApp.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateUnaryApp.lean index ada1a71a0..32fe2ad97 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateUnaryApp.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateUnaryApp.lean @@ -18,8 +18,8 @@ import Cedar.Partial.Evaluator import Cedar.Spec.Evaluator import Cedar.Thm.Data.Control import Cedar.Thm.Partial.Evaluation.Props -import Cedar.Thm.Partial.WellFormed import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed /-! Theorems about `Partial.evaluateUnaryApp` -/ @@ -60,15 +60,17 @@ theorem specApply₁_wf {v : Spec.Value} {op : UnaryOp} : /-- if `Partial.evaluateUnaryApp` on a well-formed value returns `ok` with some value, that is a well-formed value as well - - This theorem does not actually require that the input value is WellFormed -/ -theorem evaluateUnaryApp_wf {pval : Partial.Value} {op : UnaryOp} : +theorem evaluateUnaryApp_wf {pval : Partial.Value} {op : UnaryOp} + (wf : pval.WellFormed) : Partial.evaluateUnaryApp op pval = .ok pval' → pval'.WellFormed := by unfold Partial.evaluateUnaryApp cases pval <;> simp only [Except.ok.injEq] - case residual r => intro h₁ ; subst h₁ ; simp [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + case residual r => + intro h₁ ; subst h₁ + simp only [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] at * + exact wf case value v => cases h₁ : Spec.apply₁ op v case error e => simp only [Except.bind_err, false_implies] @@ -111,3 +113,47 @@ theorem subst_preserves_errors {pval₁ : Partial.Value} {op : UnaryOp} {subsmap := by cases pval₁ <;> simp [Partial.evaluateUnaryApp] case value v₁ => simp [Subst.subst_concrete_value, do_error] + +/-- + If `Partial.evaluateUnaryApp` returns an error, but reducing its arg succeeds, + then it returns the same error on the reduced arg +-/ +theorem reducing_arg_preserves_errors {pval₁ : Partial.Value} {op : UnaryOp} {entities : Partial.Entities} : + Partial.evaluateUnaryApp op pval₁ = .error e → + Partial.evaluateValue pval₁ entities = .ok pval' → + Partial.evaluateUnaryApp op pval' = .error e +:= by + cases pval₁ <;> simp [Partial.evaluateUnaryApp] + case value v₁ => + simp [Partial.evaluateValue] + intro h₁ _ ; subst pval' + simp [h₁] + +/-- + If reducing the arg then `Partial.evaluateUnaryApp` returns a concrete value, + then any subst before that process shouldn't make a difference. + + This is like `subst_preserves_evaluation_to_value` but with a reduce operation + in front of the `Partial.evaluateUnaryApp` in both cases + + Takes an inductive hypothesis `ih` which says that + `subst_preserves_evaluation_to_value` holds for `pv₁` +-/ +theorem subst_preserves_reduce_evaluation_to_value {pv₁ pv₂ : Partial.Value} {op : UnaryOp} {entities : Partial.Entities} (subsmap : Subsmap) + (ih : ∀ v, Partial.evaluateValue pv₁ entities = .ok (.value v) → Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) = .ok (.value v)) : + Partial.evaluateValue pv₁ entities = .ok pv₂ → + Partial.evaluateUnaryApp op pv₂ = .ok (.value v) → + ∃ pv₃, + Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) = .ok pv₃ ∧ + Partial.evaluateUnaryApp op pv₃ = .ok (.value v) +:= by + cases pv₁ <;> simp [Partial.evaluateUnaryApp] + case value v₁ => + simp [Subst.subst_concrete_value, Partial.evaluateValue] + intro _ ; subst pv₂ ; simp only [imp_self] + case residual r₁ => + cases pv₂ <;> simp only [Except.ok.injEq, false_implies, implies_true] + case value v₂ => + intro h₁ h₂ + specialize ih v₂ h₁ + exists (.value v₂) diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateValue.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateValue.lean new file mode 100644 index 000000000..020892065 --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateValue.lean @@ -0,0 +1,690 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Partial.Value +import Cedar.Spec.Evaluator +import Cedar.Thm.Data.Control +import Cedar.Thm.Data.List +import Cedar.Thm.Data.Set +import Cedar.Thm.Partial.Evaluation.EvaluateBinaryApp +import Cedar.Thm.Partial.Evaluation.EvaluateCall +import Cedar.Thm.Partial.Evaluation.EvaluateGetAttr +import Cedar.Thm.Partial.Evaluation.EvaluateHasAttr +import Cedar.Thm.Partial.Evaluation.EvaluateUnaryApp +import Cedar.Thm.Partial.Evaluation.Evaluate.Record +import Cedar.Thm.Partial.Evaluation.ReevaluateUnaryApp +import Cedar.Thm.Partial.WellFormed + +/-! This file contains theorems about `Partial.evaluateValue` (and `Partial.evaluateResidual`). -/ + +namespace Cedar.Thm.Partial.Evaluation.EvaluateValue + +open Cedar.Data +open Cedar.Partial (Subsmap) +open Cedar.Spec (Attr BinaryOp Error ExtFun Prim UnaryOp) + +/-- + `Partial.evaluateValue` of a Spec.Value always succeeds and returns the value +-/ +theorem eval_spec_value (v : Spec.Value) (entities : Partial.Entities) : + Partial.evaluateValue v entities = .ok (.value v) +:= by + simp [Partial.evaluateValue] + +theorem sizeOf_lt_ite (pv₁ pv₂ pv₃ : Partial.Value) : + sizeOf pv₁ < sizeOf (Partial.ResidualExpr.ite pv₁ pv₂ pv₃) ∧ + sizeOf pv₂ < sizeOf (Partial.ResidualExpr.ite pv₁ pv₂ pv₃) ∧ + sizeOf pv₃ < sizeOf (Partial.ResidualExpr.ite pv₁ pv₂ pv₃) +:= by + sorry + +theorem sizeOf_lt_and (pv₁ pv₂ : Partial.Value) : + sizeOf pv₁ < sizeOf (Partial.ResidualExpr.and pv₁ pv₂) ∧ + sizeOf pv₂ < sizeOf (Partial.ResidualExpr.and pv₁ pv₂) +:= by + sorry + +theorem sizeOf_lt_or (pv₁ pv₂ : Partial.Value) : + sizeOf pv₁ < sizeOf (Partial.ResidualExpr.or pv₁ pv₂) ∧ + sizeOf pv₂ < sizeOf (Partial.ResidualExpr.or pv₁ pv₂) +:= by + sorry + +theorem sizeOf_lt_unaryApp (op : UnaryOp) (pv₁ : Partial.Value) : + sizeOf pv₁ < sizeOf (Partial.ResidualExpr.unaryApp op pv₁) +:= by + sorry + +theorem sizeOf_lt_binaryApp (op : BinaryOp) (pv₁ pv₂ : Partial.Value) : + sizeOf pv₁ < sizeOf (Partial.ResidualExpr.binaryApp op pv₁ pv₂) ∧ + sizeOf pv₂ < sizeOf (Partial.ResidualExpr.binaryApp op pv₁ pv₂) +:= by + sorry + +theorem sizeOf_lt_getAttr (pv₁ : Partial.Value) (attr : Attr) : + sizeOf pv₁ < sizeOf (Partial.ResidualExpr.getAttr pv₁ attr) +:= by + sorry + +theorem sizeOf_lt_hasAttr (pv₁ : Partial.Value) (attr : Attr) : + sizeOf pv₁ < sizeOf (Partial.ResidualExpr.hasAttr pv₁ attr) +:= by + sorry + +theorem sizeOf_lt_set (pvs : List Partial.Value) : + sizeOf pvs < sizeOf (Partial.ResidualExpr.set pvs) +:= by + sorry + +theorem sizeOf_lt_record (pvs : List (Attr × Partial.Value)) : + sizeOf pvs < sizeOf (Partial.ResidualExpr.record pvs) +:= by + sorry + +theorem sizeOf_lt_call (xfn : ExtFun) (pvs : List Partial.Value) : + sizeOf pvs < sizeOf (Partial.ResidualExpr.call xfn pvs) +:= by + sorry + +mutual + +/-- + `Partial.evaluateResidual` always returns well-formed results +-/ +theorem evalResidual_wf {r : Partial.ResidualExpr} {entities : Partial.Entities} + (wf_r : r.WellFormed) + (wf_e : entities.WellFormed) : + Partial.evaluateResidual r entities = .ok pv → pv.WellFormed +:= by + cases r <;> simp only [Partial.evaluateResidual, Except.ok.injEq, Bool.not_eq_true'] + <;> simp only [Partial.ResidualExpr.WellFormed] at wf_r + case unknown u => intro _ ; subst pv ; simp [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + case and pv₁ pv₂ | or pv₁ pv₂ => + have := sizeOf_lt_and pv₁ pv₂ + have := sizeOf_lt_or pv₁ pv₂ + cases hpv₁ : Partial.evaluateValue pv₁ entities + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok pv₁' => + cases pv₁' <;> simp only [Except.ok.injEq] + case residual r₁' => + intro _ ; subst pv ; simp [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + apply And.intro _ wf_r.right + have h₁ := evalValue_wf wf_r.left wf_e hpv₁ + simpa [Partial.Value.WellFormed] using h₁ + case value v₁' => + cases v₁'.asBool <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok b₁' => + cases b₁' <;> simp only [reduceIte, Except.ok.injEq, Bool.true_eq_false] + all_goals try { + -- this resolves the `false` case for `and`, and the `true` case for `or` + intro _ ; subst pv ; simp [Partial.Value.WellFormed, Spec.Value.WellFormed, Prim.WellFormed] + } + cases hpv₂ : Partial.evaluateValue pv₂ entities + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok pv₂' => + cases pv₂' <;> simp only [Except.ok.injEq] + case residual r₂' => + intro _ ; subst pv ; simp [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed, Spec.Value.WellFormed, Prim.WellFormed] + have h₁ := evalValue_wf wf_r.right wf_e hpv₂ + simpa [Partial.Value.WellFormed] using h₁ + case value v₂' => + cases v₂'.asBool + case error e => simp only [Except.bind_err, false_implies] + case ok b₂' => + simp only [Except.bind_ok, Except.ok.injEq] + intro _ ; subst pv ; simp [Partial.Value.WellFormed, Spec.Value.WellFormed, Prim.WellFormed] + case ite pv₁ pv₂ pv₃ => + have := sizeOf_lt_ite pv₁ pv₂ pv₃ + cases hpv₁ : Partial.evaluateValue pv₁ entities + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok pv₁' => + cases pv₁' <;> simp only [Except.ok.injEq] + case residual r₁' => + intro _ ; subst pv ; simp only [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + simp only [wf_r, and_self, and_true] + have h₁ := evalValue_wf wf_r.left wf_e hpv₁ + simpa [Partial.Value.WellFormed] using h₁ + case value v₁' => + cases v₁'.asBool <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok b₁' => + cases b₁' <;> simp only [Bool.false_eq_true, reduceIte] + case true => exact evalValue_wf wf_r.right.left wf_e + case false => exact evalValue_wf wf_r.right.right wf_e + case unaryApp op pv₁ => + have := sizeOf_lt_unaryApp op pv₁ + cases hpv₁' : Partial.evaluateValue pv₁ entities + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok pv₁' => + apply EvaluateUnaryApp.evaluateUnaryApp_wf + exact evalValue_wf wf_r wf_e hpv₁' + case binaryApp op pv₁ pv₂ => + have := sizeOf_lt_binaryApp op pv₁ pv₂ + cases hpv₁' : Partial.evaluateValue pv₁ entities + <;> cases hpv₂' : Partial.evaluateValue pv₂ entities + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok.ok => + apply EvaluateBinaryApp.evaluateBinaryApp_wf + · exact evalValue_wf wf_r.left wf_e hpv₁' + · exact evalValue_wf wf_r.right wf_e hpv₂' + case getAttr pv₁ attr => + have := sizeOf_lt_getAttr pv₁ attr + cases hpv₁' : Partial.evaluateValue pv₁ entities + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok pv₁' => + have wf₁' : pv₁'.WellFormed := evalValue_wf wf_r wf_e hpv₁' + apply EvaluateGetAttr.evaluateGetAttr_wf wf₁' wf_e _ pv + · intro pv pv' ; exact evalValue_wf (pv := pv) (pv' := pv') (wf_e := wf_e) + case hasAttr pv₁ attr => + have := sizeOf_lt_hasAttr pv₁ attr + cases hpv₁' : Partial.evaluateValue pv₁ entities + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok pv₁' => + have wf₁' : pv₁'.WellFormed := evalValue_wf wf_r wf_e hpv₁' + exact EvaluateHasAttr.evaluateHasAttr_wf wf₁' pv + case set pvs => + have := sizeOf_lt_set pvs + rw [List.mapM₁_eq_mapM (Partial.evaluateValue · entities)] + cases hpvs' : pvs.mapM (Partial.evaluateValue · entities) + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok pvs' => + split <;> rename_i h₁ <;> simp only [Except.ok.injEq] <;> intro _ <;> subst pv + · rename_i vs' + simp only [Partial.Value.WellFormed, Spec.Value.WellFormed] + apply And.intro (Set.make_wf vs') + intro v hv + replace hv := (Set.make_mem _ _).mpr hv + replace ⟨pv', hpv', h₁⟩ := List.mapM_some_implies_all_from_some h₁ v hv + split at h₁ <;> simp only [Option.some.injEq] at h₁ ; subst h₁ ; rename_i v' + replace ⟨pv, hpv, h₂⟩ := List.mapM_ok_implies_all_from_ok hpvs' v' hpv' + have := List.sizeOf_lt_of_mem hpv + have := evalValue_wf (wf_r pv hpv) wf_e h₂ + simpa [Partial.Value.WellFormed] using this + · simp only [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + intro pv' hpv' + replace ⟨pv, hpv, hpvs'⟩ := List.mapM_ok_implies_all_from_ok hpvs' pv' hpv' + have := List.sizeOf_lt_of_mem hpv + exact evalValue_wf (wf_r pv hpv) wf_e hpvs' + case record apvs => + have := sizeOf_lt_record apvs + rw [Evaluate.Record.mapM₂_eq_mapM_partial_bindAttr (Partial.evaluateValue · entities)] + cases hapvs : apvs.mapM λ kv => match kv with | (k, v) => Partial.bindAttr k (Partial.evaluateValue v entities) + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok apvs' => + split <;> simp only [Except.ok.injEq] <;> intro _ <;> subst pv + · rename_i avs havs + simp only [Partial.Value.WellFormed, Spec.Value.WellFormed] + apply And.intro (Map.make_wf avs) + intro (k, v) hkv + replace hkv := Map.make_mem_list_mem hkv + replace ⟨(k', pv'), hpv', havs⟩ := List.mapM_some_implies_all_from_some havs (k, v) hkv + split at havs <;> simp only [Option.some.injEq, Prod.mk.injEq] at havs + replace ⟨havs, havs'⟩ := havs ; subst k' v ; rename_i v' hpv' + simp only at hpv' ; subst hpv' + replace ⟨pv, hpv, hapvs⟩ := List.mapM_ok_implies_all_from_ok hapvs (k, v') hpv' + split at hapvs ; rename_i k' pv' + simp only [Partial.bindAttr, do_ok, Prod.mk.injEq, exists_eq_right_right] at hapvs + have := List.sizeOf_snd_lt_sizeOf_list hpv + have := evalValue_wf (wf_r (k', pv') hpv) wf_e hapvs.left + simpa [Partial.Value.WellFormed] using this + · simp only [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + intro (k', pv') hpv' + replace ⟨(k, pv), hpv, hapvs⟩ := List.mapM_ok_implies_all_from_ok hapvs (k', pv') hpv' + split at hapvs ; rename_i hapvs' + simp only [Prod.mk.injEq] at hapvs' ; replace ⟨hapvs', hapvs''⟩ := hapvs' ; subst hapvs' hapvs'' + simp only [Partial.bindAttr, do_ok, Prod.mk.injEq, exists_eq_right_right] at hapvs + have := List.sizeOf_snd_lt_sizeOf_list hpv + exact evalValue_wf (wf_r (k, pv) hpv) wf_e hapvs.left + case call xfn pvs => + have := sizeOf_lt_call xfn pvs + rw [List.mapM₁_eq_mapM (Partial.evaluateValue · entities)] + cases hpvs : pvs.mapM (Partial.evaluateValue · entities) + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok pvs' => + apply EvaluateCall.evaluateCall_wf + intro pv' hpv' + replace ⟨pv, hpv, hpvs⟩ := List.mapM_ok_implies_all_from_ok hpvs pv' hpv' + have := List.sizeOf_lt_of_mem hpv + exact evalValue_wf (wf_r pv hpv) wf_e hpvs +termination_by sizeOf r +decreasing_by + all_goals simp_wf + all_goals simp only at * + all_goals subst r + all_goals try omega + case _ => -- the second inductive call for getAttr + sorry + +/-- + `Partial.evaluateValue` always returns well-formed results +-/ +theorem evalValue_wf {pv : Partial.Value} {entities : Partial.Entities} + (wf_pv : pv.WellFormed) + (wf_e : entities.WellFormed) : + Partial.evaluateValue pv entities = .ok pv' → pv'.WellFormed +:= by + cases pv <;> simp only [Partial.evaluateValue, Except.ok.injEq] + case value v => intro _ ; subst pv' ; exact wf_pv + case residual r => + simp only [Partial.Value.WellFormed] at wf_pv + exact evalResidual_wf wf_pv wf_e +termination_by sizeOf pv + +end + +mutual + +/-- + If `Partial.evaluateResidual` returns a concrete value, then + `Partial.evaluateValue` returns the same value after any substitution of + unknowns +-/ +theorem evalResidual_subst_preserves_evaluation_to_value {r : Partial.ResidualExpr} {entities : Partial.Entities} {v : Spec.Value} {subsmap : Subsmap} + (wf : r.WellFormed) : + Partial.evaluateResidual r entities = .ok (.value v) → + Partial.evaluateValue (r.subst subsmap) (entities.subst subsmap) = .ok (.value v) +:= by + cases r <;> simp only [Partial.evaluateResidual, Partial.evaluateValue, Partial.ResidualExpr.subst, + Except.ok.injEq, false_implies, Bool.not_eq_true'] + <;> simp only [Partial.ResidualExpr.WellFormed] at wf + case and pv₁ pv₂ | or pv₁ pv₂ => + cases hpv₁ : Partial.evaluateValue pv₁ entities + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok pv₁' => + cases pv₁' <;> simp only [Except.ok.injEq, false_implies] + case value v₁' => + cases hv₁' : v₁'.asBool <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok b₁' => + cases b₁' <;> simp [subst_preserves_evaluation_to_value subsmap wf.left hpv₁, hv₁'] + all_goals { + cases hpv₂ : Partial.evaluateValue pv₂ entities <;> simp + case ok pv₂' => + cases pv₂' <;> simp + case value v₂' => + cases hv₂' : v₂'.asBool <;> simp + case ok b₂' => + intro _ ; subst v + simp [subst_preserves_evaluation_to_value subsmap wf.right hpv₂, hv₂'] + } + case ite pv₁ pv₂ pv₃ => + cases hpv₁ : Partial.evaluateValue pv₁ entities <;> simp + case ok pv₁' => + cases pv₁' <;> simp + case value v₁' => + cases hv₁' : v₁'.asBool <;> simp + case ok b₁' => + cases b₁' <;> simp [subst_preserves_evaluation_to_value subsmap wf.left hpv₁, hv₁'] + case true => + intro hpv₂ ; simp [subst_preserves_evaluation_to_value subsmap wf.right.left hpv₂] + case false => + intro hpv₃ ; simp [subst_preserves_evaluation_to_value subsmap wf.right.right hpv₃] + case unaryApp op pv₁ => + cases hpv₁ : Partial.evaluateValue pv₁ entities <;> simp + case ok pv₁' => + cases hpv₁' : Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) <;> simp + case error e => + intro h₁ + have h₂ := ReevaluateUnaryApp.reeval_eqv_substituting_first op pv₁ entities subsmap wf + simp [hpv₁'] at h₂ + split at h₂ <;> rename_i h₃ + <;> simp only [Prod.mk.injEq] at h₃ <;> replace ⟨h₃, h₃'⟩ := h₃ + · simp at h₃' ; subst h₃' ; rename_i e₁ + cases h₄ : Partial.evaluateUnaryApp op pv₁ + <;> simp [h₄] at h₃ + case error e₂ => + subst e₂ + simp [EvaluateUnaryApp.reducing_arg_preserves_errors h₄ hpv₁] at h₁ + case ok pv₁'' => + have ⟨pv, h₅⟩ := EvaluateUnaryApp.subst_preserves_reduce_evaluation_to_value subsmap (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf) hpv₁ h₁ + simp [h₅] at hpv₁' + · rename_i hₑ + subst h₃ h₃' + simp [h₂] at hₑ + case ok pv₁'' => + intro h₁ + have ⟨pv, h₂⟩ := EvaluateUnaryApp.subst_preserves_reduce_evaluation_to_value subsmap (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf) hpv₁ h₁ + simp [hpv₁'] at h₂ + simp [h₂] + case binaryApp op pv₁ pv₂ => sorry + case hasAttr pv₁ attr => sorry + case getAttr pv₁ attr => sorry + case set pvs => sorry + case record attrs => sorry + case call xfn pvs => sorry + +/-- + If `Partial.evaluateValue` returns a concrete value, then it returns the same + value after any substitution of unknowns +-/ +theorem subst_preserves_evaluation_to_value {pv : Partial.Value} {entities : Partial.Entities} {v : Spec.Value} (subsmap : Subsmap) + (wf : pv.WellFormed) : + Partial.evaluateValue pv entities = .ok (.value v) → + Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) = .ok (.value v) +:= by + cases pv <;> simp only [Partial.evaluateValue, Except.ok.injEq, Partial.Value.value.injEq] + case value v => + intro _ ; subst v + simp only [Subst.subst_concrete_value, eval_spec_value v] + case residual r => + simp only [Partial.Value.subst] + simp only [Partial.Value.WellFormed] at wf + exact evalResidual_subst_preserves_evaluation_to_value wf + +end + +mutual + +/-- + If `Partial.evaluateResidual` returns an error, then `Partial.evaluateValue` + returns an error (not necessarily the same error) after any substitution of + unknowns +-/ +theorem evalResidual_subst_preserves_errors {r : Partial.ResidualExpr} {entities : Partial.Entities} {e : Error} {subsmap : Subsmap} + (wf_r : r.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + Partial.evaluateResidual r entities = .error e → + ∃ e', Partial.evaluateValue (r.subst subsmap) (entities.subst subsmap) = .error e' +:= by + cases r + <;> simp only [Partial.evaluateResidual, Partial.ResidualExpr.subst, Partial.evaluateValue, + false_implies, Bool.not_eq_true'] + <;> simp only [Partial.ResidualExpr.WellFormed] at wf_r + case and pv₁ pv₂ | or pv₁ pv₂ => + cases hpv₁ : Partial.evaluateValue pv₁ entities + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq] + case error e₁ => + intro _ ; subst e₁ + have ⟨e₁', h₁⟩ := subst_preserves_errors wf_r.left wf_e wf_s hpv₁ + simp only [h₁, Except.bind_err, Except.error.injEq, exists_eq'] + case ok pv₁' => + cases pv₁' <;> simp only [false_implies] + case value v₁' => + simp only [subst_preserves_evaluation_to_value subsmap wf_r.left hpv₁, Except.bind_ok] + cases v₁'.asBool + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq, exists_eq', implies_true] + case ok b₁' => + cases b₁' + all_goals try { + -- this discharges the `false` case for `and`, and the `true` case for `or` + simp only [reduceIte, exists_false, imp_self] + } + all_goals { + simp only [Bool.true_eq_false, reduceIte] + cases hpv₂ : Partial.evaluateValue pv₂ entities + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq] + case error e₂ => + have ⟨e₂', h₁⟩ := subst_preserves_errors wf_r.right wf_e wf_s hpv₂ + simp only [h₁, Except.bind_err, Except.error.injEq, exists_eq', implies_true] + case ok pv₂' => + cases pv₂' <;> simp only [false_implies] + case value v₂' => + simp only [subst_preserves_evaluation_to_value subsmap wf_r.right hpv₂, Except.bind_ok] + cases v₂'.asBool + case error e₂' => intro _ ; exists e₂' + case ok b₂' => simp only [Except.bind_ok, exists_false, imp_self] + } + case ite pv₁ pv₂ pv₃ => + cases hpv₁ : Partial.evaluateValue pv₁ entities + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq] + case error e₁ => + intro _ ; subst e₁ + have ⟨e₁', h₁⟩ := subst_preserves_errors wf_r.left wf_e wf_s hpv₁ + simp only [h₁, Except.bind_err, Except.error.injEq, exists_eq'] + case ok pv₁' => + cases pv₁' <;> simp only [false_implies] + case value v₁' => + simp only [subst_preserves_evaluation_to_value subsmap wf_r.left hpv₁, Except.bind_ok] + cases v₁'.asBool + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq, exists_eq', implies_true] + case ok b₁' => + cases b₁' <;> simp only [Bool.false_eq_true, reduceIte] + case true => exact subst_preserves_errors wf_r.right.left wf_e wf_s + case false => exact subst_preserves_errors wf_r.right.right wf_e wf_s + case binaryApp op pv₁ pv₂ => + cases hpv₁ : Partial.evaluateValue pv₁ entities + <;> cases hpv₂ : Partial.evaluateValue pv₂ entities + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq] + case error.error e₁ e₂ | error.ok e₁ pv₂' => + have ⟨e', h₁⟩ := subst_preserves_errors wf_r.left wf_e wf_s hpv₁ + simp only [h₁, Except.bind_err, Except.error.injEq, exists_eq', implies_true] + case ok.error pv₁' e₂ => + intro _ ; subst e₂ + have ⟨e', h₁⟩ := subst_preserves_errors wf_r.right wf_e wf_s hpv₂ + simp only [h₁, Except.bind_err] + cases hpv₁' : Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq, exists_eq'] + case ok.ok pv₁' pv₂' => + cases hpv₁' : Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq, exists_eq', implies_true] + case ok pv₁'' => + cases hpv₂' : Partial.evaluateValue (pv₂.subst subsmap) (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq, exists_eq', implies_true] + case ok pv₂'' => + intro h₁ + have ⟨e', h₂⟩ := EvaluateBinaryApp.subst_preserves_errors subsmap h₁ + sorry + case unaryApp op pv₁ => + cases hpv₁ : Partial.evaluateValue pv₁ entities + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq] + case error e₁ => + intro _ ; subst e₁ + have ⟨e₁', h₁⟩ := subst_preserves_errors wf_r wf_e wf_s hpv₁ + simp only [h₁, Except.bind_err, Except.error.injEq, exists_eq'] + case ok pv₁' => + cases hpv₁' : Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq, exists_eq', implies_true] + case ok pv₁'' => + sorry + case getAttr pv₁ attr => + cases hpv₁ : Partial.evaluateValue pv₁ entities + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq] + case error e₁ => + intro _ ; subst e₁ + have ⟨e₁', h₁⟩ := subst_preserves_errors wf_r wf_e wf_s hpv₁ + simp only [h₁, Except.bind_err, Except.error.injEq, exists_eq'] + case ok pv₁' => + have wf_pv₁' : pv₁'.WellFormed := evalValue_wf wf_r wf_e hpv₁ + cases hpv₁' : Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq, exists_eq', implies_true] + case ok pv₁'' => + intro h₁ + apply EvaluateGetAttr.subst_and_reduce_preserves_errors wf_r wf_e wf_s _ _ _ hpv₁ h₁ hpv₁' + · intro v pv wf_v h₂ + apply subst_preserves_errors _ wf_e wf_s + exact EvaluateGetAttr.getAttr_wf wf_v wf_e _ h₂ + · intro _ _ _ + exact evalValue_wf + · intro _ _ _ + exact evalResidual_subst_preserves_evaluation_to_value + case hasAttr pv₁ attr => + cases hpv₁ : Partial.evaluateValue pv₁ entities + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq] + case error e₁ => + intro _ ; subst e₁ + have ⟨e₁', h₁⟩ := subst_preserves_errors wf_r wf_e wf_s hpv₁ + simp only [h₁, Except.bind_err, Except.error.injEq, exists_eq'] + case ok pv₁' => + cases hpv₁' : Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq, exists_eq', implies_true] + case ok pv₁'' => + intro h₁ + apply EvaluateHasAttr.subst_and_reduce_preserves_errors wf_r wf_e wf_s _ _ hpv₁ h₁ hpv₁' + · intro _ _ _ + exact evalValue_wf + · intro _ _ _ + exact evalResidual_subst_preserves_evaluation_to_value + case set pvs => + rw [ + List.mapM₁_eq_mapM (Partial.evaluateValue · entities), + List.mapM₁_eq_mapM (Partial.evaluateValue · (entities.subst subsmap)), + List.map₁_eq_map, + List.mapM_map, + ] + cases hpvs : pvs.mapM (Partial.evaluateValue · entities) + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq] + case ok pvs' => split <;> simp only [false_implies] + case error e' => + intro _ ; subst e' + replace ⟨pv, hpv, hpvs⟩ := List.mapM_error_implies_exists_error hpvs + have ⟨e', h₁⟩ := subst_preserves_errors (wf_r pv hpv) wf_e wf_s hpvs + have ⟨e'', h₂⟩ := List.element_error_implies_mapM_error (f := λ pv => Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap)) hpv h₁ + simp only [h₂, Except.bind_err, Except.error.injEq, exists_eq'] + case record apvs => + rw [ + List.map_attach₂_snd, + Evaluate.Record.mapM₂_eq_mapM_partial_bindAttr (Partial.evaluateValue · entities), + Evaluate.Record.mapM₂_eq_mapM_partial_bindAttr (Partial.evaluateValue · (entities.subst subsmap)), + List.mapM_map, + ] + cases hapvs : apvs.mapM λ apv => match apv with | (a, pv) => Partial.bindAttr a (Partial.evaluateValue pv entities) + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq] + case ok apvs' => split <;> simp only [false_implies] + case error e' => + intro _ ; subst e' + replace ⟨(a, pv), hpv, hapvs⟩ := List.mapM_error_implies_exists_error hapvs + split at hapvs ; rename_i a' pv' h ; simp only [Prod.mk.injEq] at h ; replace ⟨h, h'⟩ := h ; subst a' pv' + simp only [Partial.bindAttr, do_error] at hapvs + have ⟨e', h₁⟩ := subst_preserves_errors (wf_r (a, pv) hpv) wf_e wf_s hapvs + have ⟨e'', h₂⟩ := List.element_error_implies_mapM_error (f := λ (a, pv) => Partial.bindAttr a (Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap))) (e := e') hpv (by + simp only [Partial.bindAttr, h₁, Except.bind_err] + ) + simp only [h₂, Except.bind_err, Except.error.injEq, exists_eq'] + case call xfn pvs => + rw [ + List.mapM₁_eq_mapM (Partial.evaluateValue · entities), + List.mapM₁_eq_mapM (Partial.evaluateValue · (entities.subst subsmap)), + List.map₁_eq_map, + List.mapM_map, + ] + cases hpvs : pvs.mapM (Partial.evaluateValue · entities) + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq] + case ok pvs' => + cases hpvs' : pvs.mapM λ pv => Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq, exists_eq', implies_true] + case ok pvs'' => + -- unlike in the other cases, we don't currently have the proof of `evaluateCall_subst_preserves_errors` pulled out in Call.lean + sorry + case error e' => + intro _ ; subst e' + replace ⟨pv, hpv, hpvs⟩ := List.mapM_error_implies_exists_error hpvs + have ⟨e', h₁⟩ := subst_preserves_errors (wf_r pv hpv) wf_e wf_s hpvs + have ⟨e'', h₂⟩ := List.element_error_implies_mapM_error (f := λ pv => Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap)) hpv h₁ + simp only [h₂, Except.bind_err, Except.error.injEq, exists_eq'] +termination_by sizeOf r +decreasing_by all_goals sorry + +/-- + If `Partial.evaluateValue` returns an error, then it also returns an error + (not necessarily the same error) after any substitution of unknowns +-/ +theorem subst_preserves_errors {pv : Partial.Value} {entities : Partial.Entities} {e : Error} {subsmap : Subsmap} + (wf_pv : pv.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + Partial.evaluateValue pv entities = .error e → + ∃ e', Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) = .error e' +:= by + cases pv <;> simp only [Partial.evaluateValue, false_implies] + case residual r => + simp only [Partial.Value.subst] + simp only [Partial.Value.WellFormed] at wf_pv + exact evalResidual_subst_preserves_errors wf_pv wf_e wf_s +termination_by sizeOf pv + +end + +/-- + Reducing a value and then substituting it, produces the same result as + substituting it then reducing it +-/ +theorem reduce_commutes_subst {pv : Partial.Value} {entities : Partial.Entities} (subsmap : Subsmap) + (wf_v : pv.WellFormed) : + Partial.evaluateValue pv entities = .ok pv' → + Partial.evaluateValue (pv'.subst subsmap) (entities.subst subsmap) = + Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) +:= match pv with + | .value v => by + simp [eval_spec_value] + intro _ ; subst pv' ; rfl + | .residual (.unknown u) => by + simp [Partial.evaluateValue, Partial.evaluateResidual] + intro _ ; subst pv' ; rfl + | .residual (.and pv₁ pv₂) | .residual (.or pv₁ pv₂) => by + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual] + simp [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] at wf_v + exact match h₁ : Partial.evaluateValue pv₁ entities with + | .error _ => by simp + | .ok (.value v₁) => by + simp only [Except.bind_ok, subst_preserves_evaluation_to_value subsmap wf_v.left h₁] + exact match hv₁ : v₁.asBool with + | .error _ => by simp + | .ok b₁ => by + cases b₁ + all_goals try { + -- this dispatches the false case for and, and the true case for or + simp only [Except.bind_ok, Bool.true_eq_false, Bool.false_eq_true, reduceIte, Except.ok.injEq] + intro _ ; subst pv' + simp only [Subst.subst_concrete_value, eval_spec_value] + } + all_goals { + exact match h₂ : Partial.evaluateValue pv₂ entities with + | .error _ => by simp + | .ok (.value v₂) => by + simp only [Except.bind_ok, Bool.true_eq_false, Bool.false_eq_true, reduceIte, + subst_preserves_evaluation_to_value subsmap wf_v.right h₂] + simp only [do_ok] + intro ⟨b₂, h₃, h₄⟩ ; subst pv' + simp only [Subst.subst_concrete_value, eval_spec_value, h₃, Except.bind_ok] + | .ok (.residual r₂) => by + simp only [Except.bind_ok, Bool.true_eq_false, Bool.false_eq_true, reduceIte, Except.ok.injEq] + intro _ ; subst pv' + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual, Spec.Value.asBool] + have h₃ := reduce_commutes_subst subsmap wf_v.right h₂ + simp only [Partial.Value.subst] at h₃ + simp [h₃] + } + | .ok (.residual r₁) => by + simp only [Except.bind_ok, Except.ok.injEq] + intro _ ; subst pv' + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual] + have h₂ := reduce_commutes_subst subsmap wf_v.left h₁ + simp only [Partial.Value.subst] at h₂ + simp [h₂] + | .residual (.ite pv₁ pv₂ pv₃) => by + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual] + sorry + | .residual (.binaryApp op pv₁ pv₂) => by + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual] + sorry + | .residual (.unaryApp op pv₁) => by + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual] + sorry + | .residual (.hasAttr pv₁ attr) => by + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual] + sorry + | .residual (.getAttr pv₁ attr) => by + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual] + sorry + | .residual (.set pvs) => by + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual] + sorry + | .residual (.record attrs) => by + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual] + sorry + | .residual (.call xfn pvs) => by + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual] + sorry diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Props.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Props.lean index fd78155ad..d92835dfc 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Props.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Props.lean @@ -74,4 +74,19 @@ def IsAllConcrete (pvals : List Partial.Value) : Prop := def EvaluatesToWellFormed (expr : Expr) (request : Partial.Request) (entities : Partial.Entities) : Prop := ∀ pval, Partial.evaluate expr request entities = .ok pval → pval.WellFormed +/-- + Prop that re-evaluation with a substitution on the residual expression, is + equivalent to substituting first and then evaluating on the original + expression, up to the kind of error. (If both re-evaluation and subst-first + produce errors, we don't require it's the same error, just that they either + both produce errors or both do not.) +-/ +def ReevalEquivSubstFirst (expr : Spec.Expr) (req req' : Partial.Request) (entities : Partial.Entities) (subsmap : Subsmap) : Prop := + req.subst subsmap = some req' → + let re_evaluated := Partial.evaluate expr req entities >>= λ residual => Partial.evaluateValue (residual.subst subsmap) (entities.subst subsmap) + let subst_first := Partial.evaluate expr req' (entities.subst subsmap) + match (re_evaluated, subst_first) with + | (Except.error _, Except.error _) => true -- don't require that the errors are equal + | (_, _) => re_evaluated = subst_first + end Cedar.Thm.Partial diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateGetAttr.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateGetAttr.lean new file mode 100644 index 000000000..6bb9ab88a --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateGetAttr.lean @@ -0,0 +1,89 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Spec.Evaluator +import Cedar.Thm.Data.Control +import Cedar.Thm.Data.LT +import Cedar.Thm.Data.Map +import Cedar.Thm.Data.Set +import Cedar.Thm.Partial.Evaluation.EvaluateValue +import Cedar.Thm.Partial.Evaluation.Props +import Cedar.Thm.Partial.Evaluation.ReevaluatePartialGetAttr +import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed + +namespace Cedar.Thm.Partial.Evaluation.ReevaluateGetAttr + +open Cedar.Data +open Cedar.Partial (Subsmap) +open Cedar.Spec (Attr EntityUID Error Expr Prim Result) + +/-- + If `Partial.evaluateGetAttr` returns a residual, re-evaluating that residual with a + substitution is equivalent to substituting first, evaluating the arg, and calling + `Partial.evaluateGetAttr` on the substituted/evaluated arg + + As an inductive hypothesis, this takes a proof of + `ReevaluateValue.reeval_eqv_substituting_first` for any `pval` contained in `entities`. +-/ +theorem reeval_eqv_substituting_first (pval₁ : Partial.Value) (attr : Attr) {entities : Partial.Entities} {subsmap : Subsmap} + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) + (wf₁ : pval₁.WellFormed) + (ih : ∀ v pv pv', + v.WellFormed → + Partial.getAttr v attr entities = .ok pv → + Partial.evaluateValue pv entities = .ok pv' → + Partial.evaluateValue (pv'.subst subsmap) (entities.subst subsmap) = + Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) + ) : + let re_evaluated := (Partial.evaluateGetAttr pval₁ attr entities >>= λ residual => Partial.evaluateValue (residual.subst subsmap) (entities.subst subsmap)) + let subst_first := (Partial.evaluateValue (pval₁.subst subsmap) (entities.subst subsmap) >>= λ pval₁' => Partial.evaluateGetAttr pval₁' attr (entities.subst subsmap)) + match (re_evaluated, subst_first) with + | (Except.error _, Except.error _) => true -- don't require that the errors are equal + | (_, _) => re_evaluated = subst_first +:= by + unfold Partial.evaluateGetAttr + cases pval₁ <;> simp [Partial.Value.WellFormed] at wf₁ + case value v₁ => + simp [Subst.subst_concrete_value, Partial.evaluateValue] + rw [← reeval_eqv_substituting_first_partialGetAttr v₁ attr wf₁ wf_e wf_s] + cases h₁ : Partial.getAttr v₁ attr entities <;> simp + case ok pval => + have wf_pv : pval.WellFormed := EvaluateGetAttr.getAttr_wf wf₁ wf_e _ h₁ + specialize ih v₁ pval + cases h₂ : Partial.evaluateValue pval entities + <;> simp only [Except.bind_ok, Except.bind_err] + case error e => + have ⟨e', h₃⟩ := EvaluateValue.subst_preserves_errors wf_pv wf_e wf_s h₂ + simp only [h₃] + case ok pval' => + specialize ih pval' wf₁ h₁ h₂ + simp [ih] + split <;> trivial + case residual r₁ => + simp only [Except.bind_ok, Partial.evaluateValue, Partial.evaluateResidual, bind_assoc, + Partial.Value.subst] + cases h₁ : Partial.evaluateValue (r₁.subst subsmap) (entities.subst subsmap) + <;> simp only [Partial.ResidualExpr.subst, Partial.Value.subst, Partial.evaluateValue, + Partial.evaluateResidual, h₁, Except.bind_ok, Except.bind_err] + case ok pv₂ => + cases pv₂ <;> simp [Partial.evaluateGetAttr] + case value => split <;> trivial + + +end Cedar.Thm.Partial.Evaluation.ReevaluateGetAttr diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluatePartialGetAttr.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluatePartialGetAttr.lean new file mode 100644 index 000000000..42b83d4e4 --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluatePartialGetAttr.lean @@ -0,0 +1,181 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Thm.Data.Map +import Cedar.Thm.Partial.Evaluation.EvaluatePartialGetAttr +import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed + +namespace Cedar.Thm.Partial.Evaluation.ReevaluateGetAttr + +open Cedar.Data +open Cedar.Partial (Subsmap) +open Cedar.Spec (Attr EntityUID Error Expr Prim Result) + +/-- + `Partial.getAttr` on a `Spec.Value.record` returns the same result regardless + of the `entities` parameter +-/ +theorem partialGetAttr_record_entities (m : Map Attr Spec.Value) (attr : Attr) (entities₁ entities₂ : Partial.Entities) : + Partial.getAttr (.record m) attr entities₁ = Partial.getAttr (.record m) attr entities₂ +:= by + simp [Partial.getAttr, Partial.attrsOf] + +/-- + `Partial.attrsOf` on a `Spec.Value.record` never returns a map containing any + residuals +-/ +theorem partialAttrsOf_record {m : Map Attr Spec.Value} {entities : Partial.Entities} : + Partial.attrsOf (.record m) entities.attrs = .ok attrs → + ∀ val ∈ attrs.values, match val with | .value _ => true | .residual _ => false +:= by + simp [Partial.attrsOf] + intro h pval h₁ ; subst h + simp [Map.values_mapOnValues] at h₁ + replace ⟨val, _, h₁⟩ := h₁ ; subst h₁ + simp + +/-- + `Partial.getAttr` on a `Spec.Value.record` never returns a residual +-/ +theorem partialGetAttr_record (m : Map Attr Spec.Value) (attr : Attr) (entities : Partial.Entities) : + match Partial.getAttr (.record m) attr entities with + | .ok (.value _) => true + | .ok (.residual _) => false + | .error _ => true +:= by + simp [Partial.getAttr] + cases h₁ : Partial.attrsOf (.record m) entities.attrs <;> simp + case ok attrs => + have h₂ := partialAttrsOf_record h₁ + rcases Map.findOrErr_returns attrs attr Error.attrDoesNotExist with h₃ | h₃ + · replace ⟨pval, h₃⟩ := h₃ + cases pval + case value => simp [h₃] + case residual r => + specialize h₂ (.residual r) (Map.findOrErr_ok_implies_in_values h₃) + simp at h₂ + · simp [h₃] + +/-- + If `Partial.getAttr` on an `entityUID` returns a residual, re-evaluating that + residual with a substitution on `entities` is equivalent to substituting + first, calling `Partial.getAttr` on the substituted entities, and evaluating + the result +-/ +theorem reeval_eqv_substituting_first_partialGetAttr_entityUID (uid : EntityUID) (attr : Attr) {entities : Partial.Entities} {subsmap : Subsmap} + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + (Partial.getAttr (.prim (.entityUID uid)) attr entities >>= λ residual => Partial.evaluateValue (residual.subst subsmap) (entities.subst subsmap)) = + (Partial.getAttr (.prim (.entityUID uid)) attr (entities.subst subsmap) >>= λ v => Partial.evaluateValue v (entities.subst subsmap)) +:= by + unfold Partial.getAttr + cases h₁ : Partial.attrsOf (.prim (.entityUID uid)) entities.attrs + case error e => simp [EvaluateGetAttr.attrsOf_subst_preserves_errors h₁] + case ok attrs => + have wf_attrs := EvaluateGetAttr.attrsOf_wf (by simp [Spec.Value.WellFormed, Prim.WellFormed]) wf_e h₁ + simp only [Partial.attrsOf, Except.bind_ok, bind_assoc] at * + rcases Map.findOrErr_returns attrs attr Error.attrDoesNotExist with h₂ | h₂ + · replace ⟨pval, h₂⟩ := h₂ + simp only [h₂, Except.bind_ok] + replace h₂ := Map.findOrErr_ok_implies_in_kvs h₂ + have wf₁ : pval.WellFormed := by + simp [Partial.Entities.attrs] at h₁ + cases h₃ : entities.es.findOrErr uid Error.entityDoesNotExist + <;> simp [h₃] at h₁ + case ok edata => + subst h₁ + replace h₃ := Map.findOrErr_ok_implies_in_values h₃ + simp [Partial.Entities.WellFormed, Partial.EntityData.WellFormed] at wf_e + exact (wf_e.right edata h₃).right.right pval (Map.in_list_in_values h₂) + have ⟨attrs', h₂, h₃⟩ := Subst.entities_subst_preserves_attrs subsmap h₁ h₂ + have wf_attrs' := EvaluateGetAttr.partialEntities_attrs_wf (Subst.entities_subst_preserves_wf wf_e wf_s) h₂ + simp [h₂] + cases pval + case residual r => simp [(Map.findOrErr_ok_iff_in_kvs wf_attrs'.left).mpr h₃] + case value v => + simp [Subst.subst_concrete_value, Partial.evaluateValue] + simp [Subst.subst_concrete_value] at h₃ + apply Eq.symm + rcases Map.findOrErr_returns attrs' attr Error.attrDoesNotExist with h₄ | h₄ + · replace ⟨pval, h₄⟩ := h₄ + have wf₂ : pval.WellFormed := wf_attrs'.right pval (Map.findOrErr_ok_implies_in_values h₄) + simp [h₄] + cases pval + case residual r => + replace h₄ := Map.findOrErr_ok_implies_in_kvs h₄ + have h₅ := Map.key_maps_to_one_value attr _ _ attrs' wf_attrs'.left h₃ h₄ + simp at h₅ + case value v' => + simp only [Partial.Value.WellFormed] at wf₂ + simp only [Partial.evaluateValue, Except.ok.injEq, Partial.Value.value.injEq] + replace h₄ := Map.findOrErr_ok_implies_in_kvs h₄ + suffices Partial.Value.value v = Partial.Value.value v' by simp at this ; exact this.symm + exact Map.key_maps_to_one_value _ _ _ attrs' wf_attrs'.left h₃ h₄ + · rw [Map.findOrErr_err_iff_not_in_keys wf_attrs'.left] at h₄ + replace h₃ := Map.in_list_in_keys h₃ + contradiction + · simp [h₂] + cases h₃ : (entities.subst subsmap).attrs uid + case error e' => + simp [(Subst.entities_subst_preserves_error_attrs subsmap).mpr h₃] at h₁ + case ok attrs' => + simp only [Except.bind_ok] + have ⟨attrs'', h₃', h₄⟩ := Subst.entities_subst_preserves_absent_attrs subsmap h₁ (k := attr) ((Map.findOrErr_err_iff_not_in_keys wf_attrs.left).mp h₂) + simp only [h₃, Except.ok.injEq] at h₃' ; subst attrs'' + have wf_attrs' := EvaluateGetAttr.partialEntities_attrs_wf (Subst.entities_subst_preserves_wf wf_e wf_s) h₃ + rw [← Map.findOrErr_err_iff_not_in_keys wf_attrs'.left (e := Error.attrDoesNotExist)] at h₄ + simp [h₄] + +/-- + If `Partial.getAttr` returns a residual, re-evaluating that residual with a + substitution on `entities` is equivalent to substituting first, calling + `Partial.getAttr` on the substituted entities, and evaluating the result +-/ +theorem reeval_eqv_substituting_first_partialGetAttr (v₁ : Spec.Value) (attr : Attr) {entities : Partial.Entities} {subsmap : Subsmap} + (wf_v : v₁.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + (Partial.getAttr v₁ attr entities >>= λ residual => Partial.evaluateValue (residual.subst subsmap) (entities.subst subsmap)) = + (Partial.getAttr v₁ attr (entities.subst subsmap) >>= λ v => Partial.evaluateValue v (entities.subst subsmap)) +:= by + cases v₁ + case prim p => + cases p + case entityUID uid => exact reeval_eqv_substituting_first_partialGetAttr_entityUID uid attr wf_e wf_s + all_goals { + unfold Partial.getAttr + cases hv₁ : Partial.attrsOf _ entities.attrs + case error e => simp [EvaluateGetAttr.attrsOf_subst_preserves_errors hv₁] + case ok attrs => simp [Partial.attrsOf] at hv₁ + } + case record m => + rw [partialGetAttr_record_entities m attr (entities.subst subsmap) entities] + cases h₁ : Partial.getAttr (.record m) attr entities <;> simp + case ok pval => + have wf₁ : pval.WellFormed := EvaluateGetAttr.getAttr_wf wf_v wf_e _ h₁ + cases pval + case value v => simp [Subst.subst_concrete_value] + case residual r => + have h₂ := partialGetAttr_record m attr entities + simp [h₁] at h₂ + all_goals { + unfold Partial.getAttr + cases hv₁ : Partial.attrsOf _ entities.attrs + case error e => simp [EvaluateGetAttr.attrsOf_subst_preserves_errors hv₁] + case ok attrs => simp [Partial.attrsOf] at hv₁ + } diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateUnaryApp.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateUnaryApp.lean new file mode 100644 index 000000000..00f12e0e2 --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateUnaryApp.lean @@ -0,0 +1,73 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Thm.Data.Control +import Cedar.Thm.Data.Map +import Cedar.Thm.Data.Set +import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed + +/-! Theorems about reevaluation of `Partial.evaluateUnaryApp` -/ + +namespace Cedar.Thm.Partial.Evaluation.ReevaluateUnaryApp + +open Cedar.Partial (Subsmap) +open Cedar.Spec (UnaryOp) + +/-- + If `Partial.evaluateUnaryApp` returns a residual, re-evaluating that residual + with a substitution is equivalent to substituting first, evaluating the arg, + and calling `Partial.evaluateUnaryApp` on the substituted/evaluated arg +-/ +theorem reeval_eqv_substituting_first (op : UnaryOp) (pval₁ : Partial.Value) (entities : Partial.Entities) (subsmap : Subsmap) + (wf₁ : pval₁.WellFormed) : + let re_evaluated := Partial.evaluateUnaryApp op pval₁ >>= λ residual => Partial.evaluateValue (residual.subst subsmap) (entities.subst subsmap) + let subst_first := Partial.evaluateValue (pval₁.subst subsmap) (entities.subst subsmap) >>= λ pval₁' => Partial.evaluateUnaryApp op pval₁' + match (re_evaluated, subst_first) with + | (Except.error _, Except.error _) => true -- don't require that the errors are equal + | (_, _) => re_evaluated = subst_first +:= by + simp only [Partial.evaluateUnaryApp] + split <;> try { trivial } <;> rename_i hₑ h₁ + simp only [Prod.mk.injEq] at h₁ ; replace ⟨h₁, h₁'⟩ := h₁ ; subst h₁ h₁' + cases h₁ : Partial.evaluateValue (pval₁.subst subsmap) (entities.subst subsmap) + case error e => + exfalso + simp only [h₁, Except.bind_err, Except.error.injEq, imp_false, forall_apply_eq_imp_iff] at hₑ + cases pval₁ <;> simp only [bind_assoc, Except.bind_ok] at hₑ + case value v₁ => + simp [Subst.subst_concrete_value, Partial.evaluateValue] at h₁ + case residual r₁ => + simp only [Partial.Value.subst, Partial.ResidualExpr.subst] at h₁ hₑ + simp only [Partial.evaluateValue, Partial.evaluateResidual] at h₁ hₑ + simp only [h₁, Except.bind_err, Except.error.injEq, forall_eq'] at hₑ + case ok pval₁' => + cases pval₁ + case value v₁ => + simp only [Subst.subst_concrete_value, Partial.evaluateValue, + bind_assoc, Except.bind_ok, Except.ok.injEq, imp_false] at * + subst pval₁' + simp only + case residual r₁ => + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual] at * + cases hr₁' : Partial.evaluateValue (r₁.subst subsmap) (entities.subst subsmap) + case error e => + simp only [hr₁', Except.bind_err, Except.error.injEq, forall_apply_eq_imp_iff, imp_false, + forall_eq'] at hₑ + case ok r₁' => + simp only [hr₁', Except.ok.injEq] at h₁ ; subst r₁' + simp only [Except.bind_ok, Partial.evaluateUnaryApp] diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean new file mode 100644 index 000000000..fcc118b03 --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean @@ -0,0 +1,687 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Partial.Value +import Cedar.Thm.Data.Control +import Cedar.Thm.Partial.Evaluation.EvaluateBinaryApp +import Cedar.Thm.Partial.Evaluation.EvaluateHasAttr +import Cedar.Thm.Partial.Evaluation.EvaluateValue +import Cedar.Thm.Partial.Evaluation.ReevaluateGetAttr +import Cedar.Thm.Partial.Evaluation.Tactic +import Cedar.Thm.Partial.Subst + +/-! This file contains theorems about reevaluation of `Partial.evaluateValue` (and `Partial.evaluateResidual`). -/ + +namespace Cedar.Thm.Partial.Evaluation.ReevaluateValue + +open Cedar.Data +open Cedar.Partial (Subsmap) +open Cedar.Spec (Error Prim) + +private theorem mapM_ok_some {xs : List α} {ys : List β} {f : α → Except ε β} {g : β → Option ζ} : + List.mapM f xs = .ok ys → + List.mapM g ys = some zs → + ∀ x ∈ xs, ∃ y ∈ ys, ∃ z ∈ zs, f x = .ok y ∧ g y = some z +:= by + intro h₁ h₂ x hx + replace ⟨y, hy, h₁⟩ := List.mapM_ok_implies_all_ok h₁ x hx + replace ⟨z, hz, h₂⟩ := List.mapM_some_implies_all_some h₂ y hy + exists y + apply And.intro hy + exists z + +private theorem mapM_ok_none {xs : List α} {ys : List β} {f : α → Except ε β} {g : β → Option ζ} : + List.mapM f xs = .ok ys → + List.mapM g ys = none → + ∃ x ∈ xs, ∃ y ∈ ys, f x = .ok y ∧ g y = none +:= by + intro h₁ h₂ + replace ⟨y, hy, h₂⟩ := List.mapM_none_iff_exists_none.mp h₂ + replace ⟨x, hx, h₁⟩ := List.mapM_ok_implies_all_from_ok h₁ y hy + exists x + apply And.intro hx + exists y + +private theorem mapM_from_ok_some {xs : List α} {ys : List β} {f : α → Except ε β} {g : β → Option ζ} : + List.mapM g ys = some zs → + List.mapM f xs = .ok ys → + ∀ z ∈ zs, ∃ y ∈ ys, ∃ x ∈ xs, f x = .ok y ∧ g y = some z +:= by + intro h₁ h₂ z hz + replace ⟨y, hy, h₁⟩ := List.mapM_some_implies_all_from_some h₁ z hz + replace ⟨x, hx, h₂⟩ := List.mapM_ok_implies_all_from_ok h₂ y hy + exists y + apply And.intro hy + exists x + +private theorem mapM_ok_some_from_ok_some {xs : List α} {ys ys' : List β} {f f' : α → Except ε β} {g g' : β → Option ζ} : + List.mapM f xs = .ok ys → + List.mapM g ys = some zs → + List.mapM f' xs = .ok ys' → + List.mapM g' ys' = some zs' → + ∀ z' ∈ zs', ∃ y' ∈ ys', ∃ x ∈ xs, ∃ y ∈ ys, ∃ z ∈ zs, f x = .ok y ∧ g y = some z ∧ f' x = .ok y' ∧ g' y' = some z' +:= by + intro h₁ h₂ h₃ h₄ z' hz' + replace ⟨y', hy', x, hx, h₃, h₄⟩ := mapM_from_ok_some h₄ h₃ z' hz' + replace ⟨y, hy, z, hz, h₁, h₂⟩ := mapM_ok_some h₁ h₂ x hx + exists y' + apply And.intro hy' + exists x + apply And.intro hx + exists y + apply And.intro hy + exists z + +/-- + `mapM_ok_some_from_ok_some` specialized to a particular `g` and `g'`, which allows + us to give a stronger conclusion +-/ +private theorem mapM_ok_some_from_ok_some' {xs : List α} {ys ys' : List Partial.Value} {f f' : α → Except ε Partial.Value} : + List.mapM f xs = .ok ys → + List.mapM (λ pv => match pv with | .value v => some v | .residual _ => none) ys = some zs → + List.mapM f' xs = .ok ys' → + List.mapM (λ pv => match pv with | .value v => some v | .residual _ => none) ys' = some zs' → + ∀ v' ∈ zs', Partial.Value.value v' ∈ ys' ∧ ∃ x ∈ xs, ∃ v, Partial.Value.value v ∈ ys ∧ f x = .ok (.value v) ∧ f' x = .ok (.value v') ∧ v ∈ zs +:= by + intro h₁ h₂ h₃ h₄ z' hz' + replace ⟨y', hy', x, hx, y, hy, z, hz, h₁, h₂, h₃, h₄⟩ := mapM_ok_some_from_ok_some h₁ h₂ h₃ h₄ z' hz' + split at h₂ <;> simp at h₂ ; subst z ; rename_i v + split at h₄ <;> simp at h₄ ; subst z' ; rename_i v' + apply And.intro hy' + exists x + apply And.intro hx + exists v + +private theorem mapM_ok_some_from_ok_none {xs : List α} {ys ys' : List β} {f f' : α → Except ε β} {g g' : β → Option ζ} : + List.mapM f xs = .ok ys → + List.mapM g ys = some zs → + List.mapM f' xs = .ok ys' → + List.mapM g' ys' = none → + ∃ y' ∈ ys', ∃ x ∈ xs, ∃ y ∈ ys, ∃ z ∈ zs, f x = .ok y ∧ g y = some z ∧ f' x = .ok y' ∧ g' y' = none +:= by + intro h₁ h₂ h₃ h₄ + replace ⟨x, hx, y', hy', h₃, h₄⟩ := mapM_ok_none h₃ h₄ + replace ⟨y, hy, z, hz, h₁, h₂⟩ := mapM_ok_some h₁ h₂ x hx + exists y' + apply And.intro hy' + exists x + apply And.intro hx + exists y + apply And.intro hy + exists z + +/-- + `mapM_ok_some_from_ok_none` specialized to a particular `g` and `g'`, which allows + us to give a stronger conclusion +-/ +private theorem mapM_ok_some_from_ok_none' {xs : List α} {ys ys' : List Partial.Value} {f f' : α → Except ε Partial.Value} : + List.mapM f xs = .ok ys → + List.mapM (λ pv => match pv with | .value v => some v | .residual _ => none) ys = some zs → + List.mapM f' xs = .ok ys' → + List.mapM (λ pv => match pv with | .value v => some v | .residual _ => none) ys' = none → + ∃ r, Partial.Value.residual r ∈ ys' ∧ ∃ x ∈ xs, ∃ v, Partial.Value.value v ∈ ys ∧ f x = .ok (.value v) ∧ f' x = .ok (.residual r) +:= by + intro h₁ h₂ h₃ h₄ + replace ⟨y', hy', x, hx, y, hy, z, hz, h₁, h₂, h₃, h₄⟩ := mapM_ok_some_from_ok_none h₁ h₂ h₃ h₄ + split at h₂ <;> simp at h₂ ; subst z ; rename_i v + split at h₄ <;> simp at h₄ ; rename_i r + exists r + apply And.intro hy' + exists x + apply And.intro hx + exists v + +private theorem mapM_ok_none_from_ok_none {xs : List α} {ys ys' : List β} {f f' : α → Except ε β} {g g' : β → Option ζ} : + List.mapM f xs = .ok ys → + List.mapM g ys = none → + List.mapM f' xs = .ok ys' → + List.mapM g' ys' = none → + -- tracing backward from ys + ∃ y₁ ∈ ys, ∃ y'₁ ∈ ys', ∃ x₁ ∈ xs, f x₁ = .ok y₁ ∧ g y₁ = none ∧ f' x₁ = .ok y'₁ ∧ + -- tracing backward from ys' + ∃ y₂ ∈ ys, ∃ y'₂ ∈ ys', ∃ x₂ ∈ xs, f' x₂ = .ok y'₂ ∧ g' y'₂ = none ∧ f x₂ = .ok y₂ +:= by + intro h₁ h₂ h₃ h₄ + have ⟨x₁, hx₁, y₁, hy₁, h₅, h₆⟩ := mapM_ok_none h₁ h₂ + have ⟨x₂, hx₂, y'₂, hy'₂, h₇, h₈⟩ := mapM_ok_none h₃ h₄ + replace ⟨y'₁, hy'₁, h₃⟩ := List.mapM_ok_implies_all_ok h₃ x₁ hx₁ + replace ⟨y₂, hy₂, h₁⟩ := List.mapM_ok_implies_all_ok h₁ x₂ hx₂ + exists y₁ + apply And.intro hy₁ + exists y'₁ + apply And.intro hy'₁ + exists x₁ + apply And.intro hx₁ + apply And.intro h₅ + apply And.intro h₆ + apply And.intro h₃ + exists y₂ + apply And.intro hy₂ + exists y'₂ + apply And.intro hy'₂ + exists x₂ + +/-- + `mapM_ok_none_from_ok_none` specialized to a particular `g` and `g'`, which allows + us to give a stronger conclusion +-/ +private theorem mapM_ok_none_from_ok_none' {xs : List α} {ys ys' : List Partial.Value} {f f' : α → Except ε Partial.Value} : + List.mapM f xs = .ok ys → + List.mapM (λ pv => match pv with | .value v => some v | .residual _ => none) ys = none → + List.mapM f' xs = .ok ys' → + List.mapM (λ pv => match pv with | .value v => some v | .residual _ => none) ys' = none → + -- tracing backward from ys + ∃ r, Partial.Value.residual r ∈ ys ∧ ∃ x ∈ xs, f x = .ok (.residual r) ∧ ∃ pv' ∈ ys', f' x = .ok pv' ∧ + -- tracing backward from ys' + ∃ r', Partial.Value.residual r' ∈ ys' ∧ ∃ x' ∈ xs, f' x' = .ok (.residual r') ∧ ∃ pv ∈ ys, f x' = .ok pv +:= by + intro h₁ h₂ h₃ h₄ + replace ⟨y₁, hy₁, y'₁, hy'₁, x₁, hx₁, h₁, h₂, h₃, y₂, hy₂, y'₂, hy'₂, x₂, hx₂, h₄, h₅, h₆⟩ := mapM_ok_none_from_ok_none h₁ h₂ h₃ h₄ + split at h₂ <;> simp at h₂ ; rename_i r + split at h₅ <;> simp at h₅ ; rename_i r' + exists r + apply And.intro hy₁ + exists x₁ + apply And.intro hx₁ + apply And.intro h₁ + exists y'₁ + apply And.intro hy'₁ + apply And.intro h₃ + exists r' + apply And.intro hy'₂ + exists x₂ + apply And.intro hx₂ + apply And.intro h₄ + exists y₂ + +mutual + +/-- + Evaluating a `Partial.ResidualExpr` with `Partial.evaluateResidual`, then substituting, then re-evaluating, + produces the same end-result as just substituting and then evaluating +-/ +theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {pv' : Partial.Value} {entities : Partial.Entities} (subsmap : Subsmap) + (wf_r : r.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + Partial.evaluateResidual r entities = .ok pv' → + Partial.evaluateValue (pv'.subst subsmap) (entities.subst subsmap) = + Partial.evaluateValue (r.subst subsmap) (entities.subst subsmap) +:= by + cases r <;> simp only [Partial.evaluateResidual, Partial.evaluateValue, Partial.ResidualExpr.subst, + Partial.Value.subst, Except.ok.injEq, Bool.not_eq_true'] + <;> simp only [Partial.ResidualExpr.WellFormed] at wf_r + case unknown u => + intro _ ; subst pv' + simp only [Partial.Value.subst, Partial.ResidualExpr.subst] + case and pv₁ pv₂ | or pv₁ pv₂ => + have := EvaluateValue.sizeOf_lt_and pv₁ pv₂ + have := EvaluateValue.sizeOf_lt_or pv₁ pv₂ + cases hpv₁ : Partial.evaluateValue pv₁ entities + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok pv₁' => + have ih₁ := reeval_eqv_substituting_first wf_r.left wf_e wf_s hpv₁ + cases hpv₁' : Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err] + case error e₁ => + cases pv₁' <;> simp + case value v₁' => + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.left hpv₁] at hpv₁' + case residual r₁' => + intro _ ; subst pv' + simp [Partial.Value.subst, Partial.ResidualExpr.subst] + simp [Partial.Value.subst] at ih₁ + simp [Partial.evaluateValue, Partial.evaluateResidual] + simp [ih₁, hpv₁'] + case ok pv₁'' => + cases pv₁' <;> simp + case residual r₁' => + intro _ ; subst pv' + simp only [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, + Partial.evaluateResidual, Bool.not_eq_true'] at * + simp only [hpv₁'] at ih₁ + simp only [ih₁, Except.bind_ok] + case value v₁' => + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.left hpv₁] at hpv₁' + subst pv₁'' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] at * + cases hv₁' : v₁'.asBool <;> simp + case ok b₁' => + cases b₁' <;> simp + all_goals try { + -- this dispatches the `false` case for and, and the `true` case for or + intro _ ; subst pv' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] + } + -- what follows is an extremely similar tactic sequence to what we did for pv₁, + -- just for pv₂ this time. In the future we could reduce duplication (lemma? tactic?) + cases hpv₂ : Partial.evaluateValue pv₂ entities + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok pv₂' => + have ih₂ := reeval_eqv_substituting_first wf_r.right wf_e wf_s hpv₂ + cases hpv₂' : Partial.evaluateValue (pv₂.subst subsmap) (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err] + case error e₂ => + cases pv₂' <;> simp + case value v₂' => + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.right hpv₂] at hpv₂' + case residual r₂' => + intro _ ; subst pv' + simp [Partial.Value.subst, Partial.ResidualExpr.subst] + simp [Partial.Value.subst] at ih₂ + simp [Partial.evaluateValue, Partial.evaluateResidual] + simp [ih₂, hpv₂', Spec.Value.asBool] + case ok pv₂'' => + cases pv₂' <;> simp + case residual r₂' => + intro _ ; subst pv' + simp only [Spec.Value.asBool, Partial.Value.subst, Partial.ResidualExpr.subst, + Partial.evaluateValue, Partial.evaluateResidual, Bool.not_eq_true', + Except.bind_ok, Bool.true_eq_false, reduceIte] at * + simp only [hpv₂'] at ih₂ + simp only [ih₂, Except.bind_ok] + case value v₂' => + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.right hpv₂] at hpv₂' + subst pv₂'' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] at * + cases hv₂' : v₂'.asBool <;> simp + intro _ ; subst pv' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] + case binaryApp op pv₁ pv₂ => + have := EvaluateValue.sizeOf_lt_binaryApp op pv₁ pv₂ + -- this also shares a lot of commonality with the and/or proof. + -- could potentially reuse the same lemma/tactic. + cases hpv₁ : Partial.evaluateValue pv₁ entities + <;> cases hpv₂ : Partial.evaluateValue pv₂ entities + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok.ok pv₁' pv₂' => + have ih₁ := reeval_eqv_substituting_first wf_r.left wf_e wf_s hpv₁ + have ih₂ := reeval_eqv_substituting_first wf_r.right wf_e wf_s hpv₂ + cases hpv₁' : Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) + <;> cases hpv₂' : Partial.evaluateValue (pv₂.subst subsmap) (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err, Partial.evaluateBinaryApp] + case error.error e₁ _ | error.ok e₁ _ => + split <;> rename_i h₁ + <;> simp only [Prod.mk.injEq] at h₁ <;> replace ⟨h₁, h₁'⟩ := h₁ <;> subst h₁ h₁' + · simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.left hpv₁] at hpv₁' + · rename_i hv + intro h ; simp at h ; subst pv' + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual, ih₁, ih₂, hpv₁', hpv₂'] + case ok.error _ e₂ => + split <;> rename_i h₁ + <;> simp only [Prod.mk.injEq] at h₁ <;> replace ⟨h₁, h₁'⟩ := h₁ <;> subst h₁ h₁' + · simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.right hpv₂] at hpv₂' + · rename_i hv + intro h ; simp at h ; subst pv' + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual, ih₁, ih₂, hpv₁', hpv₂'] + case ok.ok pv₁'' pv₂'' => + simp [hpv₁'] at ih₁ + simp [hpv₂'] at ih₂ + split <;> rename_i h₁ + <;> simp only [Prod.mk.injEq] at h₁ <;> replace ⟨h₁, h₁'⟩ := h₁ <;> subst h₁ h₁' + · rename_i v₁ v₂ + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] at * + subst pv₁'' pv₂'' + cases op <;> simp [Partial.apply₂] + case eq => + intro _ ; subst pv' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] + case less | lessEq | add | sub | mul => + cases v₁ <;> cases v₂ + case prim.prim p₁ p₂ => + cases p₁ <;> cases p₂ <;> simp + case int.int i₁ i₂ => + cases Spec.intOrErr (i₁.add? i₂) + <;> cases Spec.intOrErr (i₁.sub? i₂) + <;> cases Spec.intOrErr (i₁.mul? i₂) + <;> try simp + all_goals { + intro _ ; subst pv' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] + } + all_goals simp + case mem => + cases v₁ <;> cases v₂ + case prim.prim p₁ p₂ => + cases p₁ <;> cases p₂ <;> simp + case entityUID.entityUID uid₁ uid₂ => + intro _ ; subst pv' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] + exact EvaluateBinaryApp.partialInₑ_subst_const + case prim.set p₁ s₂ => + cases p₁ <;> simp + case entityUID uid₁ => + rw [← EvaluateBinaryApp.partialInₛ_subst_const] + intro h₁ ; replace ⟨v, h₁, h₂⟩ := do_ok.mp h₁ + subst pv' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value, h₁] + all_goals simp + case contains => + cases v₁ <;> simp + case set s₁ => + intro _ ; subst pv' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] + case containsAll | containsAny => + cases v₁ <;> cases v₂ <;> simp + case set.set s₁ s₂ => + intro _ ; subst pv' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] + · rename_i hv + simp only [Except.ok.injEq] + intro _ ; subst pv' + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual, ih₁, ih₂, hpv₁', hpv₂'] + split <;> rename_i h₁ + <;> simp only [Prod.mk.injEq] at h₁ <;> replace ⟨h₁, h₁'⟩ := h₁ <;> subst h₁ h₁' + · simp [Partial.evaluateBinaryApp] + · rename_i hv' + cases pv₁'' <;> cases pv₂'' <;> simp [Partial.evaluateBinaryApp] + case value.value v₁' v₂' => exfalso ; exact hv' v₁' v₂' rfl rfl + case ite pv₁ pv₂ pv₃ => + have := EvaluateValue.sizeOf_lt_ite pv₁ pv₂ pv₃ + -- the first many lines of this are identical to those in the and/or proof. + -- in the future we could reduce duplication. (lemma? tactic?) + cases hpv₁ : Partial.evaluateValue pv₁ entities + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok pv₁' => + have ih₁ := reeval_eqv_substituting_first wf_r.left wf_e wf_s hpv₁ + cases hpv₁' : Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err] + case error e₁ => + cases pv₁' <;> simp + case value v₁' => + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.left hpv₁] at hpv₁' + case residual r₁' => + intro _ ; subst pv' + simp [Partial.Value.subst, Partial.ResidualExpr.subst] + simp [Partial.Value.subst] at ih₁ + simp [Partial.evaluateValue, Partial.evaluateResidual] + simp [ih₁, hpv₁'] + case ok pv₁'' => + cases pv₁' <;> simp + case residual r₁' => + intro _ ; subst pv' + simp only [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, + Partial.evaluateResidual, Bool.not_eq_true'] at * + simp only [hpv₁'] at ih₁ + simp only [ih₁, Except.bind_ok] + case value v₁' => + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.left hpv₁] at hpv₁' + subst pv₁'' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] at * + cases hv₁' : v₁'.asBool <;> simp + case ok b₁' => + cases hpv₂ : Partial.evaluateValue pv₂ entities + <;> cases hpv₃ : Partial.evaluateValue pv₃ entities + <;> cases b₁' <;> simp + case ok.error.true pv₂' e₃ | ok.ok.true pv₂' pv₃' => + intro _ ; subst pv' + simp [reeval_eqv_substituting_first wf_r.right.left wf_e wf_s hpv₂] + case error.ok.false e₂ pv₃' | ok.ok.false pv₂' pv₃' => + intro _ ; subst pv' + simp [reeval_eqv_substituting_first wf_r.right.right wf_e wf_s hpv₃] + case unaryApp op pv₁ => + have := EvaluateValue.sizeOf_lt_unaryApp op pv₁ + cases hpv₁ : Partial.evaluateValue pv₁ entities + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok pv₁' => + have ih₁ := reeval_eqv_substituting_first wf_r wf_e wf_s hpv₁ + cases hpv₁' : Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err] + case error e₁ => + cases pv₁' + case value v₁' => + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r hpv₁] at hpv₁' + case residual r₁' => + simp [Partial.evaluateUnaryApp] + intro _ ; subst pv' + simp [Partial.Value.subst, Partial.ResidualExpr.subst] + simp [Partial.Value.subst] at ih₁ + simp [Partial.evaluateValue, Partial.evaluateResidual] + simp [ih₁, hpv₁'] + case ok pv₁'' => + cases pv₁' + case residual r₁' => + simp [Partial.evaluateUnaryApp] + intro _ ; subst pv' + simp only [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, + Partial.evaluateResidual] at * + simp only [hpv₁'] at ih₁ + simp only [ih₁, Except.bind_ok, Partial.evaluateUnaryApp] + case value v₁' => + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r hpv₁] at hpv₁' + subst pv₁'' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] at * + intro h₁ ; simp [h₁] + simp [Partial.evaluateUnaryApp] at h₁ + replace ⟨v₁, h₁, h₂⟩ := do_ok.mp h₁ + subst pv' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] + case hasAttr pv₁ attr => + have := EvaluateValue.sizeOf_lt_hasAttr pv₁ attr + cases hpv₁ : Partial.evaluateValue pv₁ entities + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok pv₁' => + have ih₁ := reeval_eqv_substituting_first wf_r wf_e wf_s hpv₁ + cases hpv₁' : Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err] + case error e₁ => + cases pv₁' + case value v₁' => + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r hpv₁] at hpv₁' + case residual r₁' => + simp [Partial.evaluateHasAttr] + intro _ ; subst pv' + simp [Partial.Value.subst, Partial.ResidualExpr.subst] + simp [Partial.Value.subst] at ih₁ + simp [Partial.evaluateValue, Partial.evaluateResidual] + simp [ih₁, hpv₁'] + case ok pv₁'' => + cases pv₁' + case residual r₁' => + simp [Partial.evaluateHasAttr] + intro _ ; subst pv' + simp only [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, + Partial.evaluateResidual] at * + simp only [hpv₁'] at ih₁ + simp only [ih₁, Except.bind_ok, Partial.evaluateHasAttr] + case value v₁' => + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r hpv₁] at hpv₁' + subst pv₁'' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] at * + simp [Partial.evaluateHasAttr] + rw [← EvaluateHasAttr.hasAttr_subst_const wf_e] + intro h₁ ; simp [h₁] + replace ⟨v₁, h₁, h₂⟩ := do_ok.mp h₁ + subst pv' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] + case getAttr pv₁ attr => + have := EvaluateValue.sizeOf_lt_getAttr pv₁ attr + cases hpv₁ : Partial.evaluateValue pv₁ entities + <;> simp only [Except.bind_ok, Except.bind_err, false_implies] + case ok pv₁' => + have wf₁ : pv₁'.WellFormed := EvaluateValue.evalValue_wf wf_r wf_e hpv₁ + have ih₁ := reeval_eqv_substituting_first wf_r wf_e wf_s hpv₁ + cases pv₁' + case value v₁ => + simp only [Partial.Value.WellFormed] at wf₁ + cases hpv₁' : Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err] + case error e₁ => + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r hpv₁] at hpv₁' + case ok pv₁'' => + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r hpv₁] at hpv₁' + subst pv₁'' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] at ih₁ + simp [Partial.evaluateGetAttr] + cases h₁ : Partial.getAttr v₁ attr entities <;> simp + case ok pv₂ => + have wf₂ : pv₂.WellFormed := EvaluateGetAttr.getAttr_wf wf₁ wf_e _ h₁ + simp [EvaluateGetAttr.getAttr_subst_preserves_attrs wf₁ wf_e wf_s h₁] + intro h₂ + simp [EvaluateValue.reduce_commutes_subst subsmap wf₂ h₂] + case residual r₁ => + simp only [Partial.evaluateGetAttr, Except.ok.injEq] + intro _ ; subst pv' + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual] + simp only [Partial.Value.subst] at ih₁ + simp [ih₁] + case set pvs => + have := EvaluateValue.sizeOf_lt_set pvs + rw [List.mapM₁_eq_mapM (Partial.evaluateValue · entities)] + rw [List.map₁_eq_map] + rw [List.mapM₁_eq_mapM (Partial.evaluateValue · (entities.subst subsmap))] + rw [List.mapM_map] + cases h₁ : pvs.mapM (Partial.evaluateValue · entities) <;> simp + case ok pvs₂ => + cases h₂ : pvs.mapM (λ pv => Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap)) <;> simp + case ok pvs₃ => + split <;> rename_i h₃ <;> simp + · rename_i vs₂ + intro _ ; subst pv' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] + split <;> rename_i h₄ <;> simp + · rename_i vs₃ + simp [Set.make_make_eqv, List.Equiv, List.subset_def] + and_intros <;> intro v hv + · replace ⟨hv', pv₂, hpv₂, v', hv'', h₁, h₂, h₃⟩ := mapM_ok_some_from_ok_some' h₂ h₄ h₁ h₃ v hv ; clear h₄ + have wf₂ : pv₂.WellFormed := wf_r pv₂ hpv₂ + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf₂ h₂] at h₁ + subst v' + exact h₃ + · replace ⟨hv', pv, hpv, v', hv'', h₁, h₂, h₃⟩ := mapM_ok_some_from_ok_some' h₁ h₃ h₂ h₄ v hv ; clear h₄ + have wf : pv.WellFormed := wf_r pv hpv + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf h₁] at h₂ + subst v' + exact h₃ + · replace ⟨r, hr, pv, hpv, v', hv', h₁, h₂⟩ := mapM_ok_some_from_ok_none' h₁ h₃ h₂ h₄ ; clear h₃ h₄ + have wf₁ : pv.WellFormed := wf_r pv hpv + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf₁ h₁] at h₂ + · intro _ ; subst pv' + simp [Partial.Value.subst, Partial.ResidualExpr.subst, List.map₁_eq_map] + simp [Partial.evaluateValue, Partial.evaluateResidual, List.mapM₁_eq_mapM (Partial.evaluateValue · (entities.subst subsmap)), List.mapM_map] + split <;> rename_i h₄ + · rename_i vs₃ + have ⟨r, hr, pv, hpv, v', hv', h₅, h₆⟩ := mapM_ok_some_from_ok_none' h₂ h₄ h₁ h₃ + cases h₇ : pvs₂.mapM (λ pv => Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap)) <;> simp + case error e => + replace ⟨pv₂, hpv₂, h₇⟩ := List.mapM_error_implies_exists_error h₇ + replace ⟨pv₃, hpv₃, h₁⟩ := List.mapM_ok_implies_all_from_ok h₁ pv₂ hpv₂ + have wf₃ : pv₃.WellFormed := wf_r pv₃ hpv₃ + have : sizeOf pv₃ < sizeOf pvs := by sorry + simp [reeval_eqv_substituting_first wf₃ wf_e wf_s h₁] at h₇ + replace h₂ := List.mapM_ok_implies_all_ok h₂ pv₃ hpv₃ + simp [h₇] at h₂ + case ok pvs₄ => + split <;> rename_i h₈ + · rename_i vs₄ + simp [Set.make_make_eqv, List.Equiv, List.subset_def] + and_intros <;> intro v'' hv'' + · sorry + · sorry + · exfalso + sorry + · have ⟨r, hr, pv, hpv, h₅, pv₃, hpv₃, h₆, r', hr', pv', hpv', h₇, pv₂, hpv₂, h₈⟩ := mapM_ok_none_from_ok_none' h₁ h₃ h₂ h₄ + cases h₉ : pvs₂.mapM λ pv => Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) + <;> simp + case error e => + replace ⟨pv₂', hpv₂', h₉⟩ := List.mapM_error_implies_exists_error h₉ + replace ⟨pv'', hpv'', h₁⟩ := List.mapM_ok_implies_all_from_ok h₁ pv₂' hpv₂' + have wf'' : pv''.WellFormed := by sorry + have : sizeOf pv'' < sizeOf pvs := by sorry + have : sizeOf pvs < sizeOf (Partial.ResidualExpr.set pvs) := EvaluateValue.sizeOf_lt_set pvs + simp [reeval_eqv_substituting_first wf'' wf_e wf_s h₁] at h₉ + cases pv₂' + case value v₂ => simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap (by sorry) h₁] at h₉ + case residual r₂ => + sorry + case ok pvs₄ => + split <;> rename_i h₁₀ + · exfalso + rename_i vs₄ + sorry + · simp only [Except.ok.injEq, Partial.Value.residual.injEq, + Partial.ResidualExpr.set.injEq] + sorry + case error e => + replace ⟨pv, hpv, h₂⟩ := List.mapM_error_implies_exists_error h₂ + split <;> rename_i h₃ <;> simp only [Except.ok.injEq] + <;> intro _ <;> subst pv' + · exfalso + rename_i vs₂ + replace ⟨pv₂, hpv₂, v₂, hv₂, h₁⟩ := mapM_ok_some h₁ h₃ pv hpv + split at h₁ <;> simp at h₁ + replace ⟨h₁, h₁'⟩ := h₁ ; subst v₂ ; rename_i v₂ + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap (by sorry) h₁] at h₂ + · replace ⟨pv', hpv', pv₂, hpv₂, h₁, h₃⟩ := mapM_ok_none h₁ h₃ + split at h₃ <;> simp at h₃ ; rename_i r₂ + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual] + rw [List.map₁_eq_map] + rw [List.mapM₁_eq_mapM (Partial.evaluateValue · (entities.subst subsmap))] + rw [List.mapM_map] + cases h₄ : pvs₂.mapM λ pv => Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) + <;> simp + case error e' => + sorry + case ok pvs₃ => + split <;> rename_i h₅ + · exfalso + rename_i vs₃ + replace ⟨pv₃, hpv₃, v₃, hv₃, h₄, h₅⟩ := mapM_ok_some h₄ h₅ (.residual r₂) hpv₂ + split at h₅ <;> simp at h₅ ; subst v₃ ; rename_i v₃ + sorry + · replace ⟨pv₂, hpv₂, pv₃, hpv₃, h₄, h₅⟩ := mapM_ok_none h₄ h₅ + split at h₅ <;> simp at h₅ ; rename_i r₃ + exfalso + sorry + case record attrs => + have := EvaluateValue.sizeOf_lt_record attrs + sorry + case call xfn pvs => + have := EvaluateValue.sizeOf_lt_call xfn pvs + sorry +termination_by sizeOf r +decreasing_by + all_goals simp_wf + all_goals try subst r + all_goals try omega + case _ | _ => + rename _ = Partial.ResidualExpr.set _ => h ; subst h + omega + +/-- + Evaluating a `Partial.Value` with `Partial.evaluateValue`, then substituting, then re-evaluating, + produces the same end-result as just substituting and then evaluating +-/ +theorem reeval_eqv_substituting_first {pv pv' : Partial.Value} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_pv : pv.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + Partial.evaluateValue pv entities = .ok pv' → + Partial.evaluateValue (pv'.subst subsmap) (entities.subst subsmap) = + Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) +:= by + cases pv <;> simp only [Partial.evaluateValue, Except.ok.injEq] + case value v => intro _ ; subst pv' ; rfl + case residual r => + simp only [Partial.Value.subst] + simp only [Partial.Value.WellFormed] at wf_pv + exact evalResidual_reeval_eqv_substituting_first subsmap wf_pv wf_e wf_s +termination_by sizeOf pv + +end + +end Cedar.Thm.Partial.Evaluation.ReevaluateValue diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation.lean new file mode 100644 index 000000000..b14eaea9b --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation.lean @@ -0,0 +1,108 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Thm.Data.Map +import Cedar.Thm.Partial.Evaluation.Props +import Cedar.Thm.Partial.Evaluation.Reevaluation.AndOr +import Cedar.Thm.Partial.Evaluation.Reevaluation.Binary +import Cedar.Thm.Partial.Evaluation.Reevaluation.Call +import Cedar.Thm.Partial.Evaluation.Reevaluation.GetAttr +import Cedar.Thm.Partial.Evaluation.Reevaluation.HasAttr +import Cedar.Thm.Partial.Evaluation.Reevaluation.Ite +import Cedar.Thm.Partial.Evaluation.Reevaluation.Record +import Cedar.Thm.Partial.Evaluation.Reevaluation.Set +import Cedar.Thm.Partial.Evaluation.Reevaluation.Unary +import Cedar.Thm.Partial.Evaluation.Reevaluation.Var +import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed + +/-! + This file contains theorems about re-evaluating residuals. +-/ + +namespace Cedar.Thm.Partial.Evaluation.Reevaluation + +open Cedar.Data +open Cedar.Partial (Subsmap Unknown) + +/-- + Main PE soundness theorem (for evaluation): + + Re-evaluation with a substitution on the residual expression, is equivalent to + substituting first and then evaluating on the original expression. +-/ +theorem reeval_eqv_substituting_first (expr : Spec.Expr) {entities : Partial.Entities} {req : Partial.Request} (req' : Partial.Request) (subsmap : Subsmap) + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + ReevalEquivSubstFirst expr req req' entities subsmap +:= by + cases expr + case lit p => + unfold ReevalEquivSubstFirst Partial.evaluate + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] + case var v => exact Var.reeval_eqv_substituting_first v req req' entities subsmap wf_r wf_e wf_s + case and x₁ x₂ | or x₁ x₂ => + first + | apply (AndOr.reeval_eqv_substituting_first wf_r wf_e wf_s _ _).left + | apply (AndOr.reeval_eqv_substituting_first wf_r wf_e wf_s _ _).right + · exact reeval_eqv_substituting_first x₁ req' subsmap wf_r wf_e wf_s + · exact reeval_eqv_substituting_first x₂ req' subsmap wf_r wf_e wf_s + case ite x₁ x₂ x₃ => + apply Ite.reeval_eqv_substituting_first wf_r wf_e wf_s + · exact reeval_eqv_substituting_first x₁ req' subsmap wf_r wf_e wf_s + · exact reeval_eqv_substituting_first x₂ req' subsmap wf_r wf_e wf_s + · exact reeval_eqv_substituting_first x₃ req' subsmap wf_r wf_e wf_s + case unaryApp op x₁ => + apply Unary.reeval_eqv_substituting_first wf_r wf_e + · exact reeval_eqv_substituting_first x₁ req' subsmap wf_r wf_e wf_s + case binaryApp op x₁ x₂ => + apply Binary.reeval_eqv_substituting_first wf_r wf_e wf_s + · exact reeval_eqv_substituting_first x₁ req' subsmap wf_r wf_e wf_s + · exact reeval_eqv_substituting_first x₂ req' subsmap wf_r wf_e wf_s + case hasAttr x₁ attr => + apply HasAttr.reeval_eqv_substituting_first wf_r wf_e wf_s + · exact reeval_eqv_substituting_first x₁ req' subsmap wf_r wf_e wf_s + case getAttr x₁ attr => + apply GetAttr.reeval_eqv_substituting_first wf_r wf_e wf_s + · exact reeval_eqv_substituting_first x₁ req' subsmap wf_r wf_e wf_s + case set xs => + apply Set.reeval_eqv_substituting_first wf_r wf_e wf_s + · intro x h₁ + have := List.sizeOf_lt_of_mem h₁ + exact reeval_eqv_substituting_first x req' subsmap wf_r wf_e wf_s + case record attrs => + apply Record.reeval_eqv_substituting_first wf_r wf_e wf_s + · intro (k, v) h₁ + have := List.sizeOf_lt_of_mem h₁ + apply reeval_eqv_substituting_first v req' subsmap wf_r wf_e wf_s + case call xfn xs => + apply Call.reeval_eqv_substituting_first wf_r wf_e wf_s + · intro x h₁ + have := List.sizeOf_lt_of_mem h₁ + exact reeval_eqv_substituting_first x req' subsmap wf_r wf_e wf_s +termination_by expr +decreasing_by + all_goals simp_wf + all_goals try omega + case _ => -- record + have h₂ : sizeOf v < sizeOf (k, v) := by simp only [sizeOf, Prod._sizeOf_1] ; omega + apply Nat.lt_trans h₂ + omega + + +end Cedar.Thm.Partial.Evaluation.Reevaluation diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/AndOr.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/AndOr.lean new file mode 100644 index 000000000..399d8d48f --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/AndOr.lean @@ -0,0 +1,163 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Thm.Partial.Evaluation.Evaluate +import Cedar.Thm.Partial.Evaluation.Props +import Cedar.Thm.Partial.Subst + +namespace Cedar.Thm.Partial.Evaluation.Reevaluation.AndOr + +open Cedar.Data +open Cedar.Partial (Subsmap Unknown) +open Cedar.Spec (Prim) + +/-- + Inductive argument that re-evaluation of a `Spec.Expr.and` or + `Spec.Expr.or` with a substitution on the residual expression, is + equivalent to substituting first and then evaluating on the original + `Spec.Expr.and` or `Spec.Expr.or`. +-/ +theorem reeval_eqv_substituting_first {x₁ x₂ : Spec.Expr} {entities : Partial.Entities} {req req' : Partial.Request} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) + (ih₁ : ReevalEquivSubstFirst x₁ req req' entities subsmap) + (ih₂ : ReevalEquivSubstFirst x₂ req req' entities subsmap) : + ReevalEquivSubstFirst (Spec.Expr.and x₁ x₂) req req' entities subsmap ∧ + ReevalEquivSubstFirst (Spec.Expr.or x₁ x₂) req req' entities subsmap +:= by + unfold ReevalEquivSubstFirst at * + simp [Partial.evaluate] + constructor <;> intro h_req + <;> have wf_r' : req'.WellFormed := Subst.req_subst_preserves_wf wf_r wf_s h_req + all_goals { + specialize ih₁ h_req ; specialize ih₂ h_req + split <;> try trivial + rename_i hₑ h₁ + cases hx₁ : Partial.evaluate x₁ req entities + <;> simp [hx₁] at ih₁ h₁ <;> simp [hx₁] + <;> replace ⟨h₁, h₁'⟩ := h₁ <;> subst h₁ h₁' + case error e₁ => + have ⟨e₁', hx₁'⟩ := Evaluate.subst_preserves_errors wf_r wf_e wf_s h_req hx₁ + simp only [hx₁', Except.error.injEq, Except.bind_err, imp_false, forall_apply_eq_imp_iff, + forall_eq'] at ih₁ hₑ + case ok pval₁ => + have wf₁ : pval₁.WellFormed := Evaluate.partial_eval_wf wf_r wf_e _ hx₁ + cases pval₁ + <;> simp only [bind_assoc, Except.bind_ok] + <;> simp only [Partial.Value.WellFormed] at wf₁ + case value v₁ => + simp only [bind_assoc, imp_false] at hₑ + split at ih₁ <;> rename_i ih₁' + <;> simp only [Subst.subst_concrete_value, EvaluateValue.eval_spec_value v₁, + Prod.mk.injEq, false_and] at ih₁' + <;> replace ⟨ih₁', ih₁''⟩ := ih₁' <;> subst ih₁' ih₁'' + <;> simp only [← ih₁] + <;> simp only [Subst.subst_concrete_value, EvaluateValue.eval_spec_value v₁, + Except.bind_ok] + <;> cases v₁ + <;> simp only [Spec.Value.asBool, Except.bind_err] + <;> simp only [Spec.Value.asBool] at hₑ + case prim p₁ _ => + cases p₁ <;> simp only [Except.bind_ok, Except.bind_err] + case bool b₁ _ => + cases b₁ <;> simp only [Partial.Value.subst, Except.bind_ok, reduceIte, Bool.true_eq_false, Bool.false_eq_true, bind_assoc] + all_goals try { simp [EvaluateValue.eval_spec_value] } -- this dispatches the `false` case for `and`, and the `true` case for `or` + simp only at ih₂ <;> split at ih₂ <;> rename_i ih₂' + <;> simp at ih₂' <;> replace ⟨ih₂', ih₂''⟩ := ih₂' + <;> cases hx₂ : Partial.evaluate x₂ req entities + <;> simp [hx₂] at ih₂ ih₂' hₑ + <;> simp [ih₂''] + <;> simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] at ih₁ + <;> simp [← ih₁, ih₂''] at hₑ + case h_1.ok pval₂ => + cases pval₂ + case value v₂ => + cases v₂ <;> simp + case prim p₂ => + cases p₂ + case bool b₂ => + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value b₂] at ih₂' + all_goals simp [EvaluateValue.eval_spec_value false] at hₑ + all_goals simp [EvaluateValue.eval_spec_value false] at hₑ + case residual r₂ => + exfalso + simp [Partial.Value.subst] at ih₂' + simp [Partial.Value.subst, Partial.ResidualExpr.subst, EvaluateValue.eval_spec_value false] at hₑ + simp [Partial.evaluateValue, Partial.evaluateResidual, Spec.Value.asBool] at hₑ + simp [ih₂'] at hₑ + case h_2.ok pval₂ => + subst ih₂' ih₂'' + cases pval₂ <;> simp + case value v₂ hₑ' => + rw [Evaluate.subst_preserves_evaluation_to_value wf_r wf_e wf_s h_req hx₂] at hₑ' + simp at hₑ' + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value v₂] at ih₂ + simp [← ih₂] + cases v₂ + case prim p₂ => + cases p₂ + case bool b₂ => + simp only [Subst.subst_concrete_value, Except.bind_ok, + EvaluateValue.eval_spec_value b₂] + all_goals simp only [Except.bind_err] + all_goals simp only [Except.bind_err] + case residual r₂ => + simp [← ih₂, Partial.Value.subst, Partial.ResidualExpr.subst] + conv => lhs ; simp [Partial.evaluateValue, Partial.evaluateResidual, Spec.Value.asBool] + case error e₂ => + subst ih₂'' + simp [← ih₂, hx₂] at hₑ + case residual r₁ => + simp only [Partial.Value.subst, Except.bind_ok, Partial.ResidualExpr.subst, + Partial.evaluateValue, Partial.evaluateResidual, Bool.not_eq_true', imp_false] at * + split at ih₁ <;> rename_i ih₁' + <;> simp at ih₁' <;> replace ⟨ih₁', ih₁''⟩ := ih₁' + · simp [ih₁', ih₁''] at hₑ + · rename_i hₑ' + subst ih₁' ih₁'' + simp only [ih₁] at hₑ + cases hx₁' : Partial.evaluate x₁ req' (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err] <;> simp [hx₁'] at ih₁ hₑ hₑ' + case ok pv₁' => + simp [ih₁] + cases pv₁' <;> simp only [Except.ok.injEq, Partial.Value.residual.injEq, + Partial.ResidualExpr.and.injEq, Partial.ResidualExpr.or.injEq, true_and] + case value v₁' => + cases hv₁' : v₁'.asBool <;> simp only [Except.bind_ok, Except.bind_err] <;> simp [hv₁'] at hₑ + case ok b₁' => + cases b₁' <;> simp only [Bool.true_eq_false, Bool.false_eq_true, reduceIte] + simp at hₑ + split at ih₂ <;> rename_i ih₂' + <;> simp at ih₂' <;> replace ⟨ih₂', ih₂''⟩ := ih₂' + · simp [ih₂', ih₂''] at hₑ + simp [ih₂''] + cases h₁ : Partial.evaluateValue ((x₂.substToPartialValue req).subst subsmap) (entities.subst subsmap) + <;> simp [h₁] at hₑ + case ok pv₂ => + exfalso -- h₁ and ih₂'' contradict + simp only [Subst.subst_substToPartialValue x₂ h_req] at h₁ + simp only [← Evaluate.evaluate_eqv_evalValue_substToPartialValue _ _ wf_r', ih₂''] at h₁ + · rename_i hₑ'' + subst ih₂' ih₂'' + simp only [ih₂] at hₑ'' + simp only [Subst.subst_substToPartialValue x₂ h_req] + simp only [Evaluate.evaluate_eqv_evalValue_substToPartialValue _ _ wf_r'] + case residual r₁' => exact Subst.subst_substToPartialValue x₂ h_req + } + +end Cedar.Thm.Partial.Evaluation.Reevaluation.AndOr diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Binary.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Binary.lean new file mode 100644 index 000000000..21f06ad89 --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Binary.lean @@ -0,0 +1,113 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Thm.Partial.Evaluation.Evaluate +import Cedar.Thm.Partial.Evaluation.EvaluateBinaryApp +import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed + +namespace Cedar.Thm.Partial.Evaluation.Reevaluation.Binary + +open Cedar.Data +open Cedar.Partial (Subsmap Unknown) +open Cedar.Spec (BinaryOp Error) + +/-- + Inductive argument that re-evaluation of a `Spec.Expr.binaryApp` with a + substitution on the residual expression, is equivalent to substituting first + and then evaluating on the original `Spec.Expr.binaryApp`. +-/ +theorem reeval_eqv_substituting_first {x₁ x₂ : Spec.Expr} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) + (ih₁ : ReevalEquivSubstFirst x₁ req req' entities subsmap) + (ih₂ : ReevalEquivSubstFirst x₂ req req' entities subsmap) : + ReevalEquivSubstFirst (Spec.Expr.binaryApp op x₁ x₂) req req' entities subsmap +:= by + unfold ReevalEquivSubstFirst at * + simp only [Partial.evaluate] + intro h_req ; specialize ih₁ h_req ; specialize ih₂ h_req + simp only at ih₁ ih₂ + split <;> try trivial + rename_i hₑ h₁ + cases hx₁ : Partial.evaluate x₁ req entities + <;> cases hx₂ : Partial.evaluate x₂ req entities + <;> simp [hx₁] at ih₁ h₁ + <;> simp [hx₂] at ih₂ h₁ + <;> replace ⟨h₁, h₁'⟩ := h₁ <;> subst h₁ h₁' + case error.error e₁ e₂ | error.ok e₁ pval₂ => + have ⟨e₁', hx₁'⟩ := Evaluate.subst_preserves_errors wf_r wf_e wf_s h_req hx₁ + simp [hx₁, hx₁'] at hₑ + case ok.error pval₁ e₂ => + specialize hₑ e₂ + have ⟨e₂', hx₂'⟩ := Evaluate.subst_preserves_errors wf_r wf_e wf_s h_req hx₂ + simp only [hx₂', Except.bind_err, imp_false, true_implies] at hₑ + cases hx₁' : Partial.evaluate x₁ req' (entities.subst subsmap) + <;> simp [hx₁'] at hₑ + case ok.ok pval₁ pval₂ => + simp only [Except.bind_ok] + have wf₁ : pval₁.WellFormed := Evaluate.partial_eval_wf wf_r wf_e _ hx₁ + have wf₂ : pval₂.WellFormed := Evaluate.partial_eval_wf wf_r wf_e _ hx₂ + have h₁ := EvaluateBinaryApp.reeval_eqv_substituting_first op pval₁ pval₂ entities subsmap wf₁ wf₂ + split at ih₁ <;> rename_i ih₁' + <;> simp only [Prod.mk.injEq] at ih₁' <;> replace ⟨ih₁', ih₁''⟩ := ih₁' + <;> split at ih₂ <;> rename_i ih₂' + <;> simp only [Prod.mk.injEq] at ih₂' <;> replace ⟨ih₂', ih₂''⟩ := ih₂' + <;> simp only [ih₁'', ih₂'', Except.bind_err, Except.error.injEq, imp_false, + forall_apply_eq_imp_iff] at hₑ + <;> simp [ih₁, ih₁', ih₁'', ih₂, ih₂', ih₂''] at h₁ + · exfalso + split at h₁ <;> rename_i h₁' + <;> simp only [Prod.mk.injEq] at h₁' <;> replace ⟨h₁', h₁''⟩ := h₁' + · rename_i e₁ e₂ _ e₃ e₄ _ e₅ e₆ + apply hₑ e₅ ; clear hₑ + simp only [h₁', Except.error.injEq, forall_eq'] + · rename_i hₑ' + subst h₁' h₁'' + simp only [h₁, Except.error.injEq, imp_false, forall_apply_eq_imp_iff, forall_eq'] at hₑ' + · exfalso + split at h₁ <;> rename_i h₁' + <;> simp only [Prod.mk.injEq] at h₁' <;> replace ⟨h₁', h₁''⟩ := h₁' + · simp [h₁'] at hₑ + · subst ih₂' ih₂'' h₁' h₁'' + rename_i hₑ' + simp [h₁] at hₑ' + · exfalso + subst ih₁' ih₁'' + split at h₁ <;> rename_i h₁' + <;> simp only [Prod.mk.injEq] at h₁' <;> replace ⟨h₁', h₁''⟩ := h₁' + · rename_i e₁ e₂ _ _ e₃ e₄ + specialize hₑ e₃ + simp only [h₁', true_implies] at hₑ + cases h₂ : Partial.evaluate x₁ req' (entities.subst subsmap) + <;> simp only [h₂, Except.bind_ok, Except.bind_err, Except.error.injEq, forall_eq'] at h₁'' hₑ + · subst h₁' h₁'' + rename_i e₁ e₂ _ _ hₑ' + cases h₂ : Partial.evaluate x₁ req' (entities.subst subsmap) + <;> simp only [h₂, Except.bind_ok, Except.bind_err, Except.error.injEq, imp_false, + forall_apply_eq_imp_iff] at ih₁ h₁ hₑ' + case error e₃ => + specialize hₑ' e₃ + simp only [h₁, not_true_eq_false] at hₑ' + case ok pv => + simp only [h₁, Except.error.injEq, forall_eq'] at hₑ' + · subst ih₁' ih₁'' ih₂' ih₂'' + simp only [imp_false, ih₁, h₁, ih₂] at * + + +end Cedar.Thm.Partial.Evaluation.Reevaluation.Binary diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Call.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Call.lean new file mode 100644 index 000000000..b218dba6a --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Call.lean @@ -0,0 +1,167 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Thm.Partial.Evaluation.Evaluate +import Cedar.Thm.Partial.Evaluation.EvaluateCall +import Cedar.Thm.Partial.Evaluation.EvaluateValue +import Cedar.Thm.Partial.Evaluation.ReevaluateValue +import Cedar.Thm.Partial.Evaluation.Reevaluation.Set +import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed + +namespace Cedar.Thm.Partial.Evaluation.Reevaluation.Call + +open Cedar.Data +open Cedar.Partial (Subsmap Unknown) +open Cedar.Spec (Error ExtFun Prim Result) + +/-- + something akin to `EvaluateValue.subst_preserves_errors`, lifted to + lists of `Partial.Value` + + NOTE: As of this writing, not used +-/ +theorem mapM_subst_preserves_errors {pvals : List Partial.Value} {req req' : Partial.Request} {entities : Partial.Entities} {e : Error} + (wf_v : ∀ pval ∈ pvals, pval.WellFormed) + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + req.subst subsmap = some req' → + (pvals.mapM λ pval => Partial.evaluateValue pval entities) = .error e → + ∃ e', (pvals.mapM λ pval => Partial.evaluateValue (pval.subst subsmap) (entities.subst subsmap)) = .error e' +:= by + intro h_req h₁ + replace ⟨pval, h_pval, h₁⟩ := List.mapM_error_implies_exists_error h₁ + have ⟨e', h₁'⟩ := EvaluateValue.subst_preserves_errors (wf_v pval h_pval) wf_e wf_s h₁ + exact List.element_error_implies_mapM_error + (f := λ pval => Partial.evaluateValue (pval.subst subsmap) (entities.subst subsmap)) + h_pval + h₁' + +/-- + Inductive argument that re-evaluation of a `Spec.Expr.call` with a + substitution on the residual expression, is equivalent to substituting first + and then evaluating on the original `Spec.Expr.call`. +-/ +theorem reeval_eqv_substituting_first {xs : List Spec.Expr} {xfn : ExtFun} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) + (ih : ∀ x ∈ xs, ReevalEquivSubstFirst x req req' entities subsmap) : + ReevalEquivSubstFirst (Spec.Expr.call xfn xs) req req' entities subsmap +:= by + have h := Set.mapM_reeval_eqv_substituting_first wf_r wf_e wf_s ih + unfold ReevalEquivSubstFirst at * + simp only [Partial.evaluate] + simp only at ih + rw [ + List.mapM₁_eq_mapM (Partial.evaluate · req entities), + List.mapM₁_eq_mapM (Partial.evaluate · req' (entities.subst subsmap)), + ] + split + · simp only [implies_true] + · rename_i hₑ h₁ + intro h_req ; simp [h_req] at ih ; specialize h h_req + simp at h₁ ; replace ⟨h₁, h₁'⟩ := h₁ ; subst h₁ h₁' + cases hxs : xs.mapM (Partial.evaluate · req entities) + <;> simp [hxs] at hₑ h <;> simp [hxs] + <;> cases hxs' : xs.mapM (λ x => Partial.evaluate x req' (entities.subst subsmap)) + <;> simp [hxs'] at hₑ h <;> simp [hxs'] + case ok.error pvals e => + -- evaluating `xs` before substitution produced residuals, but after + -- substitution, one of them produced the error `e` + replace ⟨x, hx, hxs'⟩ := List.mapM_error_implies_exists_error hxs' + -- `x` is the input expression that produced error `e` after substitution + have hc := EvaluateCall.reeval_eqv_substituting_first pvals xfn entities h_req + simp only at hc + exact match h₁ : Partial.evaluate x req entities with + | .error e' => by + replace ⟨pval, _, hxs⟩ := List.mapM_ok_implies_all_ok hxs x hx + simp [h₁] at hxs + | .ok (.value v) => by + simp [Evaluate.subst_preserves_evaluation_to_value wf_r wf_e wf_s h_req h₁] at hxs' + | .ok (.residual r) => by + -- evaluating the argument `x` before substitution produced (`.residual r`), + -- but evaluating `x` after substitution produced the error `e`, + -- so we need to show that re-evaluating the call residual with that + -- substitution also produces an error (not necessarily the same error) + suffices ∃ e, (do let residual ← Partial.evaluateCall xfn pvals ; Partial.evaluateValue (residual.subst subsmap) (entities.subst subsmap)) = .error e by + replace ⟨e, this⟩ := this + exfalso ; exact hₑ e this + clear hₑ + have h₂ : (Partial.Value.residual r) ∈ pvals := by + replace ⟨pval, h₄, hxs⟩ := List.mapM_ok_implies_all_ok hxs x hx + simp [hxs] at h₁ ; subst h₁ + exact h₄ + split at hc <;> rename_i hc' + <;> simp only [Prod.mk.injEq] at hc' <;> replace ⟨hc', hc''⟩ := hc' + · rename_i e' e'' + exists e' + · rename_i hₑ' + subst hc' hc'' + simp only [hc, List.map_map, List.mapM_map, Function.comp_apply] ; clear hc + -- using `hc` has reduced our proof obligation to showing that the + -- subst-first evaluation produces (any) error. + -- Our strategy for doing this will revolve around the fact that we know + -- that evaluating one of the arguments itself (`x`) produced an error + -- in the subst-first evaluation (`hxs'`). + suffices ∃ e, (pvals.mapM λ pval => Partial.evaluateValue (pval.subst subsmap) (entities.subst subsmap)) = .error e by + replace ⟨e, this⟩ := this + exists e + simp [this] + suffices ∃ e, Partial.evaluateValue ((Partial.Value.residual r).subst subsmap) (entities.subst subsmap) = .error e by + replace ⟨e, this⟩ := this + exact List.element_error_implies_mapM_error h₂ this + simp [Partial.Value.subst] + specialize ih x hx + simp only [h₁, Partial.Value.subst, Except.bind_ok] at ih + cases hr' : r.subst subsmap + case value v => + simp only [hr', EvaluateValue.eval_spec_value v] at ih + simp only [← ih] at hxs' + all_goals { + simp only [hr'] at ih + split at ih <;> rename_i ih' + <;> simp only [Prod.mk.injEq] at ih' <;> replace ⟨ih', ih''⟩ := ih' + · rename_i e' e'' + exists e' + · subst ih' ih'' + simp [ih] + exists e + } + case ok.ok pvals pvals' => + -- evaluating `xs` before substitution produced `pvals`, and after + -- substitution, produced `pvals'` + have hc := EvaluateCall.reeval_eqv_substituting_first pvals xfn entities h_req + simp only at hc + split at hc <;> rename_i hc' + <;> simp only [Prod.mk.injEq] at hc' <;> replace ⟨hc', hc''⟩ := hc' + · -- `evaluateCall` produced an error, both re-evaluated (`hc'`) and subst-first (`hc''`) + -- (when substituting on `pvals`, that is, after evaluating `xs` (`hxs`).) + -- Need to show that it also produces an error subst-first on `xs` (`hxs'`). + rename_i e e' + simp only [hc', Except.error.injEq] at * + suffices ∃ e, Partial.evaluateCall xfn pvals' = .error e by + replace ⟨e'', this⟩ := this + exfalso ; exact hₑ e e'' rfl this + clear hₑ + simp [List.mapM_map, h] at hc'' + exists e' + · subst hc' hc'' + simp [h, hc, List.mapM_map] + +end Cedar.Thm.Partial.Evaluation.Reevaluation.Call diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/GetAttr.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/GetAttr.lean new file mode 100644 index 000000000..bd0f8efbe --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/GetAttr.lean @@ -0,0 +1,107 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Thm.Partial.Evaluation.Evaluate +import Cedar.Thm.Partial.Evaluation.EvaluateGetAttr +import Cedar.Thm.Partial.Evaluation.ReevaluateGetAttr +import Cedar.Thm.Partial.Evaluation.ReevaluateValue +import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed + +namespace Cedar.Thm.Partial.Evaluation.Reevaluation.GetAttr + +open Cedar.Data +open Cedar.Partial (Subsmap Unknown) +open Cedar.Spec (Attr EntityUID Error Prim) + +/-- + Inductive argument that re-evaluation of a `Spec.Expr.getAttr` with a + substitution on the residual expression, is equivalent to substituting first + and then evaluating on the original `Spec.Expr.getAttr`. +-/ +theorem reeval_eqv_substituting_first {x₁ : Spec.Expr} {attr : Attr} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) + (ih₁ : ReevalEquivSubstFirst x₁ req req' entities subsmap) : + ReevalEquivSubstFirst (Spec.Expr.getAttr x₁ attr) req req' entities subsmap +:= by + unfold ReevalEquivSubstFirst at * + simp only [Partial.evaluate] + split <;> try simp only [implies_true] + rename_i hₑ h₁ + simp at h₁ ; replace ⟨h₁, h₁'⟩ := h₁ ; subst h₁ h₁' + intro h_req ; specialize ih₁ h_req + simp only at ih₁ + split at ih₁ <;> rename_i ih₁' + <;> simp at ih₁' <;> replace ⟨ih₁', ih₁''⟩ := ih₁' + <;> simp [ih₁''] + · -- the case where ih₁' and ih₁'' tell us they're both errors + exfalso + rename_i e e' + simp [ih₁''] at hₑ + cases hx₁ : Partial.evaluate x₁ req entities <;> simp [hx₁] at hₑ ih₁' + case ok pval₁ => + have wf₁ : pval₁.WellFormed := Evaluate.partial_eval_wf wf_r wf_e pval₁ hx₁ + have h₁ := ReevaluateGetAttr.reeval_eqv_substituting_first pval₁ attr wf_e wf_s wf₁ + simp only at h₁ ; split at h₁ <;> rename_i h₁' + <;> simp only [Prod.mk.injEq] at h₁' <;> replace ⟨h₁', h₁''⟩ := h₁' + · simp only [h₁', Except.error.injEq, forall_eq'] at hₑ + · rename_i hₑ' + subst h₁' h₁'' + simp only [ih₁', Except.bind_err, Except.error.injEq, imp_false, forall_apply_eq_imp_iff] at hₑ' + simp only [ih₁', Except.bind_err] at h₁ + apply hₑ' e ; clear hₑ' + apply h₁ ; clear h₁ + intro v pv pv' wf_v h₁ h₂ + apply ReevaluateValue.reeval_eqv_substituting_first _ wf_e wf_s h₂ + exact EvaluateGetAttr.getAttr_wf wf_v wf_e _ h₁ + · rename_i hₑ' -- the case where hₑ' tells us they're not both errors + subst ih₁' ih₁'' + cases hx₁ : Partial.evaluate x₁ req entities + case error e₁ => + have ⟨e₁', hx₁'⟩ := Evaluate.subst_preserves_errors wf_r wf_e wf_s h_req hx₁ + simp [hx₁, hx₁'] at hₑ + case ok pval₁ => + have wf₁ : pval₁.WellFormed := Evaluate.partial_eval_wf wf_r wf_e pval₁ hx₁ + simp only [Except.bind_ok] + have h₁ := ReevaluateGetAttr.reeval_eqv_substituting_first pval₁ attr wf_e wf_s wf₁ + simp only at h₁ ; split at h₁ <;> rename_i h₁' + <;> simp only [Prod.mk.injEq] at h₁' <;> replace ⟨h₁', h₁''⟩ := h₁' + · exfalso + simp only [hx₁, Except.bind_ok] at ih₁ hₑ hₑ' + simp only [ih₁] at hₑ' h₁'' + cases h₂ : Partial.evaluate x₁ req' (entities.subst subsmap) + <;> simp only [h₂, Except.bind_ok, Except.bind_err] at * + case error e => exact hₑ' e e rfl rfl + case ok x₁' => + simp only [h₁'', Except.error.injEq, forall_apply_eq_imp_iff] at hₑ + cases h₃ : Partial.evaluateGetAttr pval₁ attr entities + <;> simp only [h₃, Except.bind_ok, Except.bind_err] at * + case error e => exact hₑ e rfl + case ok pval₁' => simp only [h₁', Except.error.injEq, imp_false, forall_eq'] at hₑ + · rename_i hₑ'' + subst h₁' h₁'' + simp only [← ih₁] at * + simp only [hx₁, Except.bind_ok] + apply h₁ ; clear h₁ + intro v pv pv' wf_v h₁ h₂ + apply ReevaluateValue.reeval_eqv_substituting_first _ wf_e wf_s h₂ + exact EvaluateGetAttr.getAttr_wf wf_v wf_e _ h₁ + + +end Cedar.Thm.Partial.Evaluation.Reevaluation.GetAttr diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/HasAttr.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/HasAttr.lean new file mode 100644 index 000000000..faf885007 --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/HasAttr.lean @@ -0,0 +1,99 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Thm.Partial.Evaluation.Evaluate +import Cedar.Thm.Partial.Evaluation.EvaluateHasAttr +import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed + +namespace Cedar.Thm.Partial.Evaluation.Reevaluation.HasAttr + +open Cedar.Data +open Cedar.Partial (Subsmap Unknown) +open Cedar.Spec (Attr) + +/-- + If `Partial.evaluateHasAttr` returns a residual, re-evaluating that residual with a + substitution is equivalent to substituting first, evaluating the arg, and calling + `Partial.evaluateHasAttr` on the substituted/evaluated arg +-/ +theorem reeval_eqv_substituting_first_evaluateHasAttr (pval₁ : Partial.Value) (attr : Attr) (entities : Partial.Entities) {req req' : Partial.Request} {subsmap : Subsmap} + (wf_e : entities.WellFormed) + (wf₁ : pval₁.WellFormed) : + req.subst subsmap = some req' → + (Partial.evaluateHasAttr pval₁ attr entities >>= λ residual => Partial.evaluateValue (residual.subst subsmap) (entities.subst subsmap)) = + (Partial.evaluateValue (pval₁.subst subsmap) (entities.subst subsmap) >>= λ pval' => Partial.evaluateHasAttr pval' attr (entities.subst subsmap)) +:= by + unfold Partial.evaluateHasAttr + cases pval₁ <;> simp [Partial.Value.WellFormed] at wf₁ + case value v₁ => + simp [Subst.subst_concrete_value, Partial.evaluateValue] + rw [← EvaluateHasAttr.hasAttr_subst_const wf_e] + cases Partial.hasAttr v₁ attr entities + case error e => simp only [Except.bind_err, implies_true] + case ok v => simp only [Partial.evaluateValue, Except.bind_ok, implies_true] + case residual r₁ => + simp [Partial.Value.subst, Partial.ResidualExpr.subst] + simp [Partial.evaluateValue, Partial.evaluateResidual] + cases Partial.evaluateValue (r₁.subst subsmap) (entities.subst subsmap) + case error e => simp only [Except.bind_err, implies_true] + case ok r₁' => simp only [Partial.evaluateHasAttr, Except.bind_ok, implies_true] + +/-- + Inductive argument that re-evaluation of a `Spec.Expr.hasAttr` with a + substitution on the residual expression, is equivalent to substituting first + and then evaluating on the original `Spec.Expr.hasAttr`. +-/ +theorem reeval_eqv_substituting_first {x₁ : Spec.Expr} {attr : Attr} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) + (ih₁ : ReevalEquivSubstFirst x₁ req req' entities subsmap) : + ReevalEquivSubstFirst (Spec.Expr.hasAttr x₁ attr) req req' entities subsmap +:= by + unfold ReevalEquivSubstFirst at * + simp only [Partial.evaluate] + split <;> try simp only [implies_true] + rename_i hₑ h₁ + simp at h₁ ; replace ⟨h₁, h₁'⟩ := h₁ ; subst h₁ h₁' + intro h_req ; specialize ih₁ h_req + simp only at ih₁ + split at ih₁ <;> rename_i ih₁' + <;> simp at ih₁' <;> replace ⟨ih₁', ih₁''⟩ := ih₁' + <;> simp [ih₁''] + · -- the case where ih₁' and ih₁'' tell us they're both errors + exfalso + rename_i e e' + simp [ih₁''] at hₑ + cases hx₁ : Partial.evaluate x₁ req entities <;> simp [hx₁] at hₑ ih₁' + case ok pval₁ => + have wf₁ : pval₁.WellFormed := Evaluate.partial_eval_wf wf_r wf_e pval₁ hx₁ + rw [reeval_eqv_substituting_first_evaluateHasAttr pval₁ attr entities wf_e wf₁ h_req] at hₑ + simp [ih₁'] at hₑ + · rename_i hₑ' -- the case where hₑ' tells us they're not both errors + subst ih₁' ih₁'' + cases hx₁ : Partial.evaluate x₁ req entities + case error e₁ => + have ⟨e₁', hx₁'⟩ := Evaluate.subst_preserves_errors wf_r wf_e wf_s h_req hx₁ + simp [hx₁, hx₁'] at hₑ + case ok pval₁ => + have wf₁ : pval₁.WellFormed := Evaluate.partial_eval_wf wf_r wf_e pval₁ hx₁ + simp + rw [reeval_eqv_substituting_first_evaluateHasAttr pval₁ attr entities wf_e wf₁ h_req] + simp [← ih₁, hx₁] + +end Cedar.Thm.Partial.Evaluation.Reevaluation.HasAttr diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Ite.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Ite.lean new file mode 100644 index 000000000..b53d27a0a --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Ite.lean @@ -0,0 +1,168 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Thm.Partial.Evaluation.Evaluate +import Cedar.Thm.Partial.Evaluation.Props +import Cedar.Thm.Partial.Subst + +namespace Cedar.Thm.Partial.Evaluation.Reevaluation.Ite + +open Cedar.Data +open Cedar.Partial (Subsmap Unknown) +open Cedar.Spec (Prim) + +/-- + Inductive argument that re-evaluation of a `Spec.Expr.ite` with a + substitution on the residual expression, is equivalent to substituting first + and then evaluating on the original `Spec.Expr.ite`. +-/ +theorem reeval_eqv_substituting_first {x₁ x₂ x₃ : Spec.Expr} {entities : Partial.Entities} {req req' : Partial.Request} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) + (ih₁ : ReevalEquivSubstFirst x₁ req req' entities subsmap) + (ih₂ : ReevalEquivSubstFirst x₂ req req' entities subsmap) + (ih₃ : ReevalEquivSubstFirst x₃ req req' entities subsmap) : + ReevalEquivSubstFirst (Spec.Expr.ite x₁ x₂ x₃) req req' entities subsmap +:= by + unfold ReevalEquivSubstFirst at * + simp only [Partial.evaluate, bind_assoc] + intro h_req + have wf_r' : req'.WellFormed := Subst.req_subst_preserves_wf wf_r wf_s h_req + specialize ih₁ h_req ; specialize ih₂ h_req ; specialize ih₃ h_req + split <;> try trivial + rename_i hₑ h₁ + cases hx₁ : Partial.evaluate x₁ req entities + <;> simp [hx₁] at ih₁ h₁ <;> simp [hx₁] + <;> replace ⟨h₁, h₁'⟩ := h₁ <;> subst h₁ h₁' + case error e₁ => + have ⟨e₁', hx₁'⟩ := Evaluate.subst_preserves_errors wf_r wf_e wf_s h_req hx₁ + simp [hx₁, hx₁'] at hₑ + case ok pval₁ => + have wf₁ : pval₁.WellFormed := Evaluate.partial_eval_wf wf_r wf_e _ hx₁ + cases pval₁ + <;> simp only [bind_assoc, Except.bind_ok] + <;> simp only [Partial.Value.WellFormed] at wf₁ + case value v₁ => + simp at hₑ + split at ih₁ <;> rename_i ih₁' + <;> simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value v₁] at ih₁' + <;> replace ⟨ih₁', ih₁''⟩ := ih₁' <;> subst ih₁' ih₁'' + <;> simp [← ih₁] + <;> simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value v₁] + <;> cases v₁ + <;> simp only [Spec.Value.asBool] + <;> simp only [Spec.Value.asBool] at hₑ + case prim p₁ _ => + cases p₁ <;> simp + case bool b₁ _ => + simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value b₁] at ih₁ + cases hx₂ : Partial.evaluate x₂ req entities + <;> cases hx₃ : Partial.evaluate x₃ req entities + <;> simp [hx₂] at ih₂ hₑ + <;> simp [hx₃] at ih₃ hₑ + <;> cases b₁ <;> simp at hₑ + -- in the following, case names are (x₂ evaluation result, x₃ evaluation result, b₁ value) + case ok.ok.true pval₂ pval₃ _ | ok.error.true pval₂ e₃ _ => + have wf₂ : pval₂.WellFormed := Evaluate.partial_eval_wf wf_r wf_e _ hx₂ + cases pval₂ <;> simp <;> simp [Partial.Value.WellFormed] at wf₂ + case value v₂ => + split at ih₂ <;> rename_i ih₂' + · simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value v₂] at ih₂' + · simp at ih₂' ; replace ⟨ih₂', ih₂''⟩ := ih₂' ; subst ih₂' ih₂'' + simp [← ih₂] + case residual r₂ => + split at ih₂ <;> rename_i ih₂' + <;> simp at ih₂' <;> replace ⟨ih₂', ih₂''⟩ := ih₂' + · rename_i e₂'' e₂' + simp only [ih₂''] + simp only [← ih₁, ih₂'', Except.bind_ok] at hₑ + simp [Partial.Value.subst] at ih₂' hₑ + simp [ih₂'] at hₑ + · subst ih₂' ih₂'' + simp only [← ih₂] + case ok.ok.false pval₂ pval₃ _ | error.ok.false e₂ pval₃ _ => + have wf₃ : pval₃.WellFormed := Evaluate.partial_eval_wf wf_r wf_e _ hx₃ + cases pval₃ <;> simp <;> simp [Partial.Value.WellFormed] at wf₃ + case value v₃ => + split at ih₃ <;> rename_i ih₃' + · simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value v₃] at ih₃' + · simp at ih₃' ; replace ⟨ih₃', ih₃''⟩ := ih₃' ; subst ih₃' ih₃'' + simp [← ih₃] + case residual r₃ => + split at ih₃ <;> rename_i ih₃' + <;> simp at ih₃' <;> replace ⟨ih₃', ih₃''⟩ := ih₃' + · rename_i e₃'' e₃' + simp only [ih₃''] + simp only [← ih₁, ih₃'', Except.bind_ok] at hₑ + simp [Partial.Value.subst] at ih₃' hₑ + simp [ih₃'] at hₑ + · subst ih₃' ih₃'' + simp only [← ih₃] + case error.error.true e₂ e₃ _ | error.ok.true e₂ pval₃ _ => + split at ih₂ <;> rename_i ih₂' + <;> simp at ih₂' <;> replace ⟨ih₂', ih₂''⟩ := ih₂' + · rename_i e₂'' e₂' + simp [← ih₁, ih₂'', Except.bind_ok] at hₑ + · subst ih₂' ih₂'' + simp [← ih₁, ← ih₂, Except.bind_ok] at hₑ + case error.error.false e₂ e₃ _ | ok.error.false pval₂ e₃ _ => + split at ih₃ <;> rename_i ih₃' + <;> simp at ih₃' <;> replace ⟨ih₃', ih₃''⟩ := ih₃' + · rename_i e₃'' e₃' + simp [← ih₁, ih₃'', Except.bind_ok] at hₑ + · subst ih₃' ih₃'' + simp [← ih₁, ← ih₃, Except.bind_ok] at hₑ + all_goals simp only [Except.bind_err] + case residual r₁ => + simp only [Partial.Value.subst, Except.bind_ok, Partial.ResidualExpr.subst, + Partial.evaluateValue, Partial.evaluateResidual, imp_false] at * + split at ih₁ <;> rename_i ih₁' + <;> simp at ih₁' <;> replace ⟨ih₁', ih₁''⟩ := ih₁' + · exfalso + simp only [ih₁', Except.bind_err, Except.error.injEq, ih₁'', forall_apply_eq_imp_iff, + imp_false, forall_eq'] at hₑ + · subst ih₁' ih₁'' + simp only [ih₁] + cases hx₁' : Partial.evaluate x₁ req' (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err] + case ok pv₁' => + cases pv₁' <;> simp only [Except.ok.injEq, Partial.Value.residual.injEq, + Partial.ResidualExpr.ite.injEq, true_and] + case residual r₁' => + exact And.intro (Subst.subst_substToPartialValue x₂ h_req) (Subst.subst_substToPartialValue x₃ h_req) + case value v₁' => + rw [Subst.subst_substToPartialValue x₂ h_req] + rw [Subst.subst_substToPartialValue x₃ h_req] + cases v₁'.asBool <;> simp only [Except.bind_ok, Except.bind_err] + case ok b₁' => + cases b₁' <;> simp only [Bool.false_eq_true, reduceIte] + case true => + split at ih₂ <;> rename_i ih₂' <;> simp only [Prod.mk.injEq] at ih₂' <;> replace ⟨_, ih₂'⟩ := ih₂' + · simp only [ih₂'] + rw [Evaluate.evaluate_eqv_evalValue_substToPartialValue x₂ _ wf_r'] at ih₂' + exact ih₂' + · exact (Evaluate.evaluate_eqv_evalValue_substToPartialValue x₂ _ wf_r').symm + case false => + split at ih₃ <;> rename_i ih₃' <;> simp only [Prod.mk.injEq] at ih₃' <;> replace ⟨_, ih₃'⟩ := ih₃' + · simp only [ih₃'] + rw [Evaluate.evaluate_eqv_evalValue_substToPartialValue x₃ _ wf_r'] at ih₃' + exact ih₃' + · exact (Evaluate.evaluate_eqv_evalValue_substToPartialValue x₃ _ wf_r').symm + + +end Cedar.Thm.Partial.Evaluation.Reevaluation.Ite diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Record.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Record.lean new file mode 100644 index 000000000..8c4b248c0 --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Record.lean @@ -0,0 +1,479 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Thm.Partial.Evaluation.Evaluate +import Cedar.Thm.Partial.Evaluation.Evaluate.Lemmas +import Cedar.Thm.Partial.Evaluation.Evaluate.Record +import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed + +namespace Cedar.Thm.Partial.Evaluation.Reevaluation.Record + +open Cedar.Data +open Cedar.Partial (Subsmap Unknown) +open Cedar.Spec (Attr Error Prim Result) + +/-- + If evaluating any value in a `Partial.Value.record` produces an error, then + evaluating the whole `Partial.Value.record` must also produce an error (not + necessarily the same error) +-/ +theorem element_error_implies_record_error {k : Attr} {pv : Partial.Value} {attrs : List (Attr × Partial.Value)} {entities : Partial.Entities} {e : Error} : + (k, pv) ∈ attrs → + Partial.evaluateValue pv entities = .error e → + ∃ e', Partial.evaluateValue (.residual (.record attrs)) entities = .error e' +:= by + intro h₁ h₂ + simp only [Partial.evaluateValue, Partial.evaluateResidual, + Evaluate.Record.mapM₂_eq_mapM_partial_bindAttr (Partial.evaluateValue · entities)] + cases h₃ : attrs.mapM (λ kv => Partial.bindAttr kv.fst (Partial.evaluateValue kv.snd entities)) + <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq, exists_eq'] + case ok pvals => + replace ⟨pval, _, h₃⟩ := List.mapM_ok_implies_all_ok h₃ (k, pv) h₁ + simp [h₂, Partial.bindAttr] at h₃ + +/-- + small lemma that we want to prove by induction, which is easier if we factor + it out and name it like this +-/ +theorem commute_prod_snd {kvs : List (α × Partial.Value)} {kvs' : List (α × Spec.Value)}: + kvs.mapM (λ kv => match kv.snd with + | .value v => some (kv.fst, v) + | .residual _ => none) + = some kvs' → + kvs.mapM (λ kv => match kv.snd with + | .value v => some v + | .residual _ => none) + = some (List.map Prod.snd kvs') +:= match kvs with + | [] => by simp ; intro h ; subst h ; simp + | (khd, vhd) :: tl => by + simp only [List.mapM_cons, Option.pure_def, Option.bind_eq_bind, Option.bind_eq_some, + Option.some.injEq, forall_exists_index, and_imp] + split + · simp only [Option.some.injEq, exists_eq_left', forall_eq'] + intro tl' htl' _ ; subst kvs' + exists (tl'.map Prod.snd) + simp only [commute_prod_snd htl', List.map_cons, and_self] + · simp only [false_and, exists_const, imp_false, false_implies, implies_true] + +/-- + Basically a statement of `ReevalEquivSubstFirst`, but for + `mapM Partial.bindAttr . (Partial.evaluate .)` instead of raw `Partial.evaluate` +-/ +-- Shares a lot of code and structure with the theorem of the same name in Partial/Reevaluation/Set.lean +theorem mapM_reeval_eqv_substituting_first {attrs : List (Attr × Spec.Expr)} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) + (ih : ∀ kv ∈ attrs, ReevalEquivSubstFirst kv.snd req req' entities subsmap) : + req.subst subsmap = some req' → + let re_evaluated := attrs.mapM (λ kv => Partial.bindAttr kv.fst (Partial.evaluate kv.snd req entities)) >>= λ residuals => residuals.mapM (λ kv => Partial.bindAttr kv.fst (Partial.evaluateValue (kv.snd.subst subsmap) (entities.subst subsmap))) + let subst_first := attrs.mapM (λ kv => Partial.bindAttr kv.fst (Partial.evaluate kv.snd req' (entities.subst subsmap))) + match (re_evaluated, subst_first) with + | (Except.error _, Except.error _) => true -- don't require that the errors are equal + | (_, _) => re_evaluated = subst_first +:= by + simp only + split + · simp only [implies_true] + · rename_i hₑ h₁ + simp at h₁ ; replace ⟨h₁, h₁'⟩ := h₁ ; subst h₁ h₁' + cases hattrs : attrs.mapM λ kv => Partial.bindAttr kv.fst (Partial.evaluate kv.snd req entities) + <;> simp [hattrs] at hₑ <;> simp [hattrs] + <;> cases hattrs' : attrs.mapM λ kv => Partial.bindAttr kv.fst (Partial.evaluate kv.snd req' (entities.subst subsmap)) + <;> simp [hattrs'] at hₑ + case error.ok e pvals => + intro h_req + exfalso + replace ⟨(k, x), hx, hattrs⟩ := List.mapM_error_implies_exists_error hattrs + simp only [Partial.bindAttr] at hattrs + rw [do_error] at hattrs + replace ⟨pval, _, hattrs'⟩ := List.mapM_ok_implies_all_ok hattrs' (k, x) hx + have ⟨e', hattrs''⟩ := Evaluate.subst_preserves_errors wf_r wf_e wf_s h_req hattrs + simp [Partial.bindAttr, hattrs''] at hattrs' + case ok.error pvals e => + -- evaluating `attrs` before substitution produced residuals, but after + -- substitution, one of them produced the error `e` + replace ⟨(k, x), hx, hattrs'⟩ := List.mapM_error_implies_exists_error hattrs' + simp only [Partial.bindAttr] at hattrs' + rw [do_error] at hattrs' + -- `x` is the input expression that produced error `e` after substitution + exact match h₁ : Partial.evaluate x req entities with + | .error e' => by + replace ⟨(k', pval), _, hattrs⟩ := List.mapM_ok_implies_all_ok hattrs (k, x) hx + simp [Partial.bindAttr, h₁] at hattrs + | .ok pv => by + intro h_req + cases pv + case value v => + simp [Evaluate.subst_preserves_evaluation_to_value wf_r wf_e wf_s h_req h₁] at hattrs' + case residual r => + specialize ih (k, x) hx h_req + simp [h₁] at ih + split at ih <;> rename_i ih' + <;> simp at ih' <;> replace ⟨ih', ih''⟩ := ih' + · rename_i e' e'' + simp [hattrs'] at ih'' ; subst e'' + suffices ∃ e, pvals.mapM (λ kv => Partial.bindAttr kv.fst (Partial.evaluateValue (kv.snd.subst subsmap) (entities.subst subsmap))) = .error e by + replace ⟨e, this⟩ := this + exfalso ; exact hₑ e this + clear hₑ + apply List.element_error_implies_mapM_error (x := (k, .residual r)) (e := e') + · replace ⟨(k', pval), h₃, hattrs⟩ := List.mapM_ok_implies_all_ok hattrs (k, x) hx + simp only [Partial.bindAttr] at hattrs + replace ⟨pval', hattrs, hattrs'⟩ := do_ok.mp hattrs + simp only [Prod.mk.injEq] at hattrs' ; replace ⟨hattrs', hattrs''⟩ := hattrs' ; subst k' pval' + simp [hattrs] at h₁ ; subst h₁ + exact h₃ + · simp [Partial.bindAttr, ih'] + · rename_i hₑ' + subst ih' ih'' + simp [hattrs', ih] at ih hₑ' + case ok.ok pvals pvals' => + -- evaluating `attrs` before substitution produced `pvals`, and after + -- substitution, produced `pvals'` + intro h_req + -- we proceed by induction on `attrs` + cases attrs <;> simp [pure, Except.pure] at * + case nil => subst pvals pvals' ; simp [pure, Except.pure] + case cons hd tl => + have (khd, vhd) := hd ; clear hd + have ⟨ih_hd, ih_tl⟩ := ih ; clear ih + have ih := mapM_reeval_eqv_substituting_first wf_r wf_e wf_s ih_tl h_req + -- the plan is to use `ih_hd` to dispatch the `hd`-related obligations, + -- and `ih` (not `ih_tl`) to dispatch the `tl`-related obligations + specialize ih_hd h_req + simp at ih_hd ; split at ih_hd <;> rename_i ih_hd' + · rename_i e e' + cases hhd : Partial.evaluate vhd req entities + <;> simp [hhd] at ih_hd' hattrs + case ok hd_pval => + cases htl : tl.mapM λ kv => Partial.bindAttr kv.fst (Partial.evaluate kv.snd req entities) + <;> simp only [htl, Except.bind_ok, Except.bind_err] at hattrs + <;> simp only [Partial.bindAttr, Except.bind_ok, Except.ok.injEq] at hattrs + case ok tl_pvals => + subst pvals + simp [Partial.bindAttr, ih_hd'] at hattrs' + case error e'' => + cases htl : tl.mapM λ kv => Partial.bindAttr kv.fst (Partial.evaluate kv.snd req entities) + <;> simp only [htl, Except.bind_ok, Except.bind_err] at hattrs + <;> simp only [Partial.bindAttr, Except.bind_err] at hattrs + · rename_i hₑ' + simp at ih_hd' ; replace ⟨ih_hd', ih_hd''⟩ := ih_hd' ; subst ih_hd' ih_hd'' + cases hhd : Partial.evaluate vhd req entities + <;> simp [hhd] at ih ih_hd hattrs hₑ' + case error e => simp only [Partial.bindAttr, Except.bind_err] at hattrs + case ok hd_pval => + simp [ih_hd] at hₑ' + cases htl : tl.mapM λ kv => Partial.bindAttr kv.fst (Partial.evaluate kv.snd req entities) + <;> simp only [htl, Except.bind_err, Except.bind_ok] at hattrs ih + <;> simp only [Partial.bindAttr, Except.bind_ok, Except.ok.injEq] at hattrs + case ok tl_pvals => + subst pvals + simp [ih_hd, pure, Except.pure] + cases hhd' : Partial.evaluate vhd req' (entities.subst subsmap) + <;> simp only [hhd'] at hattrs' + case error e => simp only [Partial.bindAttr, Except.bind_err] at hattrs' + case ok hd_pval' => + clear hₑ' + split at ih <;> rename_i ih' + <;> simp at ih' <;> replace ⟨ih', ih''⟩ := ih' + · simp only [ih'', Except.bind_err] at hattrs' + simp only [Partial.bindAttr, Except.bind_ok] at hattrs' + · rename_i hₑ' + subst ih' ih'' + simp [ih] + exact hattrs' + +/-- + Inductive argument that re-evaluation of a `Spec.Expr.record` with a + substitution on the residual expression, is equivalent to substituting first + and then evaluating on the original `Spec.Expr.record`. +-/ +-- TODO: there is significant duplication of the proof between this theorem and +-- `mapM_reeval_eqv_substituting_first` above. This theorem uses the one above +-- as a lemma in only one case. It could probably use it as a lemma in more +-- cases, to reduce duplication. +theorem reeval_eqv_substituting_first {attrs : List (Attr × Spec.Expr)} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) + (ih : ∀ kv ∈ attrs, ReevalEquivSubstFirst kv.snd req req' entities subsmap) : + ReevalEquivSubstFirst (Spec.Expr.record attrs) req req' entities subsmap +:= by + have h := mapM_reeval_eqv_substituting_first wf_r wf_e wf_s ih + have hsorted_attrs : attrs.SortedBy Prod.fst := sorry + unfold ReevalEquivSubstFirst at * + simp only [Partial.evaluate] + simp only at ih + rw [ + Evaluate.Record.mapM₂_eq_mapM_partial_bindAttr (Partial.evaluate · req entities), + Evaluate.Record.mapM₂_eq_mapM_partial_bindAttr (Partial.evaluate · req' (entities.subst subsmap)), + ] + split + · simp only [implies_true] + · rename_i hₑ h₁ + intro h_req ; simp [h_req] at ih ; specialize h h_req + simp at h₁ ; replace ⟨h₁, h₁'⟩ := h₁ ; subst h₁ h₁' + cases hattrs : attrs.mapM λ kv => Partial.bindAttr kv.fst (Partial.evaluate kv.snd req entities) + <;> simp [hattrs] at hₑ <;> simp [hattrs] + <;> cases hattrs' : attrs.mapM λ kv => Partial.bindAttr kv.fst (Partial.evaluate kv.snd req' (entities.subst subsmap)) + <;> simp [hattrs'] at hₑ <;> simp [hattrs'] + case error.ok e pvals => + replace ⟨x, hx, hattrs⟩ := List.mapM_error_implies_exists_error hattrs + replace ⟨pval, _, hattrs'⟩ := List.mapM_ok_implies_all_ok hattrs' x hx + simp only [Partial.bindAttr] at hattrs hattrs' + rw [do_error] at hattrs + have ⟨e', hattrs''⟩ := Evaluate.subst_preserves_errors wf_r wf_e wf_s h_req hattrs + simp [hattrs''] at hattrs' + case ok.error pvals e => + -- evaluating `attrs` before substitution produced residuals, but after + -- substitution, one of them produced the error `e` + replace ⟨(k, x), hx, hattrs'⟩ := List.mapM_error_implies_exists_error hattrs' + -- `x` is the input expression that produced error `e` after substitution + exact match h₁ : Partial.evaluate x req entities with + | .error e' => by + replace ⟨pval, _, hxs⟩ := List.mapM_ok_implies_all_ok hattrs (k, x) hx + simp [h₁, Partial.bindAttr] at hxs + | .ok pv => by + cases pv + case value v => + simp [Evaluate.subst_preserves_evaluation_to_value wf_r wf_e wf_s h_req h₁, Partial.bindAttr] at hattrs' + case residual r => + have h₂ : (k, .residual r) ∈ pvals := by + replace ⟨(k', pval), h₄, hattrs⟩ := List.mapM_ok_implies_all_ok hattrs (k, x) hx + simp only [Partial.bindAttr] at hattrs + replace ⟨pval', hattrs, hattrs'⟩ := do_ok.mp hattrs + simp only [Prod.mk.injEq] at hattrs' ; replace ⟨hattrs', hattrs''⟩ := hattrs' ; subst k' pval' + simp [hattrs] at h₁ ; subst h₁ + exact h₄ + have h₃ : pvals.mapM (λ kv => match kv.snd with | .value v => some v | .residual _ => none) = none := by + by_contra h₃ + simp [Option.ne_none_iff_exists'] at h₃ + replace ⟨vs, h₃⟩ := h₃ + replace ⟨v, _, h₃⟩ := List.mapM_some_implies_all_some h₃ (k, .residual r) h₂ + simp at h₃ + split at hₑ <;> rename_i h₄ + · rename_i avs + replace ⟨(k', pval), h_pval, h₃⟩ := List.mapM_none_iff_exists_none.mp h₃ + replace ⟨(k'', v), hv, h₄⟩ := List.mapM_some_implies_all_some h₄ (k', pval) h_pval + cases pval <;> simp at h₃ h₄ + · simp at * + specialize ih (k, x) hx + simp [h₁] at ih + split at ih <;> rename_i ih' + <;> simp at ih' <;> replace ⟨ih', ih''⟩ := ih' + · exfalso + rename_i e' e'' + simp only [Partial.Value.subst] at hₑ + suffices ∃ e, Partial.evaluateValue ((Partial.ResidualExpr.record pvals).subst subsmap) (entities.subst subsmap) = .error e by + replace ⟨e, this⟩ := this + exact hₑ e this + clear hₑ + simp only [Partial.ResidualExpr.subst, List.map_attach₂_snd] + apply element_error_implies_record_error (k := k) (pv := (Partial.Value.residual r).subst subsmap) _ ih' + simp only [List.mem_map, Prod.mk.injEq] + exists (k, .residual r) + · rename_i hₑ' + subst ih' ih'' + simp only [Partial.bindAttr] at hattrs' + rw [do_error] at hattrs' + simp only [hattrs', Except.error.injEq, imp_false, forall_apply_eq_imp_iff] at ih hₑ' + simp [ih] at hₑ' + case ok.ok pvals pvals' => + -- evaluating `attrs` before substitution produced `pvals`, and after + -- substitution, produced `pvals'` + split <;> rename_i h₁ <;> simp + · -- `pvals` is actually fully concrete + rename_i avs + clear hₑ + have h_pvals : pvals = pvals' := by + suffices Except.ok (ε := Error) pvals = Except.ok pvals' by simpa using this + suffices attrs.mapM (λ kv => Partial.bindAttr kv.fst (Partial.evaluate kv.snd req' (entities.subst subsmap))) = .ok pvals by + rw [← this, ← hattrs'] + apply Evaluate.Record.mapM_subst_snd_preserves_evaluation_to_values _ h_req pvals hattrs _ + · unfold SubstPreservesEvaluationToConcrete + intro x _ h_req v hx + exact Evaluate.subst_preserves_evaluation_to_value wf_r wf_e wf_s h_req hx + · unfold IsAllConcrete + exists (avs.map Prod.snd) + simp [List.mapM_map] + exact commute_prod_snd h₁ + subst pvals' + simp [h₁, Subst.subst_concrete_value, EvaluateValue.eval_spec_value] + · -- `pvals` is not fully concrete; that is, it contains at least one `.residual` + clear hₑ + simp only [Partial.Value.subst, Partial.ResidualExpr.subst, List.map_attach₂_snd] + simp only [Partial.evaluateValue, Partial.evaluateResidual, Evaluate.Record.mapM₂_eq_mapM_partial_bindAttr (Partial.evaluateValue · (entities.subst subsmap))] + simp only [List.mapM_map] + cases h₂ : pvals.mapM λ kv => Partial.bindAttr kv.fst (Partial.evaluateValue (kv.snd.subst subsmap) (entities.subst subsmap)) + case error e => + exfalso + replace ⟨(k, pval), h_pval, h₂⟩ := List.mapM_error_implies_exists_error h₂ + simp only [Partial.bindAttr, do_error] at h₂ + have wf₁ : pval.WellFormed := by + apply Evaluate.partial_eval_wf_mapM_snd wf_r wf_e _ hattrs pval + simp only [List.mem_map] + exists (k, pval) + -- re-evaluating `pvals` with substitution produced an error, and + -- `pval` is the member of `pvals` which caused it + replace ⟨(k', x), hx, h₃⟩ := List.mapM_ok_implies_all_from_ok hattrs (k, pval) h_pval + simp only [Partial.bindAttr] at h₃ + replace ⟨pval', h₃, h₃'⟩ := do_ok.mp h₃ + simp only [Prod.mk.injEq] at h₃' ; replace ⟨h₃', h₃''⟩ := h₃' ; subst k' pval' + -- `x` is the value in `attrs` which produced `pval` (`h₃`) + replace ⟨(k', pval'), h_pval', hattrs'⟩ := List.mapM_ok_implies_all_ok hattrs' (k, x) hx + simp only [Partial.bindAttr] at hattrs' + replace ⟨pval'', hattrs', hattrs''⟩ := do_ok.mp hattrs' + simp only [Prod.mk.injEq] at hattrs'' ; replace ⟨hattrs'', hattrs'''⟩ := hattrs'' ; subst k' pval'' + specialize ih (k, x) hx + simp [h₃] at ih + cases pval + case value v => + simp [Partial.bindAttr, Subst.subst_concrete_value, EvaluateValue.eval_spec_value v] at h₂ + case residual r => simp only [h₂, hattrs'] at ih + case ok pvals_re => + split <;> rename_i h₃ + · -- `pvals'` (substituting first then evaluating) is fully concrete `avs'` + rename_i avs' + have hsorted_avs' : avs'.SortedBy Prod.fst := by + apply Evaluate.mapM_Option_on_snd_preserves_sortedBy_fst' _ h₃ + simp [Partial.bindAttr] at hattrs' + exact Evaluate.mapM_Except_on_snd_preserves_sortedBy_fst hsorted_attrs hattrs' (f := (Partial.evaluate · req' (entities.subst subsmap))) + simp only [Except.bind_ok] + split <;> rename_i h₄ + · -- and re-evaluating `pvals` with substitution produced fully concrete `avs` + rename_i avs + have hsorted_avs : avs.SortedBy Prod.fst := by + apply Evaluate.mapM_Option_on_snd_preserves_sortedBy_fst' _ h₄ + simp [Partial.bindAttr] at h₂ hattrs + apply Evaluate.mapM_Except_on_snd_preserves_sortedBy_fst _ h₂ (f := λ (pv : Partial.Value) => Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap)) + exact Evaluate.mapM_Except_on_snd_preserves_sortedBy_fst hsorted_attrs hattrs (f := (Partial.evaluate · req entities)) + simp only [Except.ok.injEq, Partial.Value.value.injEq, Spec.Value.record.injEq] + apply (Map.eq_iff_kvs_equiv (Map.make_wf _) (Map.make_wf _)).mp + simp only [List.Equiv, List.subset_def] + constructor <;> intro (k, v) hkv + · replace hkv := Map.make_mem_list_mem hkv + replace ⟨(k', pval_re), h_pval_re, h₄⟩ := List.mapM_some_implies_all_from_some h₄ (k, v) hkv + split at h₄ <;> simp only [Option.some.injEq, Prod.mk.injEq] at h₄ + replace ⟨h₄, h₄'⟩ := h₄ ; subst k' h₄' ; rename_i v hv + simp only at hv ; subst pval_re + replace ⟨(k', pval), h_pval, h₂⟩ := List.mapM_ok_implies_all_from_ok h₂ (k, .value v) h_pval_re + simp only [Partial.bindAttr] at h₂ + replace ⟨pv', h₂, h₂'⟩ := do_ok.mp h₂ + simp only [Prod.mk.injEq] at h₂' ; replace ⟨h₂', h₂''⟩ := h₂' ; subst k' pv' + replace ⟨(k', x), hx, hxs⟩ := List.mapM_ok_implies_all_from_ok hattrs (k, pval) h_pval + simp only [Partial.bindAttr] at hxs + replace ⟨pval', hxs, hxs'⟩ := do_ok.mp hxs + simp only [Prod.mk.injEq] at hxs' ; replace ⟨hxs', hxs''⟩ := hxs' ; subst k' pval' + replace ⟨(k', pval'), h_pval', hattrs'⟩ := List.mapM_ok_implies_all_ok hattrs' (k, x) hx + simp only [Partial.bindAttr] at hattrs' + replace ⟨pval', hattrs', hattrs''⟩ := do_ok.mp hattrs' + simp only [Prod.mk.injEq] at hattrs'' ; replace ⟨hattrs'', hattrs'''⟩ := hattrs'' ; subst k' pval' + replace ⟨(k', v'), hv', h₃⟩ := List.mapM_some_implies_all_some h₃ (k, pval') h_pval' + split at h₃ <;> simp only [Option.some.injEq, Prod.mk.injEq] at h₃ + replace ⟨h₃, h₃'⟩ := h₃ ; subst k' v' ; rename_i v' hv'' + suffices v = v' by subst this ; exact Map.mem_list_mem_make hsorted_avs' hv' + specialize ih (k, x) hx + simp [hxs, h₂, hattrs'] at ih ; subst pval' + simpa using hv'' + · replace hkv := Map.make_mem_list_mem hkv + replace ⟨(k', pval'), h_pval', h₃⟩ := List.mapM_some_implies_all_from_some h₃ (k, v) hkv + split at h₃ <;> simp at h₃ + replace ⟨h₃, h₃'⟩ := h₃ ; subst k' v ; rename_i v' h_pval'' + simp only at h_pval'' ; subst pval' + replace ⟨(k', x), hx, hxs'⟩ := List.mapM_ok_implies_all_from_ok hattrs' (k, .value v') h_pval' + simp only [Partial.bindAttr] at hxs' + replace ⟨v'', hxs', hxs''⟩ := do_ok.mp hxs' + simp only [Prod.mk.injEq] at hxs'' ; replace ⟨hxs'', hxs'''⟩ := hxs'' ; subst k' v'' + replace ⟨(k', pval), h_pval, hxs⟩ := List.mapM_ok_implies_all_ok hattrs (k, x) hx + simp only [Partial.bindAttr] at hxs + replace ⟨pval', hxs, hxs''⟩ := do_ok.mp hxs + simp only [Prod.mk.injEq] at hxs'' ; replace ⟨hxs'', hxs'''⟩ := hxs'' ; subst k' pval' + replace ⟨(k', pval_re), h_pval_re, h₂⟩ := List.mapM_ok_implies_all_ok h₂ (k, pval) h_pval + simp only [Partial.bindAttr] at h₂ + replace ⟨pval', h₂, h₂'⟩ := do_ok.mp h₂ + simp only [Prod.mk.injEq] at h₂' ; replace ⟨h₂', h₂''⟩ := h₂' ; subst k' pval' + replace ⟨v, hv, h₄⟩ := List.mapM_some_implies_all_some h₄ (k, pval_re) h_pval_re + split at h₄ <;> simp at h₄ + subst h₄ ; rename_i v hv' + simp only at hv' + suffices v = v' by subst this ; exact Map.mem_list_mem_make hsorted_avs hv + specialize ih (k, x) hx + simp [hxs, h₂, hxs'] at ih ; subst ih + simpa using hv'.symm + · -- but re-evaluating `pvals` with substitution produced `pvals_re` which is not fully concrete + exfalso + replace ⟨(k, pval), h_pval, h₄⟩ := List.mapM_none_iff_exists_none.mp h₄ + split at h₄ <;> simp at h₄ ; rename_i pval' h_pval' + simp only at h_pval' + replace ⟨(k', pval''), h_pval'', h₂⟩ := List.mapM_ok_implies_all_from_ok h₂ (k, pval) h_pval + simp only [Partial.bindAttr] at h₂ + replace ⟨v', h₂, h₂'⟩ := do_ok.mp h₂ + simp only [Prod.mk.injEq] at h₂' ; replace ⟨h₂', h₂''⟩ := h₂' ; subst k' v' + replace ⟨(k', x), hx, hattrs⟩ := List.mapM_ok_implies_all_from_ok hattrs (k, pval'') h_pval'' + simp only [Partial.bindAttr] at hattrs + replace ⟨pval', hattrs, hattrs''⟩ := do_ok.mp hattrs + simp only [Prod.mk.injEq] at hattrs'' ; replace ⟨hattrs'', hattrs'''⟩ := hattrs'' ; subst k' pval' + replace ⟨(k', pval'''), h_pval''', hattrs'⟩ := List.mapM_ok_implies_all_ok hattrs' (k, x) hx + simp only [Partial.bindAttr] at hattrs' + replace ⟨pval', hattrs', hattrs''⟩ := do_ok.mp hattrs' + simp only [Prod.mk.injEq] at hattrs'' ; replace ⟨hattrs'', hattrs'''⟩ := hattrs'' ; subst k' pval' + replace ⟨(k', v), hv, h₃⟩ := List.mapM_some_implies_all_some h₃ (k, pval''') h_pval''' + split at h₃ <;> simp at h₃ ; rename_i v' hv' + simp only at hv' ; subst pval''' + replace ⟨h₃, h₃'⟩ := h₃ ; subst k' v' + specialize ih (k, x) hx + simp [hattrs, h₂, hattrs'] at ih + subst ih + simp only at h_pval' + · -- `pvals'` (substituting first then evaluating) is not fully concrete + simp only [Except.bind_ok] + split <;> rename_i h₄ + · -- but re-evaluating `pvals` with substitution produced fully concrete `avs` + exfalso + rename_i vs' + replace ⟨(k, pval'), h_pval', h₃⟩ := List.mapM_none_iff_exists_none.mp h₃ + split at h₃ <;> simp at h₃ ; rename_i pval'' h_pval'' + simp only at h_pval'' + replace ⟨(k', x), hx, hattrs'⟩ := List.mapM_ok_implies_all_from_ok hattrs' (k, pval') h_pval' + simp only [Partial.bindAttr] at hattrs' + replace ⟨v', hattrs', hattrs''⟩ := do_ok.mp hattrs' + simp only [Prod.mk.injEq] at hattrs'' ; replace ⟨hattrs'', hattrs'''⟩ := hattrs'' ; subst k' v' + replace ⟨(k', pval), h_pval, hattrs⟩ := List.mapM_ok_implies_all_ok hattrs (k, x) hx + simp only [Partial.bindAttr] at hattrs + replace ⟨v, hattrs, hattrs''⟩ := do_ok.mp hattrs + simp only [Prod.mk.injEq] at hattrs'' ; replace ⟨hattrs'', hattrs'''⟩ := hattrs'' ; subst k' v + replace ⟨(k', pval_re), h_pval_re, h₂⟩ := List.mapM_ok_implies_all_ok h₂ (k, pval) h_pval + simp only [Partial.bindAttr] at h₂ + replace ⟨pval_re', h₂, h₂'⟩ := do_ok.mp h₂ + simp only [Prod.mk.injEq] at h₂' ; replace ⟨h₂', h₂''⟩ := h₂' ; subst k' pval_re' + replace ⟨v', hv', h₄⟩ := List.mapM_some_implies_all_some h₄ (k, pval_re) h_pval_re + split at h₄ <;> simp at h₄ + subst h₄ ; rename_i v' hv'' + specialize ih (k, x) hx + simp [hattrs, h₂, hattrs'] at ih ; subst pval_re + simp only at hv'' ; subst hv'' + simp only at h_pval'' + · -- and re-evaluating `pvals` with substitution produced `pvals_re` which is not fully concrete either + simp only [Except.ok.injEq, Partial.Value.residual.injEq, + Partial.ResidualExpr.record.injEq] + simp [hattrs, h₂, hattrs'] at h + subst h ; rfl + +end Cedar.Thm.Partial.Evaluation.Reevaluation.Record diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Set.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Set.lean new file mode 100644 index 000000000..b6924ee0f --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Set.lean @@ -0,0 +1,345 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Thm.Partial.Evaluation.Evaluate +import Cedar.Thm.Partial.Evaluation.Evaluate.Set +import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed + +namespace Cedar.Thm.Partial.Evaluation.Reevaluation.Set + +open Cedar.Data +open Cedar.Partial (Subsmap Unknown) +open Cedar.Spec (Error Prim Result) + +/-- + If evaluating any element of a `Partial.ResidualExpr.set` produces an error, + then evaluating the whole `Partial.ResidualExpr.set` must also produce an + error (not necessarily the same error) +-/ +theorem element_error_implies_set_error {pv : Partial.Value} {pvs : List Partial.Value} {entities : Partial.Entities} {e : Error} : + pv ∈ pvs → + Partial.evaluateValue pv entities = .error e → + ∃ e', Partial.evaluateValue (.residual (Partial.ResidualExpr.set pvs)) entities = .error e' +:= by + intro h₁ h₂ + simp [Partial.evaluateValue, Partial.evaluateResidual, List.mapM₁_eq_mapM (Partial.evaluateValue · entities)] + cases h₃ : pvs.mapM (Partial.evaluateValue · entities) <;> simp + case ok pvals => + replace ⟨pval, _, h₃⟩ := List.mapM_ok_implies_all_ok h₃ pv h₁ + simp [h₂] at h₃ + +/-- + Basically a statement of `ReevalEquivSubstFirst`, but for + `mapM Partial.evaluate` instead of raw `Partial.evaluate`. Used by both Set + and Call. +-/ +theorem mapM_reeval_eqv_substituting_first {xs : List Spec.Expr} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) + (ih : ∀ x ∈ xs, ReevalEquivSubstFirst x req req' entities subsmap) : + req.subst subsmap = some req' → + let re_evaluated := xs.mapM (Partial.evaluate · req entities) >>= λ residuals => residuals.mapM (λ residual => Partial.evaluateValue (residual.subst subsmap) (entities.subst subsmap)) + let subst_first := xs.mapM (λ x => Partial.evaluate x req' (entities.subst subsmap)) + match (re_evaluated, subst_first) with + | (Except.error _, Except.error _) => true -- don't require that the errors are equal + | (_, _) => re_evaluated = subst_first +:= by + simp only + split <;> try simp only [implies_true] + rename_i hₑ h₁ + simp at h₁ ; replace ⟨h₁, h₁'⟩ := h₁ ; subst h₁ h₁' + cases hxs : xs.mapM (Partial.evaluate · req entities) + <;> simp only [Except.bind_ok, Except.bind_err] + <;> cases hxs' : xs.mapM (λ x => Partial.evaluate x req' (entities.subst subsmap)) + <;> simp [hxs, hxs'] at hₑ + case error.ok e pvals => + intro h_req + exfalso + replace ⟨x, hx, hxs⟩ := List.mapM_error_implies_exists_error hxs + replace ⟨pval, _, hxs'⟩ := List.mapM_ok_implies_all_ok hxs' x hx + have ⟨e, hxs''⟩ := Evaluate.subst_preserves_errors wf_r wf_e wf_s h_req hxs + simp only [hxs''] at hxs' + case ok.error pvals e => + -- evaluating `xs` before substitution produced residuals, but after + -- substitution, one of them produced the error `e` + replace ⟨x, hx, hxs'⟩ := List.mapM_error_implies_exists_error hxs' + -- `x` is the input expression that produced error `e` after substitution + exact match h₁ : Partial.evaluate x req entities with + | .error e' => by + replace ⟨pval, _, hxs⟩ := List.mapM_ok_implies_all_ok hxs x hx + simp [h₁] at hxs + | .ok (.value v) => by + intro h_req + simp [Evaluate.subst_preserves_evaluation_to_value wf_r wf_e wf_s h_req h₁] at hxs' + | .ok (.residual r) => by + intro h_req + specialize ih x hx h_req + simp [h₁] at ih + split at ih <;> rename_i ih' + <;> simp at ih' <;> replace ⟨ih', ih''⟩ := ih' + · rename_i e' e'' + simp [hxs'] at ih'' ; subst e'' + suffices ∃ e, pvals.mapM (λ pval => Partial.evaluateValue (pval.subst subsmap) (entities.subst subsmap)) = .error e by + replace ⟨e, this⟩ := this + exfalso ; exact hₑ e this + clear hₑ + apply List.element_error_implies_mapM_error (x := Partial.Value.residual r) _ ih' + replace ⟨pval, h₃, hxs⟩ := List.mapM_ok_implies_all_ok hxs x hx + simp [hxs] at h₁ ; subst h₁ + exact h₃ + · rename_i hₑ' + subst ih' ih'' + simp [hxs', ih] at ih hₑ' + case ok.ok pvals pvals' => + -- evaluating `xs` before substitution produced `pvals`, and after + -- substitution, produced `pvals'` + intro h_req + -- we proceed by induction on `xs` + cases xs <;> simp [pure, Except.pure] at * + case nil => subst pvals pvals' ; simp [pure, Except.pure] + case cons hd tl => + have ⟨ih_hd, ih_tl⟩ := ih ; clear ih + have ih := mapM_reeval_eqv_substituting_first wf_r wf_e wf_s ih_tl h_req + -- the plan is to use `ih_hd` to dispatch the `hd`-related obligations, + -- and `ih` (not `ih_tl`) to dispatch the `tl`-related obligations + specialize ih_hd h_req + simp at ih_hd ; split at ih_hd <;> rename_i ih_hd' + · rename_i e e' + cases hhd : Partial.evaluate hd req entities + <;> simp [hhd] at ih_hd' hxs + case ok hd_pval => + cases htl : tl.mapM (Partial.evaluate · req entities) + <;> simp [htl] at hxs + case ok tl_pvals => subst pvals ; simp [ih_hd'] at hxs' + · rename_i hₑ' + simp at ih_hd' ; replace ⟨ih_hd', ih_hd''⟩ := ih_hd' ; subst ih_hd' ih_hd'' + cases hhd : Partial.evaluate hd req entities + <;> simp [hhd] at ih ih_hd hxs hₑ' + case ok hd_pval => + simp [ih_hd] at hₑ' + cases htl : tl.mapM (Partial.evaluate · req entities) + <;> simp [htl] at hxs ih + case ok tl_pvals => + subst pvals + simp [ih_hd, pure, Except.pure] + cases hhd' : Partial.evaluate hd req' (entities.subst subsmap) + <;> simp [hhd'] at hxs' + case ok hd_pval' => + clear hₑ' + split at ih <;> rename_i ih' + <;> simp at ih' <;> replace ⟨ih', ih''⟩ := ih' + · simp [ih''] at hxs' + · rename_i hₑ' + subst ih' ih'' + simp [ih] + exact hxs' + +/-- + Inductive argument that re-evaluation of a `Spec.Expr.set` with a + substitution on the residual expression, is equivalent to substituting first + and then evaluating on the original `Spec.Expr.set`. +-/ +-- TODO: there is significant duplication of the proof between this theorem and +-- `mapM_reeval_eqv_substituting_first` above. This theorem uses the one above +-- as a lemma in only one case. It could probably use it as a lemma in more +-- cases, to reduce duplication. +theorem reeval_eqv_substituting_first {xs : List Spec.Expr} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) + (ih : ∀ x ∈ xs, ReevalEquivSubstFirst x req req' entities subsmap) : + ReevalEquivSubstFirst (Spec.Expr.set xs) req req' entities subsmap +:= by + have h := mapM_reeval_eqv_substituting_first wf_r wf_e wf_s ih + unfold ReevalEquivSubstFirst at * + simp only [Partial.evaluate] + simp only at ih + rw [ + List.mapM₁_eq_mapM (Partial.evaluate · req entities), + List.mapM₁_eq_mapM (Partial.evaluate · req' (entities.subst subsmap)), + ] + split + · simp only [implies_true] + · rename_i hₑ h₁ + intro h_req ; simp [h_req] at ih ; specialize h h_req + simp at h₁ ; replace ⟨h₁, h₁'⟩ := h₁ ; subst h₁ h₁' + cases hxs : xs.mapM (Partial.evaluate · req entities) + <;> simp [hxs] at hₑ <;> simp [hxs] + <;> cases hxs' : xs.mapM (λ x => Partial.evaluate x req' (entities.subst subsmap)) + <;> simp [hxs'] at hₑ <;> simp [hxs'] + case error.ok e pvals => + replace ⟨x, hx, hxs⟩ := List.mapM_error_implies_exists_error hxs + replace ⟨pval, _, hxs'⟩ := List.mapM_ok_implies_all_ok hxs' x hx + have ⟨e', hxs''⟩ := Evaluate.subst_preserves_errors wf_r wf_e wf_s h_req hxs + simp only [hxs''] at hxs' + case ok.error pvals e => + -- evaluating `xs` before substitution produced residuals, but after + -- substitution, one of them produced the error `e` + replace ⟨x, hx, hxs'⟩ := List.mapM_error_implies_exists_error hxs' + -- `x` is the input expression that produced error `e` after substitution + exact match h₁ : Partial.evaluate x req entities with + | .error e' => by + replace ⟨pval, _, hxs⟩ := List.mapM_ok_implies_all_ok hxs x hx + simp [h₁] at hxs + | .ok (.value v) => by + simp [Evaluate.subst_preserves_evaluation_to_value wf_r wf_e wf_s h_req h₁] at hxs' + | .ok (.residual r) => by + have h₂ : (Partial.Value.residual r) ∈ pvals := by + replace ⟨pval, h₄, hxs⟩ := List.mapM_ok_implies_all_ok hxs x hx + simp [hxs] at h₁ ; subst h₁ + exact h₄ + have h₃ : pvals.mapM (λ pval => match pval with | .value v => some v | .residual _ => none) = none := by + by_contra h₃ + simp [Option.ne_none_iff_exists'] at h₃ + replace ⟨vs, h₃⟩ := h₃ + replace ⟨v, _, h₃⟩ := List.mapM_some_implies_all_some h₃ (.residual r) h₂ + simp at h₃ + split at hₑ <;> rename_i h₄ + · -- for some reason, Lean doesn't accept `rw [h₄] at h₃`, + -- so we have this convoluted way to get Lean to see the contradiction here + rename_i vs + suffices some vs = none by simp at this + rw [← h₄, ← h₃] + rfl + · simp only [Except.bind_ok] + simp only [hxs, Except.bind_ok] at h + specialize ih x hx + simp only [h₁, Except.bind_ok] at ih + split at ih <;> rename_i ih' + <;> simp at ih' <;> replace ⟨ih', ih''⟩ := ih' + · exfalso + rename_i e' e'' + simp [Partial.Value.subst, Partial.ResidualExpr.subst, List.map₁_eq_map] at hₑ + suffices ∃ e, Partial.evaluateValue (.residual (.set (pvals.map (Partial.Value.subst subsmap)))) (entities.subst subsmap) = .error e by + replace ⟨e, this⟩ := this + exact hₑ e this + clear hₑ + apply element_error_implies_set_error (pv := (Partial.Value.residual r).subst subsmap) _ ih' + simp only [List.mem_map] + exists (.residual r) + · rename_i hₑ' + subst ih' ih'' + simp [hxs'] at ih hₑ' + simp [ih] at hₑ' + case ok.ok pvals pvals' => + -- evaluating `xs` before substitution produced `pvals`, and after + -- substitution, produced `pvals'` + split <;> rename_i h₁ <;> simp + · -- `pvals` is actually fully concrete + rename_i vs + clear hₑ + have h_pvals : pvals = pvals' := by + suffices Except.ok (ε := Error) pvals = Except.ok pvals' by simpa using this + suffices xs.mapM (λ x => Partial.evaluate x req' (entities.subst subsmap)) = .ok pvals by + rw [← this, ← hxs'] + apply Evaluate.Set.mapM_subst_preserves_evaluation_to_values _ h_req pvals hxs _ + · unfold SubstPreservesEvaluationToConcrete + intro x _ h_req v hx + exact Evaluate.subst_preserves_evaluation_to_value wf_r wf_e wf_s h_req hx + · unfold IsAllConcrete + exists vs + subst pvals' + simp [h₁, Subst.subst_concrete_value, EvaluateValue.eval_spec_value] + · -- `pvals` is not fully concrete; that is, it contains at least one `.residual` + clear hₑ + simp only [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual, List.map₁_eq_map] + rw [List.mapM₁_eq_mapM (Partial.evaluateValue · (entities.subst subsmap))] + rw [List.mapM_map] + cases h₂ : pvals.mapM λ pval => Partial.evaluateValue (pval.subst subsmap) (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err] + case error e => + exfalso + replace ⟨pval, h_pval, h₂⟩ := List.mapM_error_implies_exists_error h₂ + -- re-evaluating `pvals` with substitution produced an error, and + -- `pval` is the member of `pvals` which caused it + replace ⟨x, hx, h₃⟩ := List.mapM_ok_implies_all_from_ok hxs pval h_pval + -- `x` is the member of `xs` which produced `pval` + replace ⟨pval', _, hxs'⟩ := List.mapM_ok_implies_all_ok hxs' x hx + specialize ih x hx + simp [h₃, hxs'] at ih + simp [ih] at h₂ + case ok pvals_re => + split <;> rename_i h₃ + · -- re-evaluating `pvals` with substitution produced fully concrete `vs` + rename_i vs + split <;> rename_i h₄ + · -- and `pvals'` (substituting first then evaluating) is fully concrete `vs'` + rename_i vs' + simp only [Except.ok.injEq, Partial.Value.value.injEq, Spec.Value.set.injEq] + simp only [Set.make_make_eqv, List.Equiv, List.subset_def] + constructor <;> intro v hv + · replace ⟨pval_re, h_pval_re, h₃⟩ := List.mapM_some_implies_all_from_some h₃ v hv + split at h₃ <;> simp at h₃ + subst h₃ ; rename_i v + replace ⟨pval, h_pval, h₂⟩ := List.mapM_ok_implies_all_from_ok h₂ (.value v) h_pval_re + replace ⟨x, hx, hxs⟩ := List.mapM_ok_implies_all_from_ok hxs pval h_pval + replace ⟨pval', h_pval', hxs'⟩ := List.mapM_ok_implies_all_ok hxs' x hx + replace ⟨v', hv', h₄⟩ := List.mapM_some_implies_all_some h₄ pval' h_pval' + split at h₄ <;> simp at h₄ + subst h₄ ; rename_i v' + suffices v = v' by subst this ; exact hv' + specialize ih x hx + simp [hxs, h₂, hxs'] at ih + exact ih + · replace ⟨pval', h_pval', h₄⟩ := List.mapM_some_implies_all_from_some h₄ v hv + split at h₄ <;> simp at h₄ + subst h₄ ; rename_i v' + replace ⟨x, hx, hxs'⟩ := List.mapM_ok_implies_all_from_ok hxs' (.value v') h_pval' + replace ⟨pval, h_pval, hxs⟩ := List.mapM_ok_implies_all_ok hxs x hx + replace ⟨pval_re, h_pval_re, h₂⟩ := List.mapM_ok_implies_all_ok h₂ pval h_pval + replace ⟨v, hv, h₃⟩ := List.mapM_some_implies_all_some h₃ pval_re h_pval_re + split at h₃ <;> simp at h₃ + subst h₃ ; rename_i v + suffices v = v' by subst this ; exact hv + specialize ih x hx + simp [hxs, h₂, hxs'] at ih + exact ih + · -- but `pvals'` (substituting first then evaluating) is not fully concrete + exfalso + replace ⟨pval', h_pval', h₄⟩ := List.mapM_none_iff_exists_none.mp h₄ + split at h₄ <;> simp at h₄ ; rename_i r + replace ⟨x, hx, hxs'⟩ := List.mapM_ok_implies_all_from_ok hxs' (.residual r) h_pval' + replace ⟨pval, h_pval, hxs⟩ := List.mapM_ok_implies_all_ok hxs x hx + replace ⟨pval_re, h_pval_re, h₂⟩ := List.mapM_ok_implies_all_ok h₂ pval h_pval + replace ⟨v, hv, h₃⟩ := List.mapM_some_implies_all_some h₃ pval_re h_pval_re + split at h₃ <;> simp at h₃ + subst h₃ ; rename_i v + specialize ih x hx + simp [hxs, h₂, hxs'] at ih + · -- re-evaluating `pvals` with substitution produced `pvals_re` which is not fully concrete + split <;> rename_i h₄ + · -- but `pvals'` (substituting first then evaluating) is fully concrete `vs'` + exfalso + rename_i vs' + replace ⟨pval_re, h_pval_re, h₃⟩ := List.mapM_none_iff_exists_none.mp h₃ + split at h₃ <;> simp at h₃ ; rename_i r + replace ⟨pval, h_pval, h₂⟩ := List.mapM_ok_implies_all_from_ok h₂ (.residual r) h_pval_re + replace ⟨x, hx, hxs⟩ := List.mapM_ok_implies_all_from_ok hxs pval h_pval + replace ⟨pval', h_pval', hxs'⟩ := List.mapM_ok_implies_all_ok hxs' x hx + replace ⟨v', hv', h₄⟩ := List.mapM_some_implies_all_some h₄ pval' h_pval' + split at h₄ <;> simp at h₄ + subst h₄ ; rename_i v' + specialize ih x hx + simp [hxs, h₂, hxs'] at ih + · -- and `pvals'` (substituting first then evaluating) is not fully concrete either + simp only [Except.ok.injEq, Partial.Value.residual.injEq, Spec.Expr.set.injEq] + simp [hxs, h₂, hxs'] at h + subst h ; rfl + +end Cedar.Thm.Partial.Evaluation.Reevaluation.Set diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Unary.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Unary.lean new file mode 100644 index 000000000..454cbbfb2 --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Unary.lean @@ -0,0 +1,81 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Thm.Partial.Evaluation.Evaluate +import Cedar.Thm.Partial.Evaluation.Evaluate.Unary +import Cedar.Thm.Partial.Evaluation.ReevaluateUnaryApp +import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed + +namespace Cedar.Thm.Partial.Evaluation.Reevaluation.Unary + +open Cedar.Data +open Cedar.Partial (Subsmap Unknown) +open Cedar.Spec (Prim UnaryOp) + +/-- + Inductive argument that re-evaluation of a `Spec.Expr.unaryApp` with a + substitution on the residual expression, is equivalent to substituting first + and then evaluating on the original `Spec.Expr.unaryApp`. +-/ +theorem reeval_eqv_substituting_first {x₁ : Spec.Expr} {req req' : Partial.Request} {entities : Partial.Entities} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (ih₁ : ReevalEquivSubstFirst x₁ req req' entities subsmap) : + ReevalEquivSubstFirst (Spec.Expr.unaryApp op x₁) req req' entities subsmap +:= by + unfold ReevalEquivSubstFirst at * + simp only [Partial.evaluate] + split <;> try simp only [implies_true] + rename_i hₑ h₁ ; simp only [bind_assoc, Prod.mk.injEq] at h₁ ; replace ⟨h₁, h₁'⟩ := h₁ ; subst h₁ h₁' + intro h_req ; specialize ih₁ h_req + simp only at ih₁ ; split at ih₁ <;> rename_i ih₁' + · exfalso + rename_i hₑ _ e₁ e₂ + simp only [bind_assoc, Prod.mk.injEq] at ih₁' ; replace ⟨ih₁', ih₁''⟩ := ih₁' + simp only [ih₁'', Except.bind_err, Except.error.injEq, imp_false, forall_apply_eq_imp_iff] at hₑ + cases hx₁ : Partial.evaluate x₁ req entities + <;> simp only [hx₁, Except.bind_ok, Except.bind_err, Except.error.injEq, forall_eq'] at ih₁' hₑ + · rename_i pval₁ + have wf_pval₁ : pval₁.WellFormed := Evaluate.partial_eval_wf wf_r wf_e pval₁ hx₁ + have h := ReevaluateUnaryApp.reeval_eqv_substituting_first op pval₁ entities subsmap wf_pval₁ + simp only at h ; split at h <;> rename_i h' + <;> simp only [Prod.mk.injEq] at h' <;> replace ⟨h', h''⟩ := h' + · simp only [h', Except.error.injEq, forall_eq'] at hₑ + · subst h' h'' + simp only [ih₁', h, Except.bind_err, Except.error.injEq, forall_eq'] at hₑ + · rename_i hₑ' + simp only [Prod.mk.injEq] at ih₁' ; replace ⟨ih₁', ih₁''⟩ := ih₁' ; subst ih₁' ih₁'' + simp only [← ih₁, bind_assoc] + simp only [← ih₁, imp_false] at hₑ' + cases hx₁ : Partial.evaluate x₁ req entities + <;> simp only [hx₁, Except.bind_ok, Except.bind_err] at ih₁ hₑ' + <;> simp only [Except.bind_ok, Except.bind_err] + case ok pval₁ => + have wf₁ : pval₁.WellFormed := Evaluate.partial_eval_wf wf_r wf_e _ hx₁ + have h := ReevaluateUnaryApp.reeval_eqv_substituting_first op pval₁ entities subsmap wf₁ + simp only at h ; split at h <;> rename_i h' + <;> simp only [Prod.mk.injEq] at h' <;> replace ⟨h', h''⟩ := h' + · simp [h', h'', ← ih₁, hx₁] at hₑ + · rename_i hₑ'' + subst h' h'' + cases h₁ : Partial.evaluateUnaryApp op pval₁ <;> simp [h₁] at * + case error => simp [← h] at * + case ok => simp only [h] at * + + +end Cedar.Thm.Partial.Evaluation.Reevaluation.Unary diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Var.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Var.lean new file mode 100644 index 000000000..d092b987e --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Var.lean @@ -0,0 +1,323 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Thm.Data.Control +import Cedar.Thm.Partial.Evaluation.Evaluate +import Cedar.Thm.Partial.Evaluation.Evaluate.Var +import Cedar.Thm.Partial.Evaluation.ReevaluateValue +import Cedar.Thm.Partial.WellFormed +import Cedar.Thm.Partial.Subst + +namespace Cedar.Thm.Partial.Evaluation.Reevaluation.Var + +open Cedar.Data +open Cedar.Partial (Subsmap Unknown) +open Cedar.Spec (Attr Error Result Var) + +theorem do_error {res : Result α} {e : Error} {f : α → β} : + (do let v ← res ; .ok (f v)) = .error e → + res = .error e +:= by cases res <;> simp + +/-- + If `Partial.evaluateVar` returns a residual, re-evaluating that residual with + a substitution on `req`, is equivalent to substituting first, evaluating the + context values if the var is `context`, and then calling `Partial.evaluateVar` + on the substituted/evaluated request +-/ +theorem reeval_eqv_substituting_first_evaluateVar (var : Var) (entities : Partial.Entities) {req req' : Partial.Request} {subsmap : Subsmap} + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + req.subst subsmap = some req' → + let re_evaluated := Partial.evaluateVar var req entities >>= λ residual => Partial.evaluateValue (residual.subst subsmap) (entities.subst subsmap) + let subst_first := Partial.evaluateVar var req' (entities.subst subsmap) + match (re_evaluated, subst_first) with + | (Except.error _, Except.error _) => true -- don't require that the errors are equal + | (_, _) => re_evaluated = subst_first +:= by + intro h_req + cases h_var : Partial.evaluateVar var req entities + case error e => + cases var <;> simp at * + case principal | action | resource => split <;> trivial + case context => + split <;> try { trivial } + rename_i hₑ h₁ + simp only [Prod.mk.injEq] at h₁ ; replace ⟨h₁, h₁'⟩ := h₁ ; subst h₁ h₁' + have ⟨e', h₁⟩ := Evaluate.Var.subst_preserves_evaluateVar_to_error wf_r wf_e wf_s h_req h_var + simp only [h₁, Except.error.injEq, imp_false, forall_apply_eq_imp_iff, forall_eq'] at hₑ + case ok pval => + unfold Partial.evaluateVar at * + cases var <;> simp at * + case principal => + subst pval + cases h₁ : req.principal <;> simp + case known uid => + simp only [Subst.subst_concrete_value, EvaluateValue.eval_spec_value, Except.ok.injEq] + rw [Subst.req_subst_preserves_known_principal h₁ h_req] + case unknown u => + simp [h₁, Partial.Request.subst, Partial.UidOrUnknown.subst] at h_req + replace ⟨p, h_p, a, h_a, r, h_r, h_req⟩ := h_req + subst req' + simp only + split at h_p <;> simp at h_p <;> subst p <;> rename_i h_subs + <;> simp only [Partial.Value.subst, Partial.ResidualExpr.subst, h_subs] + · simp only [EvaluateValue.eval_spec_value] + · simp only [Partial.evaluateValue, Partial.evaluateResidual] + · simp only [Partial.evaluateValue, Partial.evaluateResidual] + case action => + subst pval + cases h₁ : req.action <;> simp + case known uid => + simp only [Subst.subst_concrete_value, EvaluateValue.eval_spec_value, Except.ok.injEq] + rw [Subst.req_subst_preserves_known_action h₁ h_req] + case unknown u => + simp [h₁, Partial.Request.subst, Partial.UidOrUnknown.subst] at h_req + replace ⟨p, h_p, a, h_a, r, h_r, h_req⟩ := h_req + subst req' + simp only + split at h_a <;> simp at h_a <;> subst a <;> rename_i h_subs + <;> simp only [Partial.Value.subst, Partial.ResidualExpr.subst, h_subs] + · simp only [EvaluateValue.eval_spec_value] + · simp only [Partial.evaluateValue, Partial.evaluateResidual] + · simp only [Partial.evaluateValue, Partial.evaluateResidual] + case resource => + subst pval + cases h₁ : req.resource <;> simp + case known uid => + simp only [Subst.subst_concrete_value, EvaluateValue.eval_spec_value, Except.ok.injEq] + rw [Subst.req_subst_preserves_known_resource h₁ h_req] + case unknown u => + simp [h₁, Partial.Request.subst, Partial.UidOrUnknown.subst] at h_req + replace ⟨p, h_p, a, h_a, r, h_r, h_req⟩ := h_req + subst req' + simp only + split at h_r <;> simp at h_r <;> subst r <;> rename_i h_subs + <;> simp only [Partial.Value.subst, Partial.ResidualExpr.subst, h_subs] + · simp only [EvaluateValue.eval_spec_value] + · simp only [Partial.evaluateValue, Partial.evaluateResidual] + · simp only [Partial.evaluateValue, Partial.evaluateResidual] + case context => + simp only [Partial.Request.subst, Option.bind_eq_bind, Option.bind_eq_some, + Option.some.injEq] at h_req + replace ⟨p, h_p, a, h_a, r, h_r, h_req⟩ := h_req ; subst req' ; simp only + simp only [Map.mapMOnValues_mapOnValues] + split <;> try { trivial } + rename_i hₑ h₁ + simp only [Prod.mk.injEq] at h₁ ; replace ⟨h₁, h₁'⟩ := h₁ ; subst h₁ h₁' + cases h₁ : Partial.evaluateValue (pval.subst subsmap) (entities.subst subsmap) + <;> simp only [h₁, imp_false, false_implies, implies_true] at hₑ + case error e' => + exfalso + specialize hₑ e' ; simp only [true_implies] at hₑ + cases h₂ : req.context.mapMOnValues (Partial.evaluateValue · entities) + <;> simp only [h₂, Except.bind_ok, Except.bind_err] at h_var + case ok apvs => + split at h_var <;> simp only [Except.ok.injEq] at h_var <;> subst pval <;> rename_i hapvs + · simp only [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] at h₁ + · simp only [Partial.Value.subst, Partial.ResidualExpr.subst, List.map_attach₂_snd, + Partial.evaluateValue, Partial.evaluateResidual, + Evaluate.Record.mapM₂_eq_mapM_partial_bindAttr (Partial.evaluateValue · (entities.subst subsmap)), + List.mapM_map] at h₁ + suffices ∃ e, (req.context.mapMOnValues λ pv => Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap)) = .error e by + replace ⟨e, this⟩ := this + simp only [this, Except.bind_err, Except.error.injEq, forall_eq'] at hₑ + clear hₑ + have h₃ : (apvs.kvs.mapM λ apv => Partial.bindAttr apv.fst (Partial.evaluateValue (apv.snd.subst subsmap) (entities.subst subsmap))) = .error e' := by + cases h₃ : apvs.kvs.mapM λ apv => Partial.bindAttr apv.fst (Partial.evaluateValue (apv.snd.subst subsmap) (entities.subst subsmap)) + <;> simp only [h₃, Except.bind_ok, Except.bind_err, Except.error.injEq] at h₁ + case error => subst e' ; rfl + case ok => split at h₁ <;> simp only at h₁ + clear h₁ -- h₃ is a more concise statement of h₁ + replace ⟨(a, pv'), hpv', h₃⟩ := List.mapM_error_implies_exists_error h₃ + simp only [Partial.bindAttr] at h₃ + replace h₃ := do_error h₃ + replace ⟨pv, hpv, h₂⟩ := Map.mapMOnValues_ok_implies_all_from_ok h₂ (a, pv') hpv' + simp only at * + apply Map.element_error_implies_mapMOnValues_error (Map.in_list_in_values hpv) (e := e') + have wf_pv : pv.WellFormed := wf_r.right pv (Map.in_list_in_values hpv) + simp only [ReevaluateValue.reeval_eqv_substituting_first wf_pv wf_e wf_s h₂] at h₃ + exact h₃ + case ok pval' => + cases h₂ : req.context.mapMOnValues (Partial.evaluateValue · entities) + <;> simp only [h₂, Except.bind_ok, Except.bind_err] at h_var + case ok apvs => + split at h_var <;> simp only [Except.ok.injEq] at h_var <;> subst pval <;> rename_i hapvs + · rename_i avs + -- in this branch, `apvs` is all-concrete (`avs` is its pure-concrete representation) + simp only [Subst.subst_concrete_value, EvaluateValue.eval_spec_value, + Except.ok.injEq] at h₁ ; subst pval' + cases h₃ : req.context.mapMOnValues λ pv => Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) + case error e => + exfalso + replace ⟨pv, hpv, h₃⟩ := Map.mapMOnValues_error_implies_exists_error h₃ + replace ⟨a, hpv⟩ := Map.in_values_exists_key hpv + replace ⟨pv', hpv', h₂⟩ := Map.mapMOnValues_ok_implies_all_ok h₂ (a, pv) hpv + replace ⟨v', hv', hapvs⟩ := Map.mapMOnValues_some_implies_all_some hapvs (a, pv') hpv' + simp only at * + split at hapvs <;> simp only [Option.some.injEq] at hapvs ; subst v' ; rename_i v + have wf_pv : pv.WellFormed := wf_r.right pv (Map.in_list_in_values hpv) + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_pv h₂] at h₃ + case ok apvs' => + simp only [Except.bind_ok] + split <;> rename_i hapvs' + <;> simp only [Except.ok.injEq, Partial.Value.value.injEq, Spec.Value.record.injEq] + · rename_i avs' + apply (Map.eq_iff_kvs_equiv _ _).mp + · simp only [List.Equiv, List.subset_def] + and_intros <;> intro (a, v) hv + · replace ⟨pv', hpv', hapvs⟩ := Map.mapMOnValues_some_implies_all_from_some hapvs (a, v) hv + split at hapvs <;> simp only [Option.some.injEq] at hapvs ; subst v ; rename_i v + replace ⟨pv, hpv, h₂⟩ := Map.mapMOnValues_ok_implies_all_from_ok h₂ (a, v) hpv' + have hv' := hpv' ; clear hpv' + replace ⟨pv', hpv', h₃⟩ := Map.mapMOnValues_ok_implies_all_ok h₃ (a, pv) hpv + replace ⟨v', hv'', hapvs'⟩ := Map.mapMOnValues_some_implies_all_some hapvs' (a, pv') hpv' + split at hapvs' <;> simp only [Option.some.injEq] at hapvs' ; subst v' ; rename_i v' hpv'' + simp only at * + subst pv' + have wf_pv : pv.WellFormed := wf_r.right pv (Map.in_list_in_values hpv) + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_pv h₂, + Except.ok.injEq, Partial.Value.value.injEq] at h₃ + subst v' + exact hv'' + · replace ⟨pv', hpv', hapvs'⟩ := Map.mapMOnValues_some_implies_all_from_some hapvs' (a, v) hv + split at hapvs' <;> simp only [Option.some.injEq] at hapvs' ; subst v ; rename_i v + replace ⟨pv, hpv, h₃⟩ := Map.mapMOnValues_ok_implies_all_from_ok h₃ (a, v) hpv' + replace ⟨pv', hpv'', h₂⟩ := Map.mapMOnValues_ok_implies_all_ok h₂ (a, pv) hpv + replace ⟨v', hv', hapvs⟩ := Map.mapMOnValues_some_implies_all_some hapvs (a, pv') hpv'' + split at hapvs <;> simp only [Option.some.injEq] at hapvs ; subst v' ; rename_i v' hv'' + simp only at * + subst pv' + have wf_pv : pv.WellFormed := wf_r.right pv (Map.in_list_in_values hpv) + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_pv h₂, + Except.ok.injEq, Partial.Value.value.injEq] at h₃ + subst v' + exact hv' + · apply Map.mapMOnValues_some_wf _ hapvs + apply Map.mapMOnValues_ok_wf _ h₂ + exact wf_r.left + · apply Map.mapMOnValues_some_wf _ hapvs' + apply Map.mapMOnValues_ok_wf _ h₃ + exact wf_r.left + · replace ⟨pv', hpv', hapvs'⟩ := Map.mapMOnValues_none_iff_exists_none.mp hapvs' + split at hapvs' <;> simp only at hapvs' ; rename_i r + replace ⟨a, hpv'⟩ := Map.in_values_exists_key hpv' + replace ⟨pv, hpv, h₃⟩ := Map.mapMOnValues_ok_implies_all_from_ok h₃ (a, .residual r) hpv' + replace ⟨pv', hpv'', h₂⟩ := Map.mapMOnValues_ok_implies_all_ok h₂ (a, pv) hpv + replace ⟨v', hv', hapvs⟩ := Map.mapMOnValues_some_implies_all_some hapvs (a, pv') hpv'' + split at hapvs <;> simp only [Option.some.injEq] at hapvs ; subst v' ; rename_i v' hv + simp only at * + subst pv' + have wf_pv : pv.WellFormed := wf_r.right pv (Map.in_list_in_values hpv) + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_pv h₂, + Except.ok.injEq] at h₃ + · -- in this branch, `apvs` contains at least one residual + -- re-evaluated produced `pval'`; the first evaluation produced `.residual (.record apvs.kvs)`, + -- which is why `h₁` looks how it does + replace ⟨pv', hpv', hapvs⟩ := Map.mapMOnValues_none_iff_exists_none.mp hapvs + split at hapvs <;> simp only at hapvs ; rename_i r + replace ⟨a, hpv'⟩ := Map.in_values_exists_key hpv' + have ⟨pv, hpv, h₄⟩ := Map.mapMOnValues_ok_implies_all_from_ok h₂ (a, .residual r) hpv' + simp only at * + simp only [Partial.Value.subst, Partial.ResidualExpr.subst, List.map_attach₂_snd, + Partial.evaluateValue, Partial.evaluateResidual, + Evaluate.Record.mapM₂_eq_mapM_partial_bindAttr (Partial.evaluateValue · (entities.subst subsmap)), + List.mapM_map] at h₁ + cases h₃ : apvs.kvs.mapM λ apv => Partial.bindAttr apv.fst (Partial.evaluateValue (apv.snd.subst subsmap) (entities.subst subsmap)) + <;> simp only [h₃, Except.bind_ok, Except.bind_err] at h₁ + case ok apvs' => + split at h₁ <;> rename_i hapvs' <;> simp only [Except.ok.injEq] at h₁ <;> subst pval' + · rename_i avs' + -- re-evaluated produced a concrete value, `.value (.record (Map.make avs'))` + cases h₅ : req.context.mapMOnValues λ pv => Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) + <;> simp + case error e => + replace ⟨pv', hpv'', h₅⟩ := Map.mapMOnValues_error_implies_exists_error h₅ + replace ⟨a, hpv''⟩ := Map.in_values_exists_key hpv'' + replace ⟨pv'', hpv''', h₂⟩ := Map.mapMOnValues_ok_implies_all_ok h₂ (a, pv') hpv'' + simp only at * + replace ⟨(a', pv'''), hpv'''', h₃⟩ := List.mapM_ok_implies_all_ok h₃ (a, pv'') hpv''' + simp [Partial.bindAttr, do_ok] at h₃ + replace ⟨h₃, h₃'⟩ := h₃ ; subst a' + sorry + case ok apvs'' => + split <;> rename_i h₆ <;> simp + · rename_i avs'' + sorry + · replace ⟨pv', hpv'', h₆⟩ := Map.mapMOnValues_none_iff_exists_none.mp h₆ + split at h₆ <;> simp at h₆ ; rename_i r' + -- I think the contradiction requires h₂ / h₃ / hapvs' / h₅ / hpv'' + sorry + · -- re-evaluated produced a residual, `.residual (.record apvs')` + replace ⟨(a', pv'), hpv', hapvs'⟩ := List.mapM_none_iff_exists_none.mp hapvs' + split at hapvs' <;> simp only at hapvs' ; rename_i r' _ + simp only at * ; subst pv' + have ⟨(a'', pv''), hpv'', h₃'⟩ := List.mapM_ok_implies_all_from_ok h₃ (a', .residual r') hpv' + simp only [Partial.bindAttr, do_ok, Prod.mk.injEq, exists_eq_right_right] at h₃' + replace ⟨h₃', h₃''⟩ := h₃' ; subst a'' + cases h₅ : req.context.mapMOnValues λ pv => Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) + <;> simp only [Except.bind_ok, Except.bind_err] + case error e => + -- subst_first produced an error because one of its `evaluateValue` calls did + replace ⟨pvₑ, hpvₑ, h₅⟩ := Map.mapMOnValues_error_implies_exists_error h₅ + have wf_pvₑ : pvₑ.WellFormed := wf_r.right pvₑ hpvₑ + replace ⟨a'', hpvₑ⟩ := Map.in_values_exists_key hpvₑ + replace ⟨pv''', hpv''', h₂⟩ := Map.mapMOnValues_ok_implies_all_ok h₂ (a'', pvₑ) hpvₑ + simp only at * + replace ⟨(a''', pv''''), hpv'''', h₃⟩ := List.mapM_ok_implies_all_ok h₃ (a'', pv''') hpv''' + simp only [Partial.bindAttr] at h₃ + replace ⟨pv'''', h₃, h_tmp⟩ := do_ok.mp h₃ + simp only [Prod.mk.injEq] at h_tmp ; replace ⟨h_tmp, h_tmp'⟩ := h_tmp; subst h_tmp h_tmp' + simp [ReevaluateValue.reeval_eqv_substituting_first wf_pvₑ wf_e wf_s h₂] at h₃ + simp [h₃] at h₅ + case ok apvs'' => + split <;> rename_i h₆ + <;> simp only [Except.ok.injEq, Partial.Value.residual.injEq, Partial.ResidualExpr.record.injEq] + · rename_i avs'' + -- subst_first produced a concrete value, `.value (.record avs'')` + replace ⟨pv', hpv''', h₂⟩ := Map.mapMOnValues_ok_implies_all_from_ok h₂ (a', pv'') hpv'' + simp only at * + have wf_pv' : pv'.WellFormed := wf_r.right pv' (Map.in_list_in_values hpv''') + simp only [ReevaluateValue.reeval_eqv_substituting_first wf_pv' wf_e wf_s h₂] at h₃' + replace ⟨pv'''', hpv'''', h₅⟩ := Map.mapMOnValues_ok_implies_all_ok h₅ (a', pv') hpv''' + simp [h₃'] at h₅ ; subst pv'''' + simp only at * + replace h₆ := Map.mapMOnValues_some_implies_all_some h₆ (a', .residual r') hpv'''' + simp at h₆ + · -- subst_first produced a residual, `.residual (.record apvs''.kvs)` + -- Need to show it's equal to the residual re-evaluated produced + sorry + +/-- + Re-evaluation with a substitution on the residual expression, is equivalent to + substituting first and then evaluating on the original expression. +-/ +theorem reeval_eqv_substituting_first (var : Var) (req req' : Partial.Request) (entities : Partial.Entities) (subsmap : Subsmap) + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) + (wf_s : subsmap.WellFormed) : + ReevalEquivSubstFirst (Spec.Expr.var var) req req' entities subsmap +:= by + unfold ReevalEquivSubstFirst + simp only [Partial.evaluate] + intro h_req + have h₁ := reeval_eqv_substituting_first_evaluateVar var entities wf_r wf_e wf_s h_req + simp only at h₁ ; exact h₁ + + +end Cedar.Thm.Partial.Evaluation.Reevaluation.Var diff --git a/cedar-lean/Cedar/Thm/Partial/Subst.lean b/cedar-lean/Cedar/Thm/Partial/Subst.lean index 4f4ee5838..56f19b787 100644 --- a/cedar-lean/Cedar/Thm/Partial/Subst.lean +++ b/cedar-lean/Cedar/Thm/Partial/Subst.lean @@ -23,6 +23,7 @@ import Cedar.Spec.Expr import Cedar.Thm.Data.List import Cedar.Thm.Data.LT import Cedar.Thm.Partial.Evaluation.Props +--import Cedar.Thm.Partial.IsRestricted import Cedar.Thm.Partial.WellFormed /-! ## Lemmas about `subst` operations -/ @@ -31,7 +32,7 @@ namespace Cedar.Thm.Partial.Subst open Cedar.Data open Cedar.Partial (Subsmap Unknown) -open Cedar.Spec (Attr EntityUID Error Prim) +open Cedar.Spec (Attr EntityUID Error Expr Prim) /-- Partial.Value.subst on a concrete value is that value @@ -66,31 +67,70 @@ theorem subst_concrete_values {pvals : List Partial.Value} {subsmap : Subsmap} : unfold IsAllConcrete exists vtl +private theorem sizeOf_elem_lt_sizeOf_prod [SizeOf α] [SizeOf β] (a : α) (b : β) : + sizeOf b < sizeOf (a, b) +:= by + conv => rhs ; simp [sizeOf, Prod._sizeOf_1] + conv => lhs ; simp [sizeOf] + omega + +mutual + /-- Partial.ResidualExpr.subst preserves well-formedness -/ theorem residual_subst_preserves_wf {x : Partial.ResidualExpr} {subsmap : Subsmap} : x.WellFormed → subsmap.WellFormed → (x.subst subsmap).WellFormed := by - cases x + cases x <;> + simp only [Partial.ResidualExpr.WellFormed, Partial.ResidualExpr.subst, + Partial.Value.WellFormed, and_imp, implies_true, true_implies, imp_self] case unknown u => - simp only [Partial.ResidualExpr.WellFormed, Partial.Value.WellFormed, - Partial.ResidualExpr.subst, true_implies] split - · rename_i h ; split at h - · subst h ; rename_i v _ h - replace h := Map.find?_mem_toList h - intro wf_s - suffices (Partial.Value.value v).WellFormed by simpa [Partial.Value.WellFormed] using this - apply wf_s.right - simp only [Map.toList] at h + · rename_i pv h + intro wf_s + simp only [Subsmap.WellFormed] at wf_s + apply wf_s.right + · replace h := Map.find?_mem_toList h exact Map.in_list_in_values h - · simp only at h - · simp only [implies_true] - all_goals { - simp only [Partial.ResidualExpr.WellFormed, Partial.Value.WellFormed, - Partial.ResidualExpr.subst, implies_true, imp_self] - } + · simp only [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed, implies_true] + case getAttr pv₁ attr | hasAttr pv₁ attr | unaryApp op attr => + exact val_subst_preserves_wf + case and pv₁ pv₂ | or pv₁ pv₂ | binaryApp op pv₁ pv₂ => + intro wf₁ wf₂ wf_s + and_intros + · exact val_subst_preserves_wf wf₁ wf_s + · exact val_subst_preserves_wf wf₂ wf_s + case ite pv₁ pv₂ pv₃ => + intro wf₁ wf₂ wf₃ wf_s + and_intros + · exact val_subst_preserves_wf wf₁ wf_s + · exact val_subst_preserves_wf wf₂ wf_s + · exact val_subst_preserves_wf wf₃ wf_s + case set pvs | call xfn pvs => + rw [List.map₁_eq_map] + simp only [List.mem_map, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂] + intro h₁ wf_s pv hpv + exact val_subst_preserves_wf (h₁ pv hpv) wf_s + case record apvs => + rw [List.map_attach₂_snd] + simp only [List.mem_map, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂] + intro h₁ wf_s (k, v) hkv + exact val_subst_preserves_wf (h₁ (k, v) hkv) wf_s +termination_by sizeOf x +decreasing_by + all_goals simp_wf + all_goals try omega + case _ => -- set + have := List.sizeOf_lt_of_mem hpv + omega + case _ => -- record + have h₂ := List.sizeOf_lt_of_mem hkv + have h₃ := sizeOf_elem_lt_sizeOf_prod k v + omega + case _ => -- call + have := List.sizeOf_lt_of_mem hpv + omega /-- Partial.Value.subst preserves well-formedness @@ -107,6 +147,65 @@ theorem val_subst_preserves_wf {pv : Partial.Value} {subsmap : Subsmap} : rw [h_tmp] ; clear h_tmp simp only [Partial.Value.subst] exact residual_subst_preserves_wf +termination_by sizeOf pv + +end + +/-- + Expr.substToPartialValue produces well-formed partial values +-/ +theorem substToPartialValue_wf (x : Expr) {req : Partial.Request} + (wf_r : req.WellFormed) : + (x.substToPartialValue req).WellFormed +:= by + cases x + case var v => + cases v <;> simp only [Expr.substToPartialValue] + case principal | action | resource => + split <;> simp only [Partial.Value.WellFormed, Spec.Value.WellFormed, Prim.WellFormed, Partial.ResidualExpr.WellFormed] + case context => + simp only [Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + unfold Partial.Request.WellFormed at wf_r + split at wf_r ; rename_i context ; simp only + intro (k, pv) hpv + exact wf_r.right pv (Map.in_list_in_values hpv) + all_goals simp only [Expr.substToPartialValue, Partial.Value.WellFormed, Partial.ResidualExpr.WellFormed] + case lit p => simp only [Spec.Value.WellFormed, Prim.WellFormed] + case getAttr x₁ attr | hasAttr x₁ attr | unaryApp op x₁ => + exact substToPartialValue_wf x₁ wf_r + case and x₁ x₂ | or x₁ x₂ | binaryApp op x₁ x₂ => + and_intros + · exact substToPartialValue_wf x₁ wf_r + · exact substToPartialValue_wf x₂ wf_r + case ite x₁ x₂ x₃ => + and_intros + · exact substToPartialValue_wf x₁ wf_r + · exact substToPartialValue_wf x₂ wf_r + · exact substToPartialValue_wf x₃ wf_r + case set xs | call xfn xs => + rw [List.map₁_eq_map] + simp only [List.mem_map, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂] + intro x _ + exact substToPartialValue_wf x wf_r + case record axs => + simp only [List.map_attach₂_snd, List.mem_map, forall_exists_index, and_imp, + forall_apply_eq_imp_iff₂] + intro (k, x) _ + exact substToPartialValue_wf x wf_r +termination_by x +decreasing_by + all_goals simp_wf + all_goals try omega + case _ h₁ => -- set + have := List.sizeOf_lt_of_mem h₁ + omega + case _ h₁ => -- record + have h₂ := List.sizeOf_lt_of_mem h₁ + have h₃ := sizeOf_elem_lt_sizeOf_prod k x + omega + case _ h₁ => -- call + have := List.sizeOf_lt_of_mem h₁ + omega /-- Partial.Request.subst preserves well-formedness @@ -455,3 +554,112 @@ theorem entities_subst_preserves_contains_on_attrsOrEmpty (entities : Partial.En apply wf.right simp only [← Map.in_list_iff_find?_some wf.left] at h₁ exact Map.in_list_in_values h₁ + +/-- + Variant of `entities_subst_preserves_attrs` for `Partial.attrsOf` +-/ +theorem attrsOf_subst_preserves_attrs {v₁ : Spec.Value} {entities : Partial.Entities} (subsmap : Subsmap) + (wf_v : v₁.WellFormed) : + Partial.attrsOf v₁ entities.attrs = .ok attrs → + (k, pval) ∈ attrs.kvs → + ∃ attrs', Partial.attrsOf v₁ (entities.subst subsmap).attrs = .ok attrs' ∧ (k, pval.subst subsmap) ∈ attrs'.kvs +:= by + cases v₁ <;> simp [Partial.attrsOf] + case prim p₁ => + cases p₁ <;> simp + case entityUID uid => exact entities_subst_preserves_attrs subsmap + case record r₁ => + simp only [Spec.Value.WellFormed] at wf_v + intro _ ; subst attrs + exact match pval with + | .value v => by simp [Subst.subst_concrete_value] + | .residual r => by + intro h₁ + replace h₁ := Map.in_mapOnValues_in_kvs' wf_v.left h₁ + simp at h₁ + +/-- + `Partial.Value.subst` on the result of `Spec.Expr.substToPartialValue` + gives the same result as if we first substitute the `req` and then do + `Spec.Expr.substToPartialValue` +-/ +theorem subst_substToPartialValue (x : Spec.Expr) {req : Partial.Request} {subsmap : Subsmap} : + req.subst subsmap = some req' → + (x.substToPartialValue req).subst subsmap = x.substToPartialValue req' +:= by + cases x + case var v => + simp [Partial.Request.subst] + intro p' h_p' a' h_a' r' h_r' h_req ; subst h_req + cases v <;> simp only [Spec.Expr.substToPartialValue] + case principal => + cases h_p : req.principal <;> cases p' + <;> simp [Partial.Value.subst, Partial.ResidualExpr.subst] + <;> simp [h_p, Partial.UidOrUnknown.subst] at h_p' + case known.known => exact h_p' + case unknown.unknown u₁ u₂ => + split at h_p' <;> rename_i h_p'' <;> simp at h_p' + · subst u₂ ; rename_i u₂ + simp [h_p''] + · subst u₂ ; simp [h_p''] + case unknown.known u uid => + split at h_p' <;> rename_i h_p'' <;> simp at h_p' + subst h_p' + simp [h_p''] + case action => + cases h_a : req.action <;> cases a' + <;> simp [Partial.Value.subst, Partial.ResidualExpr.subst] + <;> simp [h_a, Partial.UidOrUnknown.subst] at h_a' + case known.known => exact h_a' + case unknown.unknown u₁ u₂ => + split at h_a' <;> rename_i h_a'' <;> simp at h_a' + · subst u₂ ; rename_i u₂ + simp [h_a''] + · subst u₂ ; simp [h_a''] + case unknown.known u uid => + split at h_a' <;> rename_i h_a'' <;> simp at h_a' + subst h_a' + simp [h_a''] + case resource => + cases h_r : req.resource <;> cases r' + <;> simp [Partial.Value.subst, Partial.ResidualExpr.subst] + <;> simp [h_r, Partial.UidOrUnknown.subst] at h_r' + case known.known => exact h_r' + case unknown.unknown u₁ u₂ => + split at h_r' <;> rename_i h_r'' <;> simp at h_r' + · subst u₂ ; rename_i u₂ + simp [h_r''] + · subst u₂ ; simp [h_r''] + case unknown.known u uid => + split at h_r' <;> rename_i h_r'' <;> simp at h_r' + subst h_r' + simp [h_r''] + case context => + simp [Partial.Value.subst, Partial.ResidualExpr.subst, List.map_attach₂_snd, Map.mapOnValues] + all_goals simp [Spec.Expr.substToPartialValue, Partial.Value.subst, Partial.ResidualExpr.subst] + case and x₁ x₂ | or x₁ x₂ | binaryApp x₁ x₂ => + intro h_req + exact And.intro (subst_substToPartialValue x₁ h_req) (subst_substToPartialValue x₂ h_req) + case unaryApp x₁ | getAttr x₁ _ | hasAttr x₁ _ => exact subst_substToPartialValue x₁ + case ite x₁ x₂ x₃ => + intro h_req + and_intros + · exact subst_substToPartialValue x₁ h_req + · exact subst_substToPartialValue x₂ h_req + · exact subst_substToPartialValue x₃ h_req + case set xs | call xs => + simp [List.map₁_eq_map] + intro h_req + apply List.map_congr + intro x _ + simp only [Function.comp_apply] + exact subst_substToPartialValue x h_req + case record attrs => + simp [List.map_attach₂_snd] + intro h_req + apply List.map_congr + intro (a, x) hx + simp only [Function.comp_apply, Prod.mk.injEq, true_and] + have := List.sizeOf_snd_lt_sizeOf_list hx + exact subst_substToPartialValue x h_req +termination_by x diff --git a/cedar-lean/Cedar/Thm/Partial/WellFormed.lean b/cedar-lean/Cedar/Thm/Partial/WellFormed.lean index 87677672f..44e600d6b 100644 --- a/cedar-lean/Cedar/Thm/Partial/WellFormed.lean +++ b/cedar-lean/Cedar/Thm/Partial/WellFormed.lean @@ -65,13 +65,46 @@ end Cedar.Spec namespace Cedar.Partial -/-- All `ResidualExpr`s are structurally WellFormed. -/ +open Cedar.Data + +mutual + def ResidualExpr.WellFormed : Partial.ResidualExpr → Prop - | _ => true + | .and pv₁ pv₂ + | .or pv₁ pv₂ + | .binaryApp _ pv₁ pv₂ => + pv₁.WellFormed ∧ pv₂.WellFormed + | .ite pv₁ pv₂ pv₃ => + pv₁.WellFormed ∧ pv₂.WellFormed ∧ pv₃.WellFormed + | .unaryApp _ pv₁ + | .getAttr pv₁ _ + | .hasAttr pv₁ _ => + pv₁.WellFormed + | .set pvs + | .call _ pvs => + ∀ pv ∈ pvs, pv.WellFormed + | .record apvs => + ∀ kv ∈ apvs, kv.snd.WellFormed + | .unknown _ => + true +termination_by x => sizeOf x +decreasing_by + all_goals simp_wf + all_goals try omega + case _ | _ => -- set | call + rename_i h + have := List.sizeOf_lt_of_mem h + omega + case _ => -- record + rename_i h + exact List.sizeOf_snd_lt_sizeOf_list h def Value.WellFormed : Partial.Value → Prop | .value v => v.WellFormed | .residual r => r.WellFormed +termination_by pv => sizeOf pv + +end def Request.WellFormed : Partial.Request → Prop | { context, .. } => context.WellFormed ∧ ∀ pval ∈ context.values, pval.WellFormed From 32e3e0b23d23b8ca5e4a624c538e41dc142dae7c Mon Sep 17 00:00:00 2001 From: Craig Disselkoen Date: Wed, 31 Jul 2024 17:57:55 +0000 Subject: [PATCH 2/8] resolve one sorry Signed-off-by: Craig Disselkoen --- .../Partial/Evaluation/Evaluate/Binary.lean | 2 +- .../Partial/Evaluation/EvaluateBinaryApp.lean | 67 +++++++++++++++++- .../Thm/Partial/Evaluation/EvaluateValue.lean | 69 +++++++++++++++++-- 3 files changed, 132 insertions(+), 6 deletions(-) diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Binary.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Binary.lean index ceb3e374f..20c1feb4b 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Binary.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Binary.lean @@ -111,7 +111,7 @@ theorem subst_preserves_evaluation_to_value {x₁ x₂ : Expr} {op : BinaryOp} { <;> simp only [Partial.Value.value.injEq, forall_eq', false_implies, forall_const] at * case value.value v₁ v₂ => simp only [ih₁, ih₂, Except.bind_ok] - exact EvaluateBinaryApp.subst_preserves_evaluation_to_value + exact EvaluateBinaryApp.subst_preserves_evaluation_to_value subsmap all_goals simp only [Partial.evaluateBinaryApp, Except.ok.injEq, false_implies] /-- diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateBinaryApp.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateBinaryApp.lean index c975aa6e2..5956c570e 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateBinaryApp.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateBinaryApp.lean @@ -248,7 +248,7 @@ theorem partialApply₂_subst_preserves_evaluation_to_value {v₁ v₂ : Spec.Va If `Partial.evaluateBinaryApp` returns a concrete value, then it returns the same value after any substitution of unknowns in `entities` -/ -theorem subst_preserves_evaluation_to_value {pval₁ pval₂ : Partial.Value} {op : BinaryOp} {entities : Partial.Entities} {subsmap : Subsmap} : +theorem subst_preserves_evaluation_to_value {pval₁ pval₂ : Partial.Value} {op : BinaryOp} {entities : Partial.Entities} (subsmap : Subsmap) : Partial.evaluateBinaryApp op pval₁ pval₂ entities = .ok (.value v) → Partial.evaluateBinaryApp op pval₁ pval₂ (entities.subst subsmap) = .ok (.value v) := by @@ -306,6 +306,71 @@ theorem subst_preserves_errors {pval₁ pval₂ : Partial.Value} {op : BinaryOp} cases pval₁ <;> cases pval₂ <;> simp only [exists_false, imp_self] case value.value v₁ v₂ => exact partialApply₂_subst_preserves_errors +/-- + If `Partial.evaluateBinaryApp` returns an error, but reducing its args + succeeds, then it returns the same error on the reduced args +-/ +theorem reducing_arg_preserves_errors {pval₁ : Partial.Value} {op : BinaryOp} {entities : Partial.Entities} : + Partial.evaluateBinaryApp op pval₁ pval₂ entities = .error e → + Partial.evaluateValue pval₁ entities = .ok pval₁' → + Partial.evaluateValue pval₂ entities = .ok pval₂' → + Partial.evaluateBinaryApp op pval₁' pval₂' entities = .error e +:= by + cases pval₁ <;> cases pval₂ <;> simp [Partial.evaluateBinaryApp] + case value.value v₁ v₂ => + simp [Partial.evaluateValue] + intro h₁ _ _ ; subst pval₁' pval₂' + simp [h₁] + +/-- + If reducing the args then `Partial.evaluateBinaryApp` returns a concrete value, + then any subst before that process shouldn't make a difference. + + This is like `subst_preserves_evaluation_to_value` but with a reduce operation + in front of the `Partial.evaluateBinaryApp` in both cases + + Takes inductive hypotheses `ih₁` and `ih₂` which say that + `subst_preserves_evaluation_to_value` holds for `pv₁` and `pv₂` +-/ +theorem subst_preserves_reduce_evaluation_to_value {pv₁ pv₂ : Partial.Value} {op : BinaryOp} {entities : Partial.Entities} (subsmap : Subsmap) + (ih₁ : ∀ v, Partial.evaluateValue pv₁ entities = .ok (.value v) → Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) = .ok (.value v)) + (ih₂ : ∀ v, Partial.evaluateValue pv₂ entities = .ok (.value v) → Partial.evaluateValue (pv₂.subst subsmap) (entities.subst subsmap) = .ok (.value v)) : + Partial.evaluateValue pv₁ entities = .ok pv₁' → + Partial.evaluateValue pv₂ entities = .ok pv₂' → + Partial.evaluateBinaryApp op pv₁' pv₂' entities = .ok (.value v) → + ∃ pv₁'' pv₂'', + Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) = .ok pv₁'' ∧ + Partial.evaluateValue (pv₂.subst subsmap) (entities.subst subsmap) = .ok pv₂'' ∧ + Partial.evaluateBinaryApp op pv₁'' pv₂'' (entities.subst subsmap) = .ok (.value v) +:= by + cases pv₁ <;> cases pv₂ <;> simp [Partial.evaluateBinaryApp] + case value.value v₁ v₂ => + simp [Subst.subst_concrete_value, Partial.evaluateValue] + intro _ _ ; subst pv₁' pv₂' ; simp only + exact partialApply₂_subst_preserves_evaluation_to_value + case value.residual v₁ r₂ => + simp [Subst.subst_concrete_value, Partial.evaluateValue, Partial.Value.subst] at * + intro _ ; subst pv₁' + cases pv₂' <;> simp only [Except.ok.injEq, false_implies, implies_true] + case value v₂ => + intro h₁ + simp [ih₂ v₂ h₁] + exact partialApply₂_subst_preserves_evaluation_to_value + case residual.value r₁ v₂ => + simp [Subst.subst_concrete_value, Partial.evaluateValue, Partial.Value.subst] at * + intro h₁ _ ; subst pv₂' + cases pv₁' <;> simp only [Except.ok.injEq, false_implies] + case value v₁ => + simp [ih₁ v₁ h₁] + exact partialApply₂_subst_preserves_evaluation_to_value + case residual.residual r₁ r₂ => + simp [Partial.evaluateValue, Partial.Value.subst] at * + cases pv₁' <;> cases pv₂' <;> simp only [Except.ok.injEq, false_implies, implies_true] + case value.value v₁ v₂ => + intro h₁ h₂ + simp [ih₁ v₁ h₁, ih₂ v₂ h₂] + exact partialApply₂_subst_preserves_evaluation_to_value + /-- `Partial.apply₂` followed by a substitution and then `Partial.evaluateValue`, is equivalent to substituting first and then `Partial.apply₂` diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateValue.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateValue.lean index 020892065..fece3ef62 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateValue.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateValue.lean @@ -348,17 +348,78 @@ theorem evalResidual_subst_preserves_evaluation_to_value {r : Partial.ResidualEx subst e₂ simp [EvaluateUnaryApp.reducing_arg_preserves_errors h₄ hpv₁] at h₁ case ok pv₁'' => - have ⟨pv, h₅⟩ := EvaluateUnaryApp.subst_preserves_reduce_evaluation_to_value subsmap (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf) hpv₁ h₁ + have ⟨pv, h₅⟩ := + EvaluateUnaryApp.subst_preserves_reduce_evaluation_to_value subsmap + (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf) + hpv₁ h₁ simp [h₅] at hpv₁' · rename_i hₑ subst h₃ h₃' simp [h₂] at hₑ case ok pv₁'' => intro h₁ - have ⟨pv, h₂⟩ := EvaluateUnaryApp.subst_preserves_reduce_evaluation_to_value subsmap (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf) hpv₁ h₁ + have ⟨pv, h₂⟩ := + EvaluateUnaryApp.subst_preserves_reduce_evaluation_to_value subsmap + (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf) + hpv₁ h₁ simp [hpv₁'] at h₂ simp [h₂] - case binaryApp op pv₁ pv₂ => sorry + case binaryApp op pv₁ pv₂ => + have h₁ := EvaluateBinaryApp.reeval_eqv_substituting_first op pv₁ pv₂ entities subsmap wf.left wf.right + cases hpv₁ : Partial.evaluateValue pv₁ entities + <;> cases hpv₂ : Partial.evaluateValue pv₂ entities + <;> simp + case ok.ok pv₁' pv₂' => + cases hpv₁' : Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) + <;> cases hpv₂' : Partial.evaluateValue (pv₂.subst subsmap) (entities.subst subsmap) + <;> simp + <;> simp [hpv₁', hpv₂'] at h₁ + case error.error e₁ e₂ | error.ok e₁ pv₂'' => + split at h₁ <;> rename_i h₃ + <;> simp only [Prod.mk.injEq] at h₃ <;> replace ⟨h₃, h₃'⟩ := h₃ + · simp at h₃' ; subst h₃' ; rename_i e₃ + cases h₄ : Partial.evaluateBinaryApp op pv₁ pv₂ entities + <;> simp [h₄] at h₃ + case error e₄ => simp [EvaluateBinaryApp.reducing_arg_preserves_errors h₄ hpv₁ hpv₂] + case ok pv₁'' => + intro h₂ + have ⟨pv₁''', pv₂''', h₅⟩ := + EvaluateBinaryApp.subst_preserves_reduce_evaluation_to_value subsmap + (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.left) + (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.right) + hpv₁ hpv₂ h₂ + simp [h₅] at hpv₁' + · rename_i hₑ + subst h₃ h₃' + simp [h₁] at hₑ + case ok.error pv₁'' e₂ => + split at h₁ <;> rename_i h₃ + <;> simp only [Prod.mk.injEq] at h₃ <;> replace ⟨h₃, h₃'⟩ := h₃ + · simp at h₃' ; subst h₃' ; rename_i e₃ + cases h₄ : Partial.evaluateBinaryApp op pv₁ pv₂ entities + <;> simp [h₄] at h₃ + case error e₄ => simp [EvaluateBinaryApp.reducing_arg_preserves_errors h₄ hpv₁ hpv₂] + case ok pv₁'' => + intro h₂ + have ⟨pv₁''', pv₂''', h₅⟩ := + EvaluateBinaryApp.subst_preserves_reduce_evaluation_to_value subsmap + (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.left) + (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.right) + hpv₁ hpv₂ h₂ + simp [h₅] at hpv₂' + · rename_i hₑ + subst h₃ h₃' + simp [h₁] at hₑ + case ok.ok pv₁'' pv₂'' => + intro h₂ + have ⟨pv₁'''', pv₂'''', h₅, h₆, h₇⟩ := + EvaluateBinaryApp.subst_preserves_reduce_evaluation_to_value subsmap + (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.left) + (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.right) + hpv₁ hpv₂ h₂ + simp only [h₅, h₆, Except.ok.injEq] at hpv₁' hpv₂' + subst pv₁'''' pv₂'''' + exact h₇ case hasAttr pv₁ attr => sorry case getAttr pv₁ attr => sorry case set pvs => sorry @@ -635,7 +696,7 @@ theorem reduce_commutes_subst {pv : Partial.Value} {entities : Partial.Entities} | .ok b₁ => by cases b₁ all_goals try { - -- this dispatches the false case for and, and the true case for or + -- this dispatches the false case for `and`, and the true case for `or` simp only [Except.bind_ok, Bool.true_eq_false, Bool.false_eq_true, reduceIte, Except.ok.injEq] intro _ ; subst pv' simp only [Subst.subst_concrete_value, eval_spec_value] From b56d2c684d386387e891c891787dbdb872beebe4 Mon Sep 17 00:00:00 2001 From: Craig Disselkoen Date: Mon, 12 Aug 2024 16:44:13 +0000 Subject: [PATCH 3/8] address some sorrys in ReevaluateValue.lean Signed-off-by: Craig Disselkoen --- .../Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean index fcc118b03..6573e3cb2 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean @@ -581,7 +581,7 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p replace ⟨pv₂, hpv₂, h₇⟩ := List.mapM_error_implies_exists_error h₇ replace ⟨pv₃, hpv₃, h₁⟩ := List.mapM_ok_implies_all_from_ok h₁ pv₂ hpv₂ have wf₃ : pv₃.WellFormed := wf_r pv₃ hpv₃ - have : sizeOf pv₃ < sizeOf pvs := by sorry + have : sizeOf pv₃ < sizeOf pvs := List.sizeOf_lt_of_mem hpv₃ simp [reeval_eqv_substituting_first wf₃ wf_e wf_s h₁] at h₇ replace h₂ := List.mapM_ok_implies_all_ok h₂ pv₃ hpv₃ simp [h₇] at h₂ @@ -600,12 +600,12 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p case error e => replace ⟨pv₂', hpv₂', h₉⟩ := List.mapM_error_implies_exists_error h₉ replace ⟨pv'', hpv'', h₁⟩ := List.mapM_ok_implies_all_from_ok h₁ pv₂' hpv₂' - have wf'' : pv''.WellFormed := by sorry - have : sizeOf pv'' < sizeOf pvs := by sorry + have wf'' : pv''.WellFormed := wf_r pv'' hpv'' + have : sizeOf pv'' < sizeOf pvs := List.sizeOf_lt_of_mem hpv'' have : sizeOf pvs < sizeOf (Partial.ResidualExpr.set pvs) := EvaluateValue.sizeOf_lt_set pvs simp [reeval_eqv_substituting_first wf'' wf_e wf_s h₁] at h₉ cases pv₂' - case value v₂ => simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap (by sorry) h₁] at h₉ + case value v₂ => simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf'' h₁] at h₉ case residual r₂ => sorry case ok pvs₄ => @@ -618,6 +618,7 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p sorry case error e => replace ⟨pv, hpv, h₂⟩ := List.mapM_error_implies_exists_error h₂ + have wf_pv : pv.WellFormed := wf_r pv hpv split <;> rename_i h₃ <;> simp only [Except.ok.injEq] <;> intro _ <;> subst pv' · exfalso @@ -625,7 +626,7 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p replace ⟨pv₂, hpv₂, v₂, hv₂, h₁⟩ := mapM_ok_some h₁ h₃ pv hpv split at h₁ <;> simp at h₁ replace ⟨h₁, h₁'⟩ := h₁ ; subst v₂ ; rename_i v₂ - simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap (by sorry) h₁] at h₂ + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_pv h₁] at h₂ · replace ⟨pv', hpv', pv₂, hpv₂, h₁, h₃⟩ := mapM_ok_none h₁ h₃ split at h₃ <;> simp at h₃ ; rename_i r₂ simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual] From 72fa287e45c55e0b6cc7fdd5f9e32cf2da0b3d81 Mon Sep 17 00:00:00 2001 From: Craig Disselkoen Date: Mon, 12 Aug 2024 18:26:58 +0000 Subject: [PATCH 4/8] finish another proof Signed-off-by: Craig Disselkoen --- .../Thm/Partial/Evaluation/Evaluate.lean | 2 +- .../Thm/Partial/Evaluation/Evaluate/Var.lean | 86 +++++++++++++------ 2 files changed, 63 insertions(+), 25 deletions(-) diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate.lean index d63c1a323..457705639 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate.lean @@ -265,7 +265,7 @@ theorem subst_preserves_evaluation_to_value {expr : Expr} {req req' : Partial.Re have h₁ := Var.subst_preserves_evaluation_to_value var req req' entities subsmap wf_r unfold SubstPreservesEvaluationToConcrete at h₁ intro h_req - exact h₁ wf_s h_req v + exact h₁ h_req v case and x₁ x₂ => intro h_req h₁ have h₂ := And.evals_to_concrete_then_operands_eval_to_concrete (by diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Var.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Var.lean index bb11a816a..b58e53256 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Var.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Var.lean @@ -195,8 +195,7 @@ theorem subst_preserves_evaluate_req_context_to_value {req req' : Partial.Reques value after any substitution of unknowns -/ theorem subst_preserves_evaluateVar_to_value {var : Var} {req req' : Partial.Request} {entities : Partial.Entities} {v : Spec.Value} {subsmap : Subsmap} - (wf_r : req.WellFormed) - (wf_s : subsmap.WellFormed) : + (wf_r : req.WellFormed) : req.subst subsmap = some req' → Partial.evaluateVar var req entities = .ok (.value v) → Partial.evaluateVar var req' (entities.subst subsmap) = .ok (.value v) @@ -223,40 +222,79 @@ theorem subst_preserves_evaluateVar_to_value {var : Var} {req req' : Partial.Req simp only cases h₂ : req.context.mapMOnValues (Partial.evaluateValue · entities) <;> simp only [h₂, Except.bind_ok, Except.bind_err] at h₁ - case ok context' => + case ok context_ev => + -- `context_ev` is the "evaluated" context (i.e., `evaluateValue` applied to all the values) split at h₁ <;> simp only [Except.ok.injEq, Partial.Value.value.injEq] at h₁ ; subst h₁ rename_i m h₁ - -- `m` is the `Spec.Value`-valued version of `context'` (which we know has only concrete values from h₁) - sorry - /- - split <;> simp only [Except.ok.injEq, Partial.Value.value.injEq, Spec.Value.record.injEq] - · rename_i m' h₂ - -- `m'` is the `Spec.Value`-valued version of `req'.context` (which we know has only concrete values from h₂) - replace h₁ := subst_preserves_evaluate_req_context_to_value wf_r wf_s h_req h₁ - suffices some m = some m' by simpa using this.symm - rw [← h₁, ← h₂] - rfl - · rename_i h₂ - replace ⟨pval, h₂, h₃⟩ := Map.mapMOnValues_none_iff_exists_none.mp h₂ - cases pval <;> simp only at h₃ - case residual r => - replace ⟨k, h₂⟩ := Map.in_values_exists_key h₂ - have ⟨v, h₄⟩ := subst_preserves_all_concrete wf_r wf_s h_req h₁ h₂ - simp at h₄ - -/ + -- `m` is the `Spec.Value`-valued version of `context_ev` (which we know has only concrete values from h₁) + simp [Partial.Request.subst] at h_req + replace ⟨p, _, a, _, r, _, h_req⟩ := h_req + subst req' ; simp [Map.mapMOnValues_mapOnValues] + cases h₃ : req.context.mapMOnValues λ pv => Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) + <;> simp only [Except.bind_err, Except.bind_ok] + case error e => + replace ⟨pv, hpv, h₃⟩ := Map.mapMOnValues_error_implies_exists_error h₃ + replace ⟨k, hpv⟩ := Map.in_values_exists_key hpv + replace ⟨pv', hpv', h₂⟩ := Map.mapMOnValues_ok_implies_all_ok h₂ (k, pv) hpv + simp only at * + replace ⟨pv'', hpv'', h₁⟩ := Map.mapMOnValues_some_implies_all_some h₁ (k, pv') hpv' + split at h₁ <;> simp at h₁ ; subst pv'' ; simp only at * ; subst pv' ; rename_i v + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap (wf_r.right pv (Map.in_list_in_values hpv)) h₂] at h₃ + case ok context_ev' => + split <;> simp <;> rename_i h₄ + · rename_i m' + suffices context_ev = context_ev' by subst context_ev' ; simpa [h₄] using h₁ + have wf₁ : context_ev.WellFormed := Map.mapMOnValues_ok_wf wf_r.left h₂ + have wf₂ : context_ev'.WellFormed := Map.mapMOnValues_ok_wf wf_r.left h₃ + rw [← Map.eq_iff_kvs_equiv wf₁ wf₂] ; simp [List.Equiv, List.subset_def] + and_intros + · intro (k, pv') hpv' + replace ⟨pv, hpv, h₂⟩ := Map.mapMOnValues_ok_implies_all_from_ok h₂ (k, pv') hpv' + simp only at * + replace ⟨pv'', hpv'', h₃⟩ := Map.mapMOnValues_ok_implies_all_ok h₃ (k, pv) hpv + simp only at * + replace ⟨v, hv, h₄⟩ := Map.mapMOnValues_some_implies_all_some h₄ (k, pv'') hpv'' + split at h₄ <;> simp at h₄ ; subst v ; simp only at * ; subst pv'' ; rename_i v + replace ⟨v', hv', h₁⟩ := Map.mapMOnValues_some_implies_all_some h₁ (k, pv') hpv' + split at h₁ <;> simp at h₁ ; subst v' ; simp only at * ; subst pv' ; rename_i v' + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap (wf_r.right pv (Map.in_list_in_values hpv)) h₂] at h₃ + subst v' + exact hpv'' + · intro (k, pv) hpv + replace ⟨pv', hpv', h₄⟩ := Map.mapMOnValues_some_implies_all_some h₄ (k, pv) hpv + split at h₄ <;> simp at h₄ ; subst pv' ; simp only at * ; subst pv ; rename_i v + replace ⟨pv'', hpv'', h₃⟩ := Map.mapMOnValues_ok_implies_all_from_ok h₃ (k, .value v) hpv + simp only at * + replace ⟨pv''', hpv''', h₂⟩ := Map.mapMOnValues_ok_implies_all_ok h₂ (k, pv'') hpv'' + simp only at * + replace ⟨v', hv', h₁⟩ := Map.mapMOnValues_some_implies_all_some h₁ (k, pv''') hpv''' + split at h₁ <;> simp at h₁ ; subst v' ; simp only at * ; subst pv''' ; rename_i v' + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap (wf_r.right pv'' (Map.in_list_in_values hpv'')) h₂] at h₃ + subst v' + exact hpv''' + · replace ⟨pv, hpv, h₄⟩ := Map.mapMOnValues_none_iff_exists_none.mp h₄ + split at h₄ <;> simp at h₄ ; rename_i r + replace ⟨k, hpv⟩ := Map.in_values_exists_key hpv + replace ⟨pv', hpv', h₃⟩ := Map.mapMOnValues_ok_implies_all_from_ok h₃ (k, .residual r) hpv + simp only at * + replace ⟨pv'', hpv'', h₂⟩ := Map.mapMOnValues_ok_implies_all_ok h₂ (k, pv') hpv' + simp only at * + replace ⟨v, hv, h₁⟩ := Map.mapMOnValues_some_implies_all_some h₁ (k, pv'') hpv'' + simp only at * + split at h₁ <;> simp at h₁ ; subst v ; rename_i v + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap (wf_r.right pv' (Map.in_list_in_values hpv')) h₂] at h₃ /-- If partial-evaluation of a `Var` returns a concrete value, then it returns the same value after any substitution of unknowns -/ theorem subst_preserves_evaluation_to_value (var : Var) (req req' : Partial.Request) (entities : Partial.Entities) (subsmap : Subsmap) - (wf_r : req.WellFormed) - (wf_s : subsmap.WellFormed) : + (wf_r : req.WellFormed) : SubstPreservesEvaluationToConcrete (Expr.var var) req req' entities subsmap := by unfold SubstPreservesEvaluationToConcrete Partial.evaluate intro h_req v - exact subst_preserves_evaluateVar_to_value wf_r wf_s h_req + exact subst_preserves_evaluateVar_to_value wf_r h_req /-- If `Partial.evaluateVar` returns an error, then it also returns an error (not From 5b3a76caca81ad50b08dcf72dd3983c9408e7d9b Mon Sep 17 00:00:00 2001 From: Craig Disselkoen Date: Mon, 12 Aug 2024 18:33:19 +0000 Subject: [PATCH 5/8] whoops remove bad import Signed-off-by: Craig Disselkoen --- cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean | 1 - 1 file changed, 1 deletion(-) diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean index 6573e3cb2..ceb0932ef 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean @@ -21,7 +21,6 @@ import Cedar.Thm.Partial.Evaluation.EvaluateBinaryApp import Cedar.Thm.Partial.Evaluation.EvaluateHasAttr import Cedar.Thm.Partial.Evaluation.EvaluateValue import Cedar.Thm.Partial.Evaluation.ReevaluateGetAttr -import Cedar.Thm.Partial.Evaluation.Tactic import Cedar.Thm.Partial.Subst /-! This file contains theorems about reevaluation of `Partial.evaluateValue` (and `Partial.evaluateResidual`). -/ From 7872751e81fece6b80414c2859fa1559774abda8 Mon Sep 17 00:00:00 2001 From: Craig Disselkoen Date: Wed, 14 Aug 2024 15:41:37 +0000 Subject: [PATCH 6/8] fill in another case Signed-off-by: Craig Disselkoen --- .../Thm/Partial/Evaluation/Evaluate.lean | 2 +- .../Partial/Evaluation/Evaluate/GetAttr.lean | 2 +- .../Partial/Evaluation/Evaluate/HasAttr.lean | 2 +- .../Thm/Partial/Evaluation/Evaluate/Var.lean | 16 ++-- .../Partial/Evaluation/EvaluateGetAttr.lean | 4 +- .../Partial/Evaluation/EvaluateHasAttr.lean | 43 ++++++++- .../Thm/Partial/Evaluation/EvaluateValue.lean | 91 +++++++++++++------ .../Partial/Evaluation/ReevaluateHasAttr.lean | 48 ++++++++++ .../Partial/Evaluation/ReevaluateValue.lean | 42 ++++----- .../Evaluation/Reevaluation/HasAttr.lean | 36 +------- .../Partial/Evaluation/Reevaluation/Var.lean | 8 +- 11 files changed, 195 insertions(+), 99 deletions(-) create mode 100644 cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateHasAttr.lean diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate.lean index 457705639..4c89d3fbc 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate.lean @@ -262,7 +262,7 @@ theorem subst_preserves_evaluation_to_value {expr : Expr} {req req' : Partial.Re intro _ h₁ ; subst h₁ rfl case var var => - have h₁ := Var.subst_preserves_evaluation_to_value var req req' entities subsmap wf_r + have h₁ := Var.subst_preserves_evaluation_to_value var req req' entities subsmap wf_r wf_e unfold SubstPreservesEvaluationToConcrete at h₁ intro h_req exact h₁ h_req v diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/GetAttr.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/GetAttr.lean index 342445241..8b67a3aee 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/GetAttr.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/GetAttr.lean @@ -95,7 +95,7 @@ theorem subst_preserves_evaluation_to_value {x₁ : Expr} {attr : Attr} {req req simp only [ih₁, Except.bind_ok] apply EvaluateGetAttr.subst_preserves_evaluation_to_value _ wf_e wf_s intro v v' pv wf_v h₁ - apply EvaluateValue.subst_preserves_evaluation_to_value subsmap (EvaluateGetAttr.getAttr_wf wf_v wf_e _ h₁) + apply EvaluateValue.subst_preserves_evaluation_to_value subsmap (EvaluateGetAttr.getAttr_wf wf_v wf_e _ h₁) wf_e exact h_pewf _ _ _ (.value v₁) (Subst.req_subst_preserves_wf wf_r wf_s h_req) (Subst.entities_subst_preserves_wf wf_e wf_s) ih₁ /-- diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/HasAttr.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/HasAttr.lean index d7c4b7c09..70cfbf86a 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/HasAttr.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/HasAttr.lean @@ -102,7 +102,7 @@ theorem subst_preserves_evaluation_to_value {x₁ : Expr} {attr : Attr} {req req case value v₁ => simp only [Partial.Value.value.injEq, forall_eq'] at * simp only [ih₁, Except.bind_ok] - exact EvaluateHasAttr.subst_preserves_evaluation_to_value wf + exact EvaluateHasAttr.subst_preserves_evaluation_to_value subsmap wf /-- Inductive argument that if partial-evaluation of an `Expr.hasAttr` diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Var.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Var.lean index b58e53256..6f6ad0e69 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Var.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Evaluate/Var.lean @@ -195,7 +195,8 @@ theorem subst_preserves_evaluate_req_context_to_value {req req' : Partial.Reques value after any substitution of unknowns -/ theorem subst_preserves_evaluateVar_to_value {var : Var} {req req' : Partial.Request} {entities : Partial.Entities} {v : Spec.Value} {subsmap : Subsmap} - (wf_r : req.WellFormed) : + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) : req.subst subsmap = some req' → Partial.evaluateVar var req entities = .ok (.value v) → Partial.evaluateVar var req' (entities.subst subsmap) = .ok (.value v) @@ -239,7 +240,7 @@ theorem subst_preserves_evaluateVar_to_value {var : Var} {req req' : Partial.Req simp only at * replace ⟨pv'', hpv'', h₁⟩ := Map.mapMOnValues_some_implies_all_some h₁ (k, pv') hpv' split at h₁ <;> simp at h₁ ; subst pv'' ; simp only at * ; subst pv' ; rename_i v - simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap (wf_r.right pv (Map.in_list_in_values hpv)) h₂] at h₃ + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap (wf_r.right pv (Map.in_list_in_values hpv)) wf_e h₂] at h₃ case ok context_ev' => split <;> simp <;> rename_i h₄ · rename_i m' @@ -257,7 +258,7 @@ theorem subst_preserves_evaluateVar_to_value {var : Var} {req req' : Partial.Req split at h₄ <;> simp at h₄ ; subst v ; simp only at * ; subst pv'' ; rename_i v replace ⟨v', hv', h₁⟩ := Map.mapMOnValues_some_implies_all_some h₁ (k, pv') hpv' split at h₁ <;> simp at h₁ ; subst v' ; simp only at * ; subst pv' ; rename_i v' - simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap (wf_r.right pv (Map.in_list_in_values hpv)) h₂] at h₃ + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap (wf_r.right pv (Map.in_list_in_values hpv)) wf_e h₂] at h₃ subst v' exact hpv'' · intro (k, pv) hpv @@ -269,7 +270,7 @@ theorem subst_preserves_evaluateVar_to_value {var : Var} {req req' : Partial.Req simp only at * replace ⟨v', hv', h₁⟩ := Map.mapMOnValues_some_implies_all_some h₁ (k, pv''') hpv''' split at h₁ <;> simp at h₁ ; subst v' ; simp only at * ; subst pv''' ; rename_i v' - simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap (wf_r.right pv'' (Map.in_list_in_values hpv'')) h₂] at h₃ + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap (wf_r.right pv'' (Map.in_list_in_values hpv'')) wf_e h₂] at h₃ subst v' exact hpv''' · replace ⟨pv, hpv, h₄⟩ := Map.mapMOnValues_none_iff_exists_none.mp h₄ @@ -282,19 +283,20 @@ theorem subst_preserves_evaluateVar_to_value {var : Var} {req req' : Partial.Req replace ⟨v, hv, h₁⟩ := Map.mapMOnValues_some_implies_all_some h₁ (k, pv'') hpv'' simp only at * split at h₁ <;> simp at h₁ ; subst v ; rename_i v - simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap (wf_r.right pv' (Map.in_list_in_values hpv')) h₂] at h₃ + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap (wf_r.right pv' (Map.in_list_in_values hpv')) wf_e h₂] at h₃ /-- If partial-evaluation of a `Var` returns a concrete value, then it returns the same value after any substitution of unknowns -/ theorem subst_preserves_evaluation_to_value (var : Var) (req req' : Partial.Request) (entities : Partial.Entities) (subsmap : Subsmap) - (wf_r : req.WellFormed) : + (wf_r : req.WellFormed) + (wf_e : entities.WellFormed) : SubstPreservesEvaluationToConcrete (Expr.var var) req req' entities subsmap := by unfold SubstPreservesEvaluationToConcrete Partial.evaluate intro h_req v - exact subst_preserves_evaluateVar_to_value wf_r h_req + exact subst_preserves_evaluateVar_to_value wf_r wf_e h_req /-- If `Partial.evaluateVar` returns an error, then it also returns an error (not diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateGetAttr.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateGetAttr.lean index 7a7f16843..afef7ddc8 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateGetAttr.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateGetAttr.lean @@ -164,7 +164,7 @@ theorem subst_and_reduce_preserves_errors {pval₁ : Partial.Value} {attr : Attr Partial.evaluateValue pv entities = .error e → ∃ e', Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) = .error e') (h_pevwf : ∀ pv es pv', pv.WellFormed → es.WellFormed → Partial.evaluateValue pv es = .ok pv' → pv'.WellFormed) - (h_erspetv : ∀ r es v, r.WellFormed → + (h_erspetv : ∀ r es v, r.WellFormed → es.WellFormed → Partial.evaluateResidual r es = .ok (.value v) → Partial.evaluateValue (r.subst subsmap) (es.subst subsmap) = .ok (.value v) ) : Partial.evaluateValue pval₁ entities = .ok pval₂ → @@ -180,7 +180,7 @@ theorem subst_and_reduce_preserves_errors {pval₁ : Partial.Value} {attr : Attr exact subst_preserves_errors wf_v wf_e wf_s ih h₁ case residual r₁ => simp only [Partial.Value.WellFormed] at wf_v - specialize h_erspetv r₁ entities ; simp only [wf_v] at h_erspetv + specialize h_erspetv r₁ entities ; simp only [wf_v, wf_e] at h_erspetv intro h₁ h₂ h₃ have wf₃ : pval₃.WellFormed := by apply h_pevwf ((Partial.Value.residual r₁).subst subsmap) (entities.subst subsmap) pval₃ _ _ h₃ diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateHasAttr.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateHasAttr.lean index 5ea930e4e..c77667471 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateHasAttr.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateHasAttr.lean @@ -131,7 +131,7 @@ theorem returns_concrete_then_operand_evals_to_concrete {pval₁ : Partial.Value The return value of `Partial.hasAttr` is not affected by substitution of unknowns in `entities` -/ -theorem hasAttr_subst_const {v₁ : Spec.Value} {attr : Attr} {entities : Partial.Entities} {subsmap : Subsmap} +theorem hasAttr_subst_const {v₁ : Spec.Value} {attr : Attr} {entities : Partial.Entities} (subsmap : Subsmap) (wf : entities.WellFormed) : Partial.hasAttr v₁ attr entities = Partial.hasAttr v₁ attr (entities.subst subsmap) := by @@ -147,14 +147,14 @@ theorem hasAttr_subst_const {v₁ : Spec.Value} {attr : Attr} {entities : Partia If `Partial.evaluateHasAttr` returns a concrete value, then it returns the same value after any substitution of unknowns in `entities` -/ -theorem subst_preserves_evaluation_to_value {pval₁ : Partial.Value} {attr : Attr} {entities : Partial.Entities} {subsmap : Subsmap} +theorem subst_preserves_evaluation_to_value {pval₁ : Partial.Value} {attr : Attr} {entities : Partial.Entities} (subsmap : Subsmap) (wf : entities.WellFormed) : Partial.evaluateHasAttr pval₁ attr entities = .ok (.value v) → Partial.evaluateHasAttr pval₁ attr (entities.subst subsmap) = .ok (.value v) := by unfold Partial.evaluateHasAttr cases pval₁ <;> simp only [Except.ok.injEq, imp_self] - case value v₁ => simp only [← hasAttr_subst_const wf, imp_self] + case value v₁ => simp only [← hasAttr_subst_const subsmap wf, imp_self] /-- If `Partial.hasAttr` returns an error, then it also returns an error (not @@ -208,7 +208,7 @@ theorem subst_and_reduce_preserves_errors {pval₁ : Partial.Value} {attr : Attr (wf_e : entities.WellFormed) (wf_s : subsmap.WellFormed) (h_pevwf : ∀ pv es pv', pv.WellFormed → es.WellFormed → Partial.evaluateValue pv es = .ok pv' → pv'.WellFormed) - (h_erspetv : ∀ r es v, r.WellFormed → + (h_erspetv : ∀ r es v, r.WellFormed → es.WellFormed → Partial.evaluateResidual r es = .ok (.value v) → Partial.evaluateValue (r.subst subsmap) (es.subst subsmap) = .ok (.value v) ) : Partial.evaluateValue pval₁ entities = .ok pval₂ → @@ -224,7 +224,7 @@ theorem subst_and_reduce_preserves_errors {pval₁ : Partial.Value} {attr : Attr exact subst_preserves_errors subsmap h₁ case residual r₁ => simp only [Partial.Value.WellFormed] at wf_v - specialize h_erspetv r₁ entities ; simp only [wf_v] at h_erspetv + specialize h_erspetv r₁ entities ; simp only [wf_v, wf_e] at h_erspetv intro h₁ h₂ h₃ have wf₃ : pval₃.WellFormed := by apply h_pevwf ((Partial.Value.residual r₁).subst subsmap) (entities.subst subsmap) pval₃ _ _ h₃ @@ -237,3 +237,36 @@ theorem subst_and_reduce_preserves_errors {pval₁ : Partial.Value} {attr : Attr simp [h_erspetv v₂ h₁] at h₃ ; subst pval₃ exact h₂ case a.residual r₂ => simp [Partial.evaluateHasAttr] at h₂ + +/-- + If reducing the arg then `Partial.evaluateHasAttr` returns a concrete value, + then any subst before that process shouldn't make a difference. + + This is like `subst_preserves_evaluation_to_value` but with a reduce operation + in front of the `Partial.evaluateHasAttr` in both cases + + Takes an inductive hypothesis `ih` which says that + `subst_preserves_evaluation_to_value` holds for `pv₁` +-/ +theorem subst_preserves_reduce_evaluation_to_value {pv₁ pv₂ : Partial.Value} {attr : Attr} {entities : Partial.Entities} (subsmap : Subsmap) + (wf_e : entities.WellFormed) + (ih : ∀ v, Partial.evaluateValue pv₁ entities = .ok (.value v) → Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) = .ok (.value v)) : + Partial.evaluateValue pv₁ entities = .ok pv₂ → + Partial.evaluateHasAttr pv₂ attr entities = .ok (.value v) → + ∃ pv₃, + Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) = .ok pv₃ ∧ + Partial.evaluateHasAttr pv₃ attr (entities.subst subsmap) = .ok (.value v) +:= by + cases pv₁ <;> simp [Partial.evaluateHasAttr] + case value v₁ => + simp [Subst.subst_concrete_value, Partial.evaluateValue] + intro _ ; subst pv₂ + simp only [do_ok, Partial.Value.value.injEq, exists_eq_right] + simp only [hasAttr_subst_const subsmap wf_e, imp_self] + case residual r₁ => + cases pv₂ <;> simp only [Except.ok.injEq, false_implies, implies_true] + case value v₂ => + intro h₁ h₂ + rw [hasAttr_subst_const subsmap wf_e] at h₂ + specialize ih v₂ h₁ + exists (.value v₂) diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateValue.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateValue.lean index fece3ef62..00b5d8fd9 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateValue.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateValue.lean @@ -26,6 +26,7 @@ import Cedar.Thm.Partial.Evaluation.EvaluateGetAttr import Cedar.Thm.Partial.Evaluation.EvaluateHasAttr import Cedar.Thm.Partial.Evaluation.EvaluateUnaryApp import Cedar.Thm.Partial.Evaluation.Evaluate.Record +import Cedar.Thm.Partial.Evaluation.ReevaluateHasAttr import Cedar.Thm.Partial.Evaluation.ReevaluateUnaryApp import Cedar.Thm.Partial.WellFormed @@ -293,7 +294,8 @@ mutual unknowns -/ theorem evalResidual_subst_preserves_evaluation_to_value {r : Partial.ResidualExpr} {entities : Partial.Entities} {v : Spec.Value} {subsmap : Subsmap} - (wf : r.WellFormed) : + (wf : r.WellFormed) + (wf_e : entities.WellFormed) : Partial.evaluateResidual r entities = .ok (.value v) → Partial.evaluateValue (r.subst subsmap) (entities.subst subsmap) = .ok (.value v) := by @@ -308,7 +310,7 @@ theorem evalResidual_subst_preserves_evaluation_to_value {r : Partial.ResidualEx case value v₁' => cases hv₁' : v₁'.asBool <;> simp only [Except.bind_ok, Except.bind_err, false_implies] case ok b₁' => - cases b₁' <;> simp [subst_preserves_evaluation_to_value subsmap wf.left hpv₁, hv₁'] + cases b₁' <;> simp [subst_preserves_evaluation_to_value subsmap wf.left wf_e hpv₁, hv₁'] all_goals { cases hpv₂ : Partial.evaluateValue pv₂ entities <;> simp case ok pv₂' => @@ -317,7 +319,7 @@ theorem evalResidual_subst_preserves_evaluation_to_value {r : Partial.ResidualEx cases hv₂' : v₂'.asBool <;> simp case ok b₂' => intro _ ; subst v - simp [subst_preserves_evaluation_to_value subsmap wf.right hpv₂, hv₂'] + simp [subst_preserves_evaluation_to_value subsmap wf.right wf_e hpv₂, hv₂'] } case ite pv₁ pv₂ pv₃ => cases hpv₁ : Partial.evaluateValue pv₁ entities <;> simp @@ -326,11 +328,11 @@ theorem evalResidual_subst_preserves_evaluation_to_value {r : Partial.ResidualEx case value v₁' => cases hv₁' : v₁'.asBool <;> simp case ok b₁' => - cases b₁' <;> simp [subst_preserves_evaluation_to_value subsmap wf.left hpv₁, hv₁'] + cases b₁' <;> simp [subst_preserves_evaluation_to_value subsmap wf.left wf_e hpv₁, hv₁'] case true => - intro hpv₂ ; simp [subst_preserves_evaluation_to_value subsmap wf.right.left hpv₂] + intro hpv₂ ; simp [subst_preserves_evaluation_to_value subsmap wf.right.left wf_e hpv₂] case false => - intro hpv₃ ; simp [subst_preserves_evaluation_to_value subsmap wf.right.right hpv₃] + intro hpv₃ ; simp [subst_preserves_evaluation_to_value subsmap wf.right.right wf_e hpv₃] case unaryApp op pv₁ => cases hpv₁ : Partial.evaluateValue pv₁ entities <;> simp case ok pv₁' => @@ -350,7 +352,7 @@ theorem evalResidual_subst_preserves_evaluation_to_value {r : Partial.ResidualEx case ok pv₁'' => have ⟨pv, h₅⟩ := EvaluateUnaryApp.subst_preserves_reduce_evaluation_to_value subsmap - (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf) + (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf wf_e) hpv₁ h₁ simp [h₅] at hpv₁' · rename_i hₑ @@ -360,7 +362,7 @@ theorem evalResidual_subst_preserves_evaluation_to_value {r : Partial.ResidualEx intro h₁ have ⟨pv, h₂⟩ := EvaluateUnaryApp.subst_preserves_reduce_evaluation_to_value subsmap - (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf) + (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf wf_e) hpv₁ h₁ simp [hpv₁'] at h₂ simp [h₂] @@ -385,8 +387,8 @@ theorem evalResidual_subst_preserves_evaluation_to_value {r : Partial.ResidualEx intro h₂ have ⟨pv₁''', pv₂''', h₅⟩ := EvaluateBinaryApp.subst_preserves_reduce_evaluation_to_value subsmap - (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.left) - (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.right) + (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.left wf_e) + (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.right wf_e) hpv₁ hpv₂ h₂ simp [h₅] at hpv₁' · rename_i hₑ @@ -403,8 +405,8 @@ theorem evalResidual_subst_preserves_evaluation_to_value {r : Partial.ResidualEx intro h₂ have ⟨pv₁''', pv₂''', h₅⟩ := EvaluateBinaryApp.subst_preserves_reduce_evaluation_to_value subsmap - (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.left) - (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.right) + (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.left wf_e) + (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.right wf_e) hpv₁ hpv₂ h₂ simp [h₅] at hpv₂' · rename_i hₑ @@ -414,13 +416,48 @@ theorem evalResidual_subst_preserves_evaluation_to_value {r : Partial.ResidualEx intro h₂ have ⟨pv₁'''', pv₂'''', h₅, h₆, h₇⟩ := EvaluateBinaryApp.subst_preserves_reduce_evaluation_to_value subsmap - (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.left) - (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.right) + (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.left wf_e) + (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf.right wf_e) hpv₁ hpv₂ h₂ simp only [h₅, h₆, Except.ok.injEq] at hpv₁' hpv₂' subst pv₁'''' pv₂'''' exact h₇ - case hasAttr pv₁ attr => sorry + case hasAttr pv₁ attr => + cases hpv₁ : Partial.evaluateValue pv₁ entities <;> simp + case ok pv₁' => + cases hpv₁' : Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) <;> simp + case error e => + intro h₁ + have h₂ := ReevaluateHasAttr.reeval_eqv_substituting_first pv₁ attr subsmap wf_e wf + simp [hpv₁'] at h₂ + cases h₃ : Partial.evaluateHasAttr pv₁ attr entities + <;> simp [h₃] at h₂ + <;> simp [Partial.evaluateHasAttr] at h₃ + case error e => + subst e + split at h₃ + · simp [Subst.subst_concrete_value, eval_spec_value] at hpv₁' + · simp at h₃ + case ok pv₂ => + split at h₃ + · simp [Subst.subst_concrete_value, eval_spec_value] at hpv₁' + · rename_i r₁ + simp only [Partial.Value.WellFormed] at wf + simp at h₃ + subst pv₂ + simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual] at * + simp [hpv₁'] at h₂ + replace ⟨v₁, h₁⟩ := EvaluateHasAttr.returns_concrete_then_operand_evals_to_concrete h₁ + subst pv₁' + simp [evalResidual_subst_preserves_evaluation_to_value wf wf_e hpv₁] at hpv₁' + case ok pv₁'' => + intro h₁ + have ⟨pv, h₂⟩ := + EvaluateHasAttr.subst_preserves_reduce_evaluation_to_value subsmap wf_e + (by intro v ; exact subst_preserves_evaluation_to_value subsmap wf wf_e) + hpv₁ h₁ + simp [hpv₁'] at h₂ + simp [h₂] case getAttr pv₁ attr => sorry case set pvs => sorry case record attrs => sorry @@ -431,7 +468,8 @@ theorem evalResidual_subst_preserves_evaluation_to_value {r : Partial.ResidualEx value after any substitution of unknowns -/ theorem subst_preserves_evaluation_to_value {pv : Partial.Value} {entities : Partial.Entities} {v : Spec.Value} (subsmap : Subsmap) - (wf : pv.WellFormed) : + (wf : pv.WellFormed) + (wf_e : entities.WellFormed) : Partial.evaluateValue pv entities = .ok (.value v) → Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) = .ok (.value v) := by @@ -442,7 +480,7 @@ theorem subst_preserves_evaluation_to_value {pv : Partial.Value} {entities : Par case residual r => simp only [Partial.Value.subst] simp only [Partial.Value.WellFormed] at wf - exact evalResidual_subst_preserves_evaluation_to_value wf + exact evalResidual_subst_preserves_evaluation_to_value wf wf_e end @@ -474,7 +512,7 @@ theorem evalResidual_subst_preserves_errors {r : Partial.ResidualExpr} {entities case ok pv₁' => cases pv₁' <;> simp only [false_implies] case value v₁' => - simp only [subst_preserves_evaluation_to_value subsmap wf_r.left hpv₁, Except.bind_ok] + simp only [subst_preserves_evaluation_to_value subsmap wf_r.left wf_e hpv₁, Except.bind_ok] cases v₁'.asBool <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq, exists_eq', implies_true] case ok b₁' => @@ -493,7 +531,7 @@ theorem evalResidual_subst_preserves_errors {r : Partial.ResidualExpr} {entities case ok pv₂' => cases pv₂' <;> simp only [false_implies] case value v₂' => - simp only [subst_preserves_evaluation_to_value subsmap wf_r.right hpv₂, Except.bind_ok] + simp only [subst_preserves_evaluation_to_value subsmap wf_r.right wf_e hpv₂, Except.bind_ok] cases v₂'.asBool case error e₂' => intro _ ; exists e₂' case ok b₂' => simp only [Except.bind_ok, exists_false, imp_self] @@ -508,7 +546,7 @@ theorem evalResidual_subst_preserves_errors {r : Partial.ResidualExpr} {entities case ok pv₁' => cases pv₁' <;> simp only [false_implies] case value v₁' => - simp only [subst_preserves_evaluation_to_value subsmap wf_r.left hpv₁, Except.bind_ok] + simp only [subst_preserves_evaluation_to_value subsmap wf_r.left wf_e hpv₁, Except.bind_ok] cases v₁'.asBool <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq, exists_eq', implies_true] case ok b₁' => @@ -570,7 +608,7 @@ theorem evalResidual_subst_preserves_errors {r : Partial.ResidualExpr} {entities · intro _ _ _ exact evalValue_wf · intro _ _ _ - exact evalResidual_subst_preserves_evaluation_to_value + apply evalResidual_subst_preserves_evaluation_to_value case hasAttr pv₁ attr => cases hpv₁ : Partial.evaluateValue pv₁ entities <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq] @@ -673,7 +711,8 @@ end substituting it then reducing it -/ theorem reduce_commutes_subst {pv : Partial.Value} {entities : Partial.Entities} (subsmap : Subsmap) - (wf_v : pv.WellFormed) : + (wf_v : pv.WellFormed) + (wf_e : entities.WellFormed) : Partial.evaluateValue pv entities = .ok pv' → Partial.evaluateValue (pv'.subst subsmap) (entities.subst subsmap) = Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap) @@ -690,7 +729,7 @@ theorem reduce_commutes_subst {pv : Partial.Value} {entities : Partial.Entities} exact match h₁ : Partial.evaluateValue pv₁ entities with | .error _ => by simp | .ok (.value v₁) => by - simp only [Except.bind_ok, subst_preserves_evaluation_to_value subsmap wf_v.left h₁] + simp only [Except.bind_ok, subst_preserves_evaluation_to_value subsmap wf_v.left wf_e h₁] exact match hv₁ : v₁.asBool with | .error _ => by simp | .ok b₁ => by @@ -706,7 +745,7 @@ theorem reduce_commutes_subst {pv : Partial.Value} {entities : Partial.Entities} | .error _ => by simp | .ok (.value v₂) => by simp only [Except.bind_ok, Bool.true_eq_false, Bool.false_eq_true, reduceIte, - subst_preserves_evaluation_to_value subsmap wf_v.right h₂] + subst_preserves_evaluation_to_value subsmap wf_v.right wf_e h₂] simp only [do_ok] intro ⟨b₂, h₃, h₄⟩ ; subst pv' simp only [Subst.subst_concrete_value, eval_spec_value, h₃, Except.bind_ok] @@ -714,7 +753,7 @@ theorem reduce_commutes_subst {pv : Partial.Value} {entities : Partial.Entities} simp only [Except.bind_ok, Bool.true_eq_false, Bool.false_eq_true, reduceIte, Except.ok.injEq] intro _ ; subst pv' simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual, Spec.Value.asBool] - have h₃ := reduce_commutes_subst subsmap wf_v.right h₂ + have h₃ := reduce_commutes_subst subsmap wf_v.right wf_e h₂ simp only [Partial.Value.subst] at h₃ simp [h₃] } @@ -722,7 +761,7 @@ theorem reduce_commutes_subst {pv : Partial.Value} {entities : Partial.Entities} simp only [Except.bind_ok, Except.ok.injEq] intro _ ; subst pv' simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual] - have h₂ := reduce_commutes_subst subsmap wf_v.left h₁ + have h₂ := reduce_commutes_subst subsmap wf_v.left wf_e h₁ simp only [Partial.Value.subst] at h₂ simp [h₂] | .residual (.ite pv₁ pv₂ pv₃) => by diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateHasAttr.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateHasAttr.lean new file mode 100644 index 000000000..5d41d0e62 --- /dev/null +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateHasAttr.lean @@ -0,0 +1,48 @@ +/- + Copyright Cedar Contributors + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-/ + +import Cedar.Partial.Evaluator +import Cedar.Thm.Partial.Evaluation.EvaluateHasAttr +import Cedar.Thm.Partial.Subst +import Cedar.Thm.Partial.WellFormed + +namespace Cedar.Thm.Partial.Evaluation.ReevaluateHasAttr + +open Cedar.Partial (Subsmap) +open Cedar.Spec (Attr) + +/-- + If `Partial.evaluateHasAttr` returns a residual, re-evaluating that residual with a + substitution is equivalent to substituting first, evaluating the arg, and calling + `Partial.evaluateHasAttr` on the substituted/evaluated arg +-/ +theorem reeval_eqv_substituting_first (pval₁ : Partial.Value) (attr : Attr) {entities : Partial.Entities} (subsmap : Subsmap) + (wf_e : entities.WellFormed) + (wf₁ : pval₁.WellFormed) : + (Partial.evaluateHasAttr pval₁ attr entities >>= λ residual => Partial.evaluateValue (residual.subst subsmap) (entities.subst subsmap)) = + (Partial.evaluateValue (pval₁.subst subsmap) (entities.subst subsmap) >>= λ pval' => Partial.evaluateHasAttr pval' attr (entities.subst subsmap)) +:= by + unfold Partial.evaluateHasAttr + cases pval₁ <;> simp [Partial.Value.WellFormed] at wf₁ + case value v₁ => + simp [Subst.subst_concrete_value, Partial.evaluateValue] + rw [← EvaluateHasAttr.hasAttr_subst_const subsmap wf_e] + case residual r₁ => + simp [Partial.Value.subst, Partial.ResidualExpr.subst] + simp [Partial.evaluateValue, Partial.evaluateResidual] + cases Partial.evaluateValue (r₁.subst subsmap) (entities.subst subsmap) + case error e => simp only [Except.bind_err, implies_true] + case ok r₁' => simp only [Partial.evaluateHasAttr, Except.bind_ok, implies_true] diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean index ceb0932ef..9f7502505 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/ReevaluateValue.lean @@ -239,7 +239,7 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p case error e₁ => cases pv₁' <;> simp case value v₁' => - simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.left hpv₁] at hpv₁' + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.left wf_e hpv₁] at hpv₁' case residual r₁' => intro _ ; subst pv' simp [Partial.Value.subst, Partial.ResidualExpr.subst] @@ -255,7 +255,7 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p simp only [hpv₁'] at ih₁ simp only [ih₁, Except.bind_ok] case value v₁' => - simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.left hpv₁] at hpv₁' + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.left wf_e hpv₁] at hpv₁' subst pv₁'' simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] at * cases hv₁' : v₁'.asBool <;> simp @@ -277,7 +277,7 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p case error e₂ => cases pv₂' <;> simp case value v₂' => - simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.right hpv₂] at hpv₂' + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.right wf_e hpv₂] at hpv₂' case residual r₂' => intro _ ; subst pv' simp [Partial.Value.subst, Partial.ResidualExpr.subst] @@ -294,7 +294,7 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p simp only [hpv₂'] at ih₂ simp only [ih₂, Except.bind_ok] case value v₂' => - simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.right hpv₂] at hpv₂' + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.right wf_e hpv₂] at hpv₂' subst pv₂'' simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] at * cases hv₂' : v₂'.asBool <;> simp @@ -316,14 +316,14 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p case error.error e₁ _ | error.ok e₁ _ => split <;> rename_i h₁ <;> simp only [Prod.mk.injEq] at h₁ <;> replace ⟨h₁, h₁'⟩ := h₁ <;> subst h₁ h₁' - · simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.left hpv₁] at hpv₁' + · simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.left wf_e hpv₁] at hpv₁' · rename_i hv intro h ; simp at h ; subst pv' simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual, ih₁, ih₂, hpv₁', hpv₂'] case ok.error _ e₂ => split <;> rename_i h₁ <;> simp only [Prod.mk.injEq] at h₁ <;> replace ⟨h₁, h₁'⟩ := h₁ <;> subst h₁ h₁' - · simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.right hpv₂] at hpv₂' + · simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.right wf_e hpv₂] at hpv₂' · rename_i hv intro h ; simp at h ; subst pv' simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual, ih₁, ih₂, hpv₁', hpv₂'] @@ -402,7 +402,7 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p case error e₁ => cases pv₁' <;> simp case value v₁' => - simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.left hpv₁] at hpv₁' + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.left wf_e hpv₁] at hpv₁' case residual r₁' => intro _ ; subst pv' simp [Partial.Value.subst, Partial.ResidualExpr.subst] @@ -418,7 +418,7 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p simp only [hpv₁'] at ih₁ simp only [ih₁, Except.bind_ok] case value v₁' => - simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.left hpv₁] at hpv₁' + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r.left wf_e hpv₁] at hpv₁' subst pv₁'' simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] at * cases hv₁' : v₁'.asBool <;> simp @@ -443,7 +443,7 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p case error e₁ => cases pv₁' case value v₁' => - simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r hpv₁] at hpv₁' + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r wf_e hpv₁] at hpv₁' case residual r₁' => simp [Partial.evaluateUnaryApp] intro _ ; subst pv' @@ -461,7 +461,7 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p simp only [hpv₁'] at ih₁ simp only [ih₁, Except.bind_ok, Partial.evaluateUnaryApp] case value v₁' => - simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r hpv₁] at hpv₁' + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r wf_e hpv₁] at hpv₁' subst pv₁'' simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] at * intro h₁ ; simp [h₁] @@ -480,7 +480,7 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p case error e₁ => cases pv₁' case value v₁' => - simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r hpv₁] at hpv₁' + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r wf_e hpv₁] at hpv₁' case residual r₁' => simp [Partial.evaluateHasAttr] intro _ ; subst pv' @@ -498,11 +498,11 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p simp only [hpv₁'] at ih₁ simp only [ih₁, Except.bind_ok, Partial.evaluateHasAttr] case value v₁' => - simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r hpv₁] at hpv₁' + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r wf_e hpv₁] at hpv₁' subst pv₁'' simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] at * simp [Partial.evaluateHasAttr] - rw [← EvaluateHasAttr.hasAttr_subst_const wf_e] + rw [← EvaluateHasAttr.hasAttr_subst_const subsmap wf_e] intro h₁ ; simp [h₁] replace ⟨v₁, h₁, h₂⟩ := do_ok.mp h₁ subst pv' @@ -520,9 +520,9 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p cases hpv₁' : Partial.evaluateValue (pv₁.subst subsmap) (entities.subst subsmap) <;> simp only [Except.bind_ok, Except.bind_err] case error e₁ => - simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r hpv₁] at hpv₁' + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r wf_e hpv₁] at hpv₁' case ok pv₁'' => - simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r hpv₁] at hpv₁' + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_r wf_e hpv₁] at hpv₁' subst pv₁'' simp [Subst.subst_concrete_value, EvaluateValue.eval_spec_value] at ih₁ simp [Partial.evaluateGetAttr] @@ -531,7 +531,7 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p have wf₂ : pv₂.WellFormed := EvaluateGetAttr.getAttr_wf wf₁ wf_e _ h₁ simp [EvaluateGetAttr.getAttr_subst_preserves_attrs wf₁ wf_e wf_s h₁] intro h₂ - simp [EvaluateValue.reduce_commutes_subst subsmap wf₂ h₂] + simp [EvaluateValue.reduce_commutes_subst subsmap wf₂ wf_e h₂] case residual r₁ => simp only [Partial.evaluateGetAttr, Except.ok.injEq] intro _ ; subst pv' @@ -558,17 +558,17 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p and_intros <;> intro v hv · replace ⟨hv', pv₂, hpv₂, v', hv'', h₁, h₂, h₃⟩ := mapM_ok_some_from_ok_some' h₂ h₄ h₁ h₃ v hv ; clear h₄ have wf₂ : pv₂.WellFormed := wf_r pv₂ hpv₂ - simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf₂ h₂] at h₁ + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf₂ wf_e h₂] at h₁ subst v' exact h₃ · replace ⟨hv', pv, hpv, v', hv'', h₁, h₂, h₃⟩ := mapM_ok_some_from_ok_some' h₁ h₃ h₂ h₄ v hv ; clear h₄ have wf : pv.WellFormed := wf_r pv hpv - simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf h₁] at h₂ + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf wf_e h₁] at h₂ subst v' exact h₃ · replace ⟨r, hr, pv, hpv, v', hv', h₁, h₂⟩ := mapM_ok_some_from_ok_none' h₁ h₃ h₂ h₄ ; clear h₃ h₄ have wf₁ : pv.WellFormed := wf_r pv hpv - simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf₁ h₁] at h₂ + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf₁ wf_e h₁] at h₂ · intro _ ; subst pv' simp [Partial.Value.subst, Partial.ResidualExpr.subst, List.map₁_eq_map] simp [Partial.evaluateValue, Partial.evaluateResidual, List.mapM₁_eq_mapM (Partial.evaluateValue · (entities.subst subsmap)), List.mapM_map] @@ -604,7 +604,7 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p have : sizeOf pvs < sizeOf (Partial.ResidualExpr.set pvs) := EvaluateValue.sizeOf_lt_set pvs simp [reeval_eqv_substituting_first wf'' wf_e wf_s h₁] at h₉ cases pv₂' - case value v₂ => simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf'' h₁] at h₉ + case value v₂ => simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf'' wf_e h₁] at h₉ case residual r₂ => sorry case ok pvs₄ => @@ -625,7 +625,7 @@ theorem evalResidual_reeval_eqv_substituting_first {r : Partial.ResidualExpr} {p replace ⟨pv₂, hpv₂, v₂, hv₂, h₁⟩ := mapM_ok_some h₁ h₃ pv hpv split at h₁ <;> simp at h₁ replace ⟨h₁, h₁'⟩ := h₁ ; subst v₂ ; rename_i v₂ - simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_pv h₁] at h₂ + simp [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_pv wf_e h₁] at h₂ · replace ⟨pv', hpv', pv₂, hpv₂, h₁, h₃⟩ := mapM_ok_none h₁ h₃ split at h₃ <;> simp at h₃ ; rename_i r₂ simp [Partial.Value.subst, Partial.ResidualExpr.subst, Partial.evaluateValue, Partial.evaluateResidual] diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/HasAttr.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/HasAttr.lean index faf885007..5d79cf93f 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/HasAttr.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/HasAttr.lean @@ -17,6 +17,7 @@ import Cedar.Partial.Evaluator import Cedar.Thm.Partial.Evaluation.Evaluate import Cedar.Thm.Partial.Evaluation.EvaluateHasAttr +import Cedar.Thm.Partial.Evaluation.ReevaluateHasAttr import Cedar.Thm.Partial.Subst import Cedar.Thm.Partial.WellFormed @@ -26,33 +27,6 @@ open Cedar.Data open Cedar.Partial (Subsmap Unknown) open Cedar.Spec (Attr) -/-- - If `Partial.evaluateHasAttr` returns a residual, re-evaluating that residual with a - substitution is equivalent to substituting first, evaluating the arg, and calling - `Partial.evaluateHasAttr` on the substituted/evaluated arg --/ -theorem reeval_eqv_substituting_first_evaluateHasAttr (pval₁ : Partial.Value) (attr : Attr) (entities : Partial.Entities) {req req' : Partial.Request} {subsmap : Subsmap} - (wf_e : entities.WellFormed) - (wf₁ : pval₁.WellFormed) : - req.subst subsmap = some req' → - (Partial.evaluateHasAttr pval₁ attr entities >>= λ residual => Partial.evaluateValue (residual.subst subsmap) (entities.subst subsmap)) = - (Partial.evaluateValue (pval₁.subst subsmap) (entities.subst subsmap) >>= λ pval' => Partial.evaluateHasAttr pval' attr (entities.subst subsmap)) -:= by - unfold Partial.evaluateHasAttr - cases pval₁ <;> simp [Partial.Value.WellFormed] at wf₁ - case value v₁ => - simp [Subst.subst_concrete_value, Partial.evaluateValue] - rw [← EvaluateHasAttr.hasAttr_subst_const wf_e] - cases Partial.hasAttr v₁ attr entities - case error e => simp only [Except.bind_err, implies_true] - case ok v => simp only [Partial.evaluateValue, Except.bind_ok, implies_true] - case residual r₁ => - simp [Partial.Value.subst, Partial.ResidualExpr.subst] - simp [Partial.evaluateValue, Partial.evaluateResidual] - cases Partial.evaluateValue (r₁.subst subsmap) (entities.subst subsmap) - case error e => simp only [Except.bind_err, implies_true] - case ok r₁' => simp only [Partial.evaluateHasAttr, Except.bind_ok, implies_true] - /-- Inductive argument that re-evaluation of a `Spec.Expr.hasAttr` with a substitution on the residual expression, is equivalent to substituting first @@ -82,7 +56,7 @@ theorem reeval_eqv_substituting_first {x₁ : Spec.Expr} {attr : Attr} {req req' cases hx₁ : Partial.evaluate x₁ req entities <;> simp [hx₁] at hₑ ih₁' case ok pval₁ => have wf₁ : pval₁.WellFormed := Evaluate.partial_eval_wf wf_r wf_e pval₁ hx₁ - rw [reeval_eqv_substituting_first_evaluateHasAttr pval₁ attr entities wf_e wf₁ h_req] at hₑ + rw [ReevaluateHasAttr.reeval_eqv_substituting_first pval₁ attr subsmap wf_e wf₁] at hₑ simp [ih₁'] at hₑ · rename_i hₑ' -- the case where hₑ' tells us they're not both errors subst ih₁' ih₁'' @@ -92,8 +66,8 @@ theorem reeval_eqv_substituting_first {x₁ : Spec.Expr} {attr : Attr} {req req' simp [hx₁, hx₁'] at hₑ case ok pval₁ => have wf₁ : pval₁.WellFormed := Evaluate.partial_eval_wf wf_r wf_e pval₁ hx₁ - simp - rw [reeval_eqv_substituting_first_evaluateHasAttr pval₁ attr entities wf_e wf₁ h_req] - simp [← ih₁, hx₁] + simp only [Except.bind_ok] + rw [ReevaluateHasAttr.reeval_eqv_substituting_first pval₁ attr subsmap wf_e wf₁] + simp only [← ih₁, hx₁, Except.bind_ok] end Cedar.Thm.Partial.Evaluation.Reevaluation.HasAttr diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Var.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Var.lean index d092b987e..b9e8b8d95 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Var.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Var.lean @@ -172,7 +172,7 @@ theorem reeval_eqv_substituting_first_evaluateVar (var : Var) (entities : Partia simp only at * split at hapvs <;> simp only [Option.some.injEq] at hapvs ; subst v' ; rename_i v have wf_pv : pv.WellFormed := wf_r.right pv (Map.in_list_in_values hpv) - simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_pv h₂] at h₃ + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_pv wf_e h₂] at h₃ case ok apvs' => simp only [Except.bind_ok] split <;> rename_i hapvs' @@ -191,7 +191,7 @@ theorem reeval_eqv_substituting_first_evaluateVar (var : Var) (entities : Partia simp only at * subst pv' have wf_pv : pv.WellFormed := wf_r.right pv (Map.in_list_in_values hpv) - simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_pv h₂, + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_pv wf_e h₂, Except.ok.injEq, Partial.Value.value.injEq] at h₃ subst v' exact hv'' @@ -204,7 +204,7 @@ theorem reeval_eqv_substituting_first_evaluateVar (var : Var) (entities : Partia simp only at * subst pv' have wf_pv : pv.WellFormed := wf_r.right pv (Map.in_list_in_values hpv) - simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_pv h₂, + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_pv wf_e h₂, Except.ok.injEq, Partial.Value.value.injEq] at h₃ subst v' exact hv' @@ -224,7 +224,7 @@ theorem reeval_eqv_substituting_first_evaluateVar (var : Var) (entities : Partia simp only at * subst pv' have wf_pv : pv.WellFormed := wf_r.right pv (Map.in_list_in_values hpv) - simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_pv h₂, + simp only [EvaluateValue.subst_preserves_evaluation_to_value subsmap wf_pv wf_e h₂, Except.ok.injEq] at h₃ · -- in this branch, `apvs` contains at least one residual -- re-evaluated produced `pval'`; the first evaluation produced `.residual (.record apvs.kvs)`, From c3c802bcd6dfa17e811f03f9ed5786d67bccd26e Mon Sep 17 00:00:00 2001 From: Craig Disselkoen Date: Mon, 26 Aug 2024 14:45:21 +0000 Subject: [PATCH 7/8] tweak Signed-off-by: Craig Disselkoen --- .../Cedar/Thm/Partial/Evaluation/Reevaluation/Record.lean | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Record.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Record.lean index 8c4b248c0..0b47c67b3 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Record.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/Reevaluation/Record.lean @@ -388,10 +388,10 @@ theorem reeval_eqv_substituting_first {attrs : List (Attr × Spec.Expr)} {req re replace ⟨(k', v'), hv', h₃⟩ := List.mapM_some_implies_all_some h₃ (k, pval') h_pval' split at h₃ <;> simp only [Option.some.injEq, Prod.mk.injEq] at h₃ replace ⟨h₃, h₃'⟩ := h₃ ; subst k' v' ; rename_i v' hv'' - suffices v = v' by subst this ; exact Map.mem_list_mem_make hsorted_avs' hv' specialize ih (k, x) hx simp [hxs, h₂, hattrs'] at ih ; subst pval' - simpa using hv'' + simp at hv'' ; subst v' + exact Map.mem_list_mem_make hsorted_avs' hv' · replace hkv := Map.make_mem_list_mem hkv replace ⟨(k', pval'), h_pval', h₃⟩ := List.mapM_some_implies_all_from_some h₃ (k, v) hkv split at h₃ <;> simp at h₃ @@ -413,10 +413,10 @@ theorem reeval_eqv_substituting_first {attrs : List (Attr × Spec.Expr)} {req re split at h₄ <;> simp at h₄ subst h₄ ; rename_i v hv' simp only at hv' - suffices v = v' by subst this ; exact Map.mem_list_mem_make hsorted_avs hv specialize ih (k, x) hx simp [hxs, h₂, hxs'] at ih ; subst ih - simpa using hv'.symm + simp at hv' ; subst v' + exact Map.mem_list_mem_make hsorted_avs hv · -- but re-evaluating `pvals` with substitution produced `pvals_re` which is not fully concrete exfalso replace ⟨(k, pval), h_pval, h₄⟩ := List.mapM_none_iff_exists_none.mp h₄ From 5f2d8315fe8810f5e54594f806ed5cc92eda87cb Mon Sep 17 00:00:00 2001 From: Craig Disselkoen Date: Fri, 13 Sep 2024 18:01:11 +0000 Subject: [PATCH 8/8] fill in some more sorrys Signed-off-by: Craig Disselkoen --- .../Thm/Partial/Evaluation/EvaluateValue.lean | 40 +++++++++---------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateValue.lean b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateValue.lean index 00b5d8fd9..eacbcccc8 100644 --- a/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateValue.lean +++ b/cedar-lean/Cedar/Thm/Partial/Evaluation/EvaluateValue.lean @@ -50,56 +50,46 @@ theorem sizeOf_lt_ite (pv₁ pv₂ pv₃ : Partial.Value) : sizeOf pv₁ < sizeOf (Partial.ResidualExpr.ite pv₁ pv₂ pv₃) ∧ sizeOf pv₂ < sizeOf (Partial.ResidualExpr.ite pv₁ pv₂ pv₃) ∧ sizeOf pv₃ < sizeOf (Partial.ResidualExpr.ite pv₁ pv₂ pv₃) -:= by - sorry +:= by simp_wf ; omega theorem sizeOf_lt_and (pv₁ pv₂ : Partial.Value) : sizeOf pv₁ < sizeOf (Partial.ResidualExpr.and pv₁ pv₂) ∧ sizeOf pv₂ < sizeOf (Partial.ResidualExpr.and pv₁ pv₂) -:= by - sorry +:= by simp_wf ; omega theorem sizeOf_lt_or (pv₁ pv₂ : Partial.Value) : sizeOf pv₁ < sizeOf (Partial.ResidualExpr.or pv₁ pv₂) ∧ sizeOf pv₂ < sizeOf (Partial.ResidualExpr.or pv₁ pv₂) -:= by - sorry +:= by simp_wf ; omega theorem sizeOf_lt_unaryApp (op : UnaryOp) (pv₁ : Partial.Value) : sizeOf pv₁ < sizeOf (Partial.ResidualExpr.unaryApp op pv₁) -:= by - sorry +:= by simp_wf ; omega theorem sizeOf_lt_binaryApp (op : BinaryOp) (pv₁ pv₂ : Partial.Value) : sizeOf pv₁ < sizeOf (Partial.ResidualExpr.binaryApp op pv₁ pv₂) ∧ sizeOf pv₂ < sizeOf (Partial.ResidualExpr.binaryApp op pv₁ pv₂) -:= by - sorry +:= by simp_wf ; omega theorem sizeOf_lt_getAttr (pv₁ : Partial.Value) (attr : Attr) : sizeOf pv₁ < sizeOf (Partial.ResidualExpr.getAttr pv₁ attr) -:= by - sorry +:= by simp_wf ; omega theorem sizeOf_lt_hasAttr (pv₁ : Partial.Value) (attr : Attr) : sizeOf pv₁ < sizeOf (Partial.ResidualExpr.hasAttr pv₁ attr) -:= by - sorry +:= by simp_wf ; omega theorem sizeOf_lt_set (pvs : List Partial.Value) : sizeOf pvs < sizeOf (Partial.ResidualExpr.set pvs) -:= by - sorry +:= by simp_wf ; omega theorem sizeOf_lt_record (pvs : List (Attr × Partial.Value)) : sizeOf pvs < sizeOf (Partial.ResidualExpr.record pvs) -:= by - sorry +:= by simp_wf ; omega theorem sizeOf_lt_call (xfn : ExtFun) (pvs : List Partial.Value) : sizeOf pvs < sizeOf (Partial.ResidualExpr.call xfn pvs) -:= by - sorry +:= by simp_wf ; omega mutual @@ -503,6 +493,8 @@ theorem evalResidual_subst_preserves_errors {r : Partial.ResidualExpr} {entities false_implies, Bool.not_eq_true'] <;> simp only [Partial.ResidualExpr.WellFormed] at wf_r case and pv₁ pv₂ | or pv₁ pv₂ => + have := sizeOf_lt_and pv₁ pv₂ + have := sizeOf_lt_or pv₁ pv₂ cases hpv₁ : Partial.evaluateValue pv₁ entities <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq] case error e₁ => @@ -537,6 +529,7 @@ theorem evalResidual_subst_preserves_errors {r : Partial.ResidualExpr} {entities case ok b₂' => simp only [Except.bind_ok, exists_false, imp_self] } case ite pv₁ pv₂ pv₃ => + have := sizeOf_lt_ite pv₁ pv₂ pv₃ cases hpv₁ : Partial.evaluateValue pv₁ entities <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq] case error e₁ => @@ -554,6 +547,7 @@ theorem evalResidual_subst_preserves_errors {r : Partial.ResidualExpr} {entities case true => exact subst_preserves_errors wf_r.right.left wf_e wf_s case false => exact subst_preserves_errors wf_r.right.right wf_e wf_s case binaryApp op pv₁ pv₂ => + have := sizeOf_lt_binaryApp op pv₁ pv₂ cases hpv₁ : Partial.evaluateValue pv₁ entities <;> cases hpv₂ : Partial.evaluateValue pv₂ entities <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq] @@ -577,6 +571,7 @@ theorem evalResidual_subst_preserves_errors {r : Partial.ResidualExpr} {entities have ⟨e', h₂⟩ := EvaluateBinaryApp.subst_preserves_errors subsmap h₁ sorry case unaryApp op pv₁ => + have := sizeOf_lt_unaryApp op pv₁ cases hpv₁ : Partial.evaluateValue pv₁ entities <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq] case error e₁ => @@ -589,6 +584,7 @@ theorem evalResidual_subst_preserves_errors {r : Partial.ResidualExpr} {entities case ok pv₁'' => sorry case getAttr pv₁ attr => + have := sizeOf_lt_getAttr pv₁ attr cases hpv₁ : Partial.evaluateValue pv₁ entities <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq] case error e₁ => @@ -610,6 +606,7 @@ theorem evalResidual_subst_preserves_errors {r : Partial.ResidualExpr} {entities · intro _ _ _ apply evalResidual_subst_preserves_evaluation_to_value case hasAttr pv₁ attr => + have := sizeOf_lt_hasAttr pv₁ attr cases hpv₁ : Partial.evaluateValue pv₁ entities <;> simp only [Except.bind_ok, Except.bind_err, Except.error.injEq] case error e₁ => @@ -627,6 +624,7 @@ theorem evalResidual_subst_preserves_errors {r : Partial.ResidualExpr} {entities · intro _ _ _ exact evalResidual_subst_preserves_evaluation_to_value case set pvs => + have := sizeOf_lt_set pvs rw [ List.mapM₁_eq_mapM (Partial.evaluateValue · entities), List.mapM₁_eq_mapM (Partial.evaluateValue · (entities.subst subsmap)), @@ -643,6 +641,7 @@ theorem evalResidual_subst_preserves_errors {r : Partial.ResidualExpr} {entities have ⟨e'', h₂⟩ := List.element_error_implies_mapM_error (f := λ pv => Partial.evaluateValue (pv.subst subsmap) (entities.subst subsmap)) hpv h₁ simp only [h₂, Except.bind_err, Except.error.injEq, exists_eq'] case record apvs => + have := sizeOf_lt_record apvs rw [ List.map_attach₂_snd, Evaluate.Record.mapM₂_eq_mapM_partial_bindAttr (Partial.evaluateValue · entities), @@ -663,6 +662,7 @@ theorem evalResidual_subst_preserves_errors {r : Partial.ResidualExpr} {entities ) simp only [h₂, Except.bind_err, Except.error.injEq, exists_eq'] case call xfn pvs => + have := sizeOf_lt_call xfn pvs rw [ List.mapM₁_eq_mapM (Partial.evaluateValue · entities), List.mapM₁_eq_mapM (Partial.evaluateValue · (entities.subst subsmap)),