/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Lean.Meta.AppBuilder
import Lean.Meta.Instances

namespace Lean.Meta

/-- Create `SizeOf` local instances for applicable parameters, and execute `k` using them. -/
private partial def mkLocalInstances {α} (params : Array Expr) (k : Array Expr → MetaM α) : MetaM α :=
  loop 0 #[]
where
  loop (i : Nat) (insts : Array Expr) : MetaM α := do
    if i < params.size then
      let param := params[i]
      let paramType ← inferType param
      let instType? ← forallTelescopeReducing paramType fun xs _ => do
        let type ← mkAppN param xs
        try
          let sizeOf ← mkAppM `SizeOf #[type]
          let instType ← mkForallFVars xs sizeOf
          return some instType
        catch _ =>
          return none
      match instType? with
      | none => loop (i+1) insts
      | some instType =>
        let instName ← mkFreshUserName `inst
        withLocalDecl instName BinderInfo.instImplicit instType fun inst =>
          loop (i+1) (insts.push inst)
    else
      k insts

/--
  Return `some x` if `fvar` has type of the form `... -> motive ... fvar` where `motive` in `motiveFVars`.
  That is, `x` "produces" one of the recursor motives.
-/
private def isInductiveHypothesis? (motiveFVars : Array Expr) (fvar : Expr) : MetaM (Option Expr) := do
  forallTelescopeReducing (← inferType fvar) fun _ type =>
    if type.isApp && motiveFVars.contains type.getAppFn then
      return some type.appArg!
    else
      return none

private def isInductiveHypothesis (motiveFVars : Array Expr) (fvar : Expr) : MetaM Bool :=
  return (← isInductiveHypothesis? motiveFVars fvar).isSome

/--
  Let `motiveFVars` be free variables for each motive in a kernel recursor, and `minorFVars` the free variables for a minor premise.
  Then, return `some idx` if `minorFVars[idx]` has a type of the form `... -> motive ... fvar` for some `motive` in `motiveFVars`.
-/
private def isRecField? (motiveFVars : Array Expr) (minorFVars : Array Expr) (fvar : Expr) : MetaM (Option Nat) := do
  let mut idx := 0
  for minorFVar in minorFVars do
    if let some fvar' ← isInductiveHypothesis? motiveFVars minorFVar then
      if fvar == fvar' then
        return some idx
    idx := idx + 1
  return none

private partial def mkSizeOfMotives {α} (motiveFVars : Array Expr) (k : Array Expr → MetaM α) : MetaM α :=
  loop 0 #[]
where
  loop (i : Nat) (motives : Array Expr) : MetaM α := do
    if i < motiveFVars.size then
      let type ← inferType motiveFVars[i]
      let motive ← forallTelescopeReducing type fun xs _ => do
        mkLambdaFVars xs <| mkConst ``Nat
      trace[Meta.sizeOf] "motive: {motive}"
      loop (i+1) (motives.push motive)
    else
      k motives

private partial def mkSizeOfMinors {α} (motiveFVars : Array Expr) (minorFVars : Array Expr) (minorFVars' : Array Expr) (k : Array Expr → MetaM α) : MetaM α :=
  assert! minorFVars.size == minorFVars'.size
  loop 0 #[]
where
  loop (i : Nat) (minors : Array Expr) : MetaM α := do
    if i < minorFVars.size then
      forallTelescopeReducing (← inferType minorFVars[i]) fun xs _ => do
      forallBoundedTelescope (← inferType minorFVars'[i]) xs.size fun xs' _ => do
        let mut minor ← mkNumeral (mkConst ``Nat) 1
        for x in xs, x' in xs' do
          unless (← isInductiveHypothesis motiveFVars x) do
          unless (← whnf (← inferType x)).isForall do -- we suppress higher-order fields
            match (← isRecField? motiveFVars xs x) with
            | some idx => minor ← mkAdd minor xs'[idx]
            | none     => minor ← mkAdd minor (← mkAppM ``SizeOf.sizeOf #[x'])
        minor ← mkLambdaFVars xs' minor
        trace[Meta.sizeOf] "minor: {minor}"
        loop (i+1) (minors.push minor)
    else
      k minors

/--
  Create a "sizeOf" function with name `declName` using the recursor `recName`.
-/
partial def mkSizeOfFn (recName : Name) (declName : Name): MetaM Unit := do
  trace[Meta.sizeOf] "recName: {recName}"
  let recInfo : RecursorVal ← getConstInfoRec recName
  forallTelescopeReducing recInfo.type fun xs type =>
    let levelParams := recInfo.levelParams.tail! -- universe parameters for declaration being defined
    let params := xs[:recInfo.numParams]
    let motiveFVars := xs[recInfo.numParams : recInfo.numParams + recInfo.numMotives]
    let minorFVars := xs[recInfo.getFirstMinorIdx : recInfo.getFirstMinorIdx + recInfo.numMinors]
    let indices := xs[recInfo.getFirstIndexIdx : recInfo.getFirstIndexIdx + recInfo.numIndices]
    let major := xs[recInfo.getMajorIdx]
    let nat := mkConst ``Nat
    mkLocalInstances params fun localInsts =>
    mkSizeOfMotives motiveFVars fun motives => do
      let us := levelOne :: levelParams.map mkLevelParam -- universe level parameters for `rec`-application
      let recFn := mkConst recName us
      let val := mkAppN recFn (params ++ motives)
      forallBoundedTelescope (← inferType val) recInfo.numMinors fun minorFVars' _ =>
      mkSizeOfMinors motiveFVars minorFVars minorFVars' fun minors => do
        let sizeOfParams := params ++ localInsts ++ indices ++ #[major]
        let sizeOfType ← mkForallFVars sizeOfParams nat
        let val := mkAppN val (minors ++ indices ++ #[major])
        trace[Meta.sizeOf] "val: {val}"
        let sizeOfValue ← mkLambdaFVars sizeOfParams val
        addDecl <| Declaration.defnDecl {
          name        := declName
          levelParams := levelParams
          type        := sizeOfType
          value       := sizeOfValue
          safety      := DefinitionSafety.safe
          hints       := ReducibilityHints.abbrev
        }

/--
  Create `sizeOf` functions for all inductive datatypes in the mutual inductive declaration containing `typeName`
  The resulting array contains the generated functions names. The `NameMap` maps recursor names into the generated function names.
  There is a function for each element of the mutual inductive declaration, and for auxiliary recursors for nested inductive types.
-/
def mkSizeOfFns (typeName : Name) : MetaM (Array Name × NameMap Name) := do
  let indInfo ← getConstInfoInduct typeName
  let recInfo ← getConstInfoRec (mkRecName typeName)
  let numExtra := recInfo.numMotives - indInfo.all.length -- numExtra > 0 for nested inductive types
  let mut result := #[]
  let baseName := indInfo.all.head! ++ `_sizeOf -- we use the first inductive type as the base name for `sizeOf` functions
  let mut i := 1
  let mut recMap : NameMap Name := {}
  for indTypeName in indInfo.all do
    let sizeOfName := baseName.appendIndexAfter i
    let recName := mkRecName indTypeName
    mkSizeOfFn recName sizeOfName
    recMap := recMap.insert recName sizeOfName
    result := result.push sizeOfName
    i := i + 1
  for j in [:numExtra] do
    let recName := (mkRecName indInfo.all.head!).appendIndexAfter (j+1)
    let sizeOfName := baseName.appendIndexAfter i
    mkSizeOfFn recName sizeOfName
    recMap := recMap.insert recName sizeOfName
    result := result.push sizeOfName
    i := i + 1
  return (result, recMap)

def mkSizeOfSpecLemmaName (ctorName : Name) : Name :=
  ctorName ++ `sizeOf_spec

def mkSizeOfSpecLemmaInstance (ctorApp : Expr) : MetaM Expr :=
  matchConstCtor ctorApp.getAppFn (fun _ => throwError "failed to apply 'sizeOf' spec, constructor expected{indentExpr ctorApp}") fun ctorInfo ctorLevels => do
    let ctorArgs     := ctorApp.getAppArgs
    let ctorFields   := ctorArgs[ctorArgs.size - ctorInfo.numFields:]
    let lemmaName  := mkSizeOfSpecLemmaName ctorInfo.name
    let lemmaInfo  ← getConstInfo lemmaName
    let lemmaArity ← forallTelescopeReducing lemmaInfo.type fun xs _ => return xs.size
    let lemmaArgMask := mkArray (lemmaArity - ctorInfo.numFields) (none (α := Expr))
    let lemmaArgMask := lemmaArgMask ++ ctorFields.toArray.map some
    mkAppOptM lemmaName lemmaArgMask

/- SizeOf spec theorem for nested inductive types -/
namespace SizeOfSpecNested

structure Context where
  indInfo    : InductiveVal
  sizeOfFns  : Array Name
  ctorName   : Name
  params     : Array Expr
  localInsts : Array Expr
  recMap     : NameMap Name -- mapping from recursor name into `_sizeOf_<idx>` function name (see `mkSizeOfFns`)

abbrev M := ReaderT Context MetaM

def throwUnexpected {α} (msg : MessageData) : M α := do
  throwError "failed to generate sizeOf theorem for {(← read).ctorName} (use `set_option genSizeOfSpec false` to disable theorem generation), {msg}"

def throwFailed {α} : M α := do
  throwError "failed to generate sizeOf theorem for {(← read).ctorName}, (use `set_option genSizeOfSpec false` to disable theorem generation)"

/-- Convert a recursor application into a `_sizeOf_<idx>` application. -/
private def recToSizeOf (e : Expr) : M Expr := do
  matchConstRec e.getAppFn (fun _ => throwFailed) fun info us => do
    match (← read).recMap.find? info.name with
    | none => throwUnexpected m!"expected recursor application {indentExpr e}"
    | some sizeOfName =>
      let args    := e.getAppArgs
      let indices := args[info.getFirstIndexIdx : info.getFirstIndexIdx + info.numIndices]
      let major   := args[info.getMajorIdx]
      return mkAppN (mkConst sizeOfName us.tail!) ((← read).params ++ (← read).localInsts ++ indices ++ #[major])

mutual
  /-- Construct minor premise proof for `mkSizeOfAuxLemmaProof`. `ys` contains fields and inductive hypotheses for the minor premise. -/
  private partial def mkMinorProof (ys : Array Expr) (lhs rhs : Expr) : M Expr := do
    trace[Meta.sizeOf.minor] "{lhs} =?= {rhs}"
    if (← isDefEq lhs rhs) then
      mkEqRefl rhs
    else
      match (← whnfI lhs).natAdd?, (← whnfI rhs).natAdd? with
      | some (a₁, b₁), some (a₂, b₂) =>
        let p₁ ← mkMinorProof ys a₁ a₂
        let p₂ ← mkMinorProofStep ys b₁ b₂
        mkCongr (← mkCongrArg (mkConst ``Nat.add) p₁) p₂
      | _, _ =>
        throwUnexpected m!"expected 'Nat.add' application, lhs is {indentExpr lhs}\nrhs is{indentExpr rhs}"

  /--
    Helper method for `mkMinorProof`. The proof step is one of the following
    - Reflexivity
    - Assumption (i.e., using an inductive hypotheses from `ys`)
    - `mkSizeOfAuxLemma` application. This case happens when we have multiple levels of nesting
  -/
  private partial def mkMinorProofStep (ys : Array Expr) (lhs rhs : Expr) : M Expr := do
    if (← isDefEq lhs rhs) then
      mkEqRefl rhs
    else
      let lhs ← recToSizeOf lhs
      trace[Meta.sizeOf.minor.step] "{lhs} =?= {rhs}"
      let target ← mkEq lhs rhs
      for y in ys do
        if (← isDefEq (← inferType y) target) then
          return y
      mkSizeOfAuxLemma lhs rhs

  /-- Construct proof of auxiliary lemma. See `mkSizeOfAuxLemma` -/
  private partial def mkSizeOfAuxLemmaProof (info : InductiveVal) (lhs rhs : Expr) : M Expr := do
    let lhsArgs := lhs.getAppArgs
    let sizeOfBaseArgs := lhsArgs[:lhsArgs.size - info.numIndices - 1]
    let indicesMajor := lhsArgs[lhsArgs.size - info.numIndices - 1:]
    let sizeOfLevels := lhs.getAppFn.constLevels!
    /- Auxiliary function for constructing an `_sizeOf_<idx>` for `ys`,
       where `ys` are the indices + major.
       Recall that if `info.name` is part of a mutually inductive declaration, then the resulting application
       is not necessarily a `lhs.getAppFn` application.
       The result is an application of one of the `(← read),sizeOfFns` functions.
       We use this auxiliary function to builtin the motive of the recursor. -/
    let rec mkSizeOf (ys : Array Expr) : M Expr := do
      for sizeOfFn in (← read).sizeOfFns do
        let candidate := mkAppN (mkAppN (mkConst sizeOfFn sizeOfLevels) sizeOfBaseArgs) ys
        if (← isTypeCorrect candidate) then
          return candidate
      throwFailed
    let major := lhs.appArg!
    let majorType ← whnf (← inferType major)
    let majorTypeArgs := majorType.getAppArgs
    match majorType.getAppFn.const? with
    | none => throwFailed
    | some (_, us) =>
      let recName := mkRecName info.name
      let recInfo ← getConstInfoRec recName
      let r := mkConst recName (levelZero :: us)
      let r := mkAppN r majorTypeArgs[:info.numParams]
      forallBoundedTelescope (← inferType r) recInfo.numMotives fun motiveFVars _ => do
        let mut r := r
        -- Add motives
        for motiveFVar in motiveFVars do
          let motive ← forallTelescopeReducing (← inferType motiveFVar) fun ys _ => do
            let lhs ← mkSizeOf ys
            let rhs ← mkAppM ``SizeOf.sizeOf #[ys.back]
            mkLambdaFVars ys (← mkEq lhs rhs)
          r := mkApp r motive
        forallBoundedTelescope (← inferType r) recInfo.numMinors fun minorFVars _ => do
          let mut r := r
          -- Add minors
          for minorFVar in minorFVars do
            let minor ← forallTelescopeReducing (← inferType minorFVar) fun ys target => do
              let target ← whnf target
              match target.eq? with
              | none => throwFailed
              | some (_, lhs, rhs) =>
                if (← isDefEq lhs rhs) then
                  mkLambdaFVars ys (← mkEqRefl rhs)
                else
                  let lhs ← unfoldDefinition lhs -- Unfold `_sizeOf_<idx>`
                  -- rhs is of the form `sizeOf (ctor ...)`
                  let ctorApp := rhs.appArg!
                  let specLemma ← mkSizeOfSpecLemmaInstance ctorApp
                  let specEq ← whnf (← inferType specLemma)
                  match specEq.eq? with
                  | none => throwFailed
                  | some (_, rhs, rhsExpanded) =>
                    let lhs_eq_rhsExpanded ← mkMinorProof ys lhs rhsExpanded
                    let rhsExpanded_eq_rhs ← mkEqSymm specLemma
                    mkLambdaFVars ys (← mkEqTrans lhs_eq_rhsExpanded rhsExpanded_eq_rhs)
            r := mkApp r minor
          -- Add indices and major
          return mkAppN r indicesMajor

  /--
    Generate proof for `C._sizeOf_<idx> t = sizeOf t` where `C._sizeOf_<idx>` is a auxiliary function
    generated for a nested inductive type in `C`.
    For example, given
    ```lean
    inductive Expr where
      | app (f : String) (args : List Expr)
    ```
    We generate the auxiliary function `Expr._sizeOf_1 : List Expr → Nat`.
    To generate the `sizeOf` spec lemma
    ```
    sizeOf (Expr.app f args) = 1 + sizeOf f + sizeOf args
    ```
    we need an auxiliary lemma for showing `Expr._sizeOf_1 args = sizeOf args`.
    Recall that `sizeOf (Expr.app f args)` is definitionally equal to `1 + sizeOf f + Expr._sizeOf_1 args`, but
    `Expr._sizeOf_1 args` is **not** definitionally equal to `sizeOf args`. We need a proof by induction.
  -/
  private partial def mkSizeOfAuxLemma (lhs rhs : Expr) : M Expr := do
    trace[Meta.sizeOf.aux] "{lhs} =?= {rhs}"
    match lhs.getAppFn.const? with
    | none => throwFailed
    | some (fName, us) =>
      let thmLevelParams ← us.mapM fun
        | Level.param n _ => return n
        | _ => throwFailed
      let thmName  := fName.appendAfter "_eq"
      if (← getEnv).contains thmName then
        -- Auxiliary lemma has already been defined
        return mkAppN (mkConst thmName us) lhs.getAppArgs
      else
        -- Define auxiliary lemma
        -- First, generalize indices
        let x := lhs.appArg!
        let xType ← whnf (← inferType x)
        matchConstInduct xType.getAppFn (fun _ => throwFailed) fun info _ => do
          let params := xType.getAppArgs[:info.numParams]
          forallTelescopeReducing (← inferType (mkAppN xType.getAppFn params)) fun indices _ => do
            let majorType := mkAppN (mkAppN xType.getAppFn params) indices
            withLocalDeclD `x majorType fun major => do
              let lhsArgs := lhs.getAppArgs
              let lhsArgsNew := lhsArgs[:lhsArgs.size - 1 - indices.size] ++ indices ++ #[major]
              let lhsNew := mkAppN lhs.getAppFn lhsArgsNew
              let rhsNew ← mkAppM ``SizeOf.sizeOf #[major]
              let eq ← mkEq lhsNew rhsNew
              let thmParams := lhsArgsNew
              let thmType ← mkForallFVars thmParams eq
              let thmValue ← mkSizeOfAuxLemmaProof info lhsNew rhsNew
              let thmValue ← mkLambdaFVars thmParams thmValue
              trace[Meta.sizeOf] "thmValue: {thmValue}"
              addDecl <| Declaration.thmDecl {
                name        := thmName
                levelParams := thmLevelParams
                type        := thmType
                value       := thmValue
              }
              return mkAppN (mkConst thmName us) lhs.getAppArgs

end

/- Prove SizeOf spec lemma of the form `sizeOf <ctor-application> = 1 + sizeOf <field_1> + ... + sizeOf <field_n> -/
partial def main (lhs rhs : Expr) : M Expr := do
  if (← isDefEq lhs rhs) then
    mkEqRefl rhs
  else
    /- Expand lhs and rhs to obtain `Nat.add` applications -/
    let lhs ← whnfI lhs            -- Expand `sizeOf (ctor ...)` into `_sizeOf_<idx>` application
    let lhs ← unfoldDefinition lhs -- Unfold `_sizeOf_<idx>` application into `HAdd.hAdd` application
    loop lhs rhs
where
  loop (lhs rhs : Expr) : M Expr := do
    trace[Meta.sizeOf.loop] "{lhs} =?= {rhs}"
    if (← isDefEq lhs rhs) then
      mkEqRefl rhs
    else
      match (← whnfI lhs).natAdd?, (← whnfI rhs).natAdd? with
      | some (a₁, b₁), some (a₂, b₂) =>
        let p₁ ← loop a₁ a₂
        let p₂ ← step b₁ b₂
        mkCongr (← mkCongrArg (mkConst ``Nat.add) p₁) p₂
      | _, _ =>
        throwUnexpected m!"expected 'Nat.add' application, lhs is {indentExpr lhs}\nrhs is{indentExpr rhs}"

  step (lhs rhs : Expr) : M Expr := do
    if (← isDefEq lhs rhs) then
      mkEqRefl rhs
    else
      let lhs ← recToSizeOf lhs
      mkSizeOfAuxLemma lhs rhs

end SizeOfSpecNested

private def mkSizeOfSpecTheorem (indInfo : InductiveVal) (sizeOfFns : Array Name) (recMap : NameMap Name) (ctorName : Name) : MetaM Unit := do
  let ctorInfo ← getConstInfoCtor ctorName
  let us := ctorInfo.levelParams.map mkLevelParam
  forallTelescopeReducing ctorInfo.type fun xs _ => do
    let params := xs[:ctorInfo.numParams]
    let fields := xs[ctorInfo.numParams:]
    let ctorApp := mkAppN (mkConst ctorName us) xs
    mkLocalInstances params fun localInsts => do
      let lhs ← mkAppM ``SizeOf.sizeOf #[ctorApp]
      let mut rhs ← mkNumeral (mkConst ``Nat) 1
      for field in fields do
        unless (← whnf (← inferType field)).isForall do
          rhs ← mkAdd rhs (← mkAppM ``SizeOf.sizeOf #[field])
      let target ← mkEq lhs rhs
      let thmName   := mkSizeOfSpecLemmaName ctorName
      let thmParams := params ++ localInsts ++ fields
      let thmType ← mkForallFVars thmParams target
      let thmValue ←
        if indInfo.isNested then
          SizeOfSpecNested.main lhs rhs |>.run {
            indInfo := indInfo, sizeOfFns := sizeOfFns, ctorName := ctorName, params := params, localInsts := localInsts, recMap := recMap
          }
        else
          mkEqRefl rhs
      let thmValue ← mkLambdaFVars thmParams thmValue
      addDecl <| Declaration.thmDecl {
        name        := thmName
        levelParams := ctorInfo.levelParams
        type        := thmType
        value       := thmValue
      }

private def mkSizeOfSpecTheorems (indTypeNames : Array Name) (sizeOfFns : Array Name) (recMap : NameMap Name) : MetaM Unit := do
  for indTypeName in indTypeNames do
    let indInfo ← getConstInfoInduct indTypeName
    for ctorName in indInfo.ctors do
      mkSizeOfSpecTheorem indInfo sizeOfFns recMap ctorName
  return ()

register_builtin_option genSizeOf : Bool := {
  defValue := true
  descr    := "generate `SizeOf` instance for inductive types and structures"
}

register_builtin_option genSizeOfSpec : Bool := {
  defValue := true
  descr    := "generate `SizeOf` specificiation theorems for automatically generated instances"
}

def mkSizeOfInstances (typeName : Name) : MetaM Unit := do
  if (← getEnv).contains ``SizeOf && genSizeOf.get (← getOptions) && !(← isInductivePredicate typeName) then
    let indInfo ← getConstInfoInduct typeName
    unless indInfo.isUnsafe do
      let (fns, recMap) ← mkSizeOfFns typeName
      for indTypeName in indInfo.all, fn in fns do
        let indInfo ← getConstInfoInduct indTypeName
        forallTelescopeReducing indInfo.type fun xs _ =>
          let params := xs[:indInfo.numParams]
          let indices := xs[indInfo.numParams:]
          mkLocalInstances params fun localInsts => do
            let us := indInfo.levelParams.map mkLevelParam
            let indType := mkAppN (mkConst indTypeName us) xs
            let sizeOfIndType ← mkAppM ``SizeOf #[indType]
            withLocalDeclD `m indType fun m => do
              let v ← mkLambdaFVars #[m] <| mkAppN (mkConst fn us) (params ++ localInsts ++ indices ++ #[m])
              let sizeOfMk ← mkAppM ``SizeOf.mk #[v]
              let instDeclName := indTypeName ++ `_sizeOf_inst
              let instDeclType ← mkForallFVars (xs ++ localInsts) sizeOfIndType
              let instDeclValue ← mkLambdaFVars (xs ++ localInsts) sizeOfMk
              addDecl <| Declaration.defnDecl {
                name        := instDeclName
                levelParams := indInfo.levelParams
                type        := instDeclType
                value       := instDeclValue
                safety      := DefinitionSafety.safe
                hints       := ReducibilityHints.abbrev
              }
              addInstance instDeclName AttributeKind.global (eval_prio default)
      if genSizeOfSpec.get (← getOptions) then
        mkSizeOfSpecTheorems indInfo.all.toArray fns recMap

builtin_initialize
  registerTraceClass `Meta.sizeOf

end Lean.Meta


-- lemmas about validity of logical propositions

import .definitions2 .freevars .substitution .evaluation .bindings

lemma valid.not_false: ⊨ vc.not value.false :=
  begin
    have : ⊨ value.false ⋁ vc.not value.false, from valid.em,
    cases valid.or.elim this with h1 h1,
    have h2, from valid.eq.true.mp h1,
    have h3, from valid.eq.true.mp h2,
    have h4, from valid.binop.mpr h3,
    unfold binop.apply at h4,
    unfold binop.apply at h4,
    have h5: ¬ (value.true = value.false), by begin
      assume h5,
      contradiction
    end,
    simp[h5] at h4,
    have h6, from option.some.inj h4,
    contradiction,
    from h1
  end

lemma valid.false.elim {P: vc}: ⊨ vc.implies value.false P :=
  have h1: ⊨ value.true, from valid.tru,
  have unop.apply unop.not value.false = value.true, by unfold unop.apply,
  have ⊨ value.true ≡ term.unop unop.not value.false, from valid.unop.mp this,
  have ⊨ term.unop unop.not value.false, from valid.eq.true.mpr this,
  have ⊨ vc.not value.false, from valid.not_false,
  have ⊨ vc.not value.false ⋁ P, from valid.or.left this,
  show ⊨ vc.implies value.false P, from this

lemma valid.implies.mp {P Q: vc}: ((⊨ P) → (⊨ Q)) → ⊨ vc.implies P Q :=
  assume h1: (⊨ P) → (⊨ Q),
  have ⊨ P ⋁ P.not, from valid.em,
  or.elim (valid.or.elim this) (
    assume : ⊨ P,
    have ⊨ Q, from h1 this,
    show ⊨ P.not ⋁ Q, from valid.or.right this
  ) (
    assume : ⊨ P.not,
    show ⊨ P.not ⋁ Q, from valid.or.left this
  )

lemma valid.implies.mpr {P Q: vc}: (⊨ vc.implies P Q) → (⊨ P) → (⊨ Q) :=
  assume h1: (⊨ P.not ⋁ Q),
  assume h2: (⊨ P),
  or.elim (valid.or.elim h1) (
    assume : ⊨ P.not,
    have ⊨ P ⋀ P.not, from valid.and.mp ⟨h2, this⟩,
    show ⊨ Q, from false.elim (valid.contradiction this)
  ) id

lemma valid.not.mp {P: vc}: (¬ ⊨ P) → ⊨ P.not :=
  assume h1: ¬ (⊨ P),
  have ⊨ P ⋁ P.not, from valid.em,
  or.elim (valid.or.elim this) (
    assume : ⊨ P,
    show ⊨ P.not, from absurd this h1
  ) id

lemma valid.not.mpr {P: vc}: (⊨ P.not) → ¬ ⊨ P :=
  assume h2: ⊨ P.not,
  assume h3: ⊨ P,
  have ⊨ (P ⋀ P.not), from valid.and.mp ⟨h3, h2⟩,
  show «false», from valid.contradiction this

lemma valid.not_not {P: vc}: (⊨ P.not.not) ↔ ⊨ P :=
  iff.intro (
    assume h1: ⊨ P.not.not,
    have h3: ¬ ⊨ P.not, from valid.not.mpr h1,
    have h4: ¬ ¬ ⊨ P, from (
      assume : ¬ ⊨ P,
      have ⊨ P.not, from valid.not.mp this,
      show «false», from h3 this
    ),
    or.elim (valid.or.elim valid.em) id (
      assume : ⊨ P.not,
      have ¬ ⊨ P, from valid.not.mpr this,
      show ⊨ P, from absurd this h4
    )
  ) (
    assume h1: ⊨ P,
    have h2: ¬ ⊨ P.not, from (
      assume : ⊨ P.not,
      have ¬ ⊨ P, from valid.not.mpr this,
      show «false», from this h1
    ),
    show ⊨ P.not.not, from valid.not.mp h2
  )

lemma valid.mt {P Q: vc}: (⊨ vc.implies P Q) → (⊨ Q.not) → ⊨ P.not :=
  assume h1: ⊨ vc.implies P Q,
  assume : ⊨ Q.not,
  have h2: ¬ ⊨ Q, from valid.not.mpr this,
  have ¬ ⊨ P, from (
    assume : ⊨ P,
    have ⊨ Q, from valid.implies.mpr h1 this,
    show «false», from h2 this
  ),
  show ⊨ P.not, from valid.not.mp this

lemma valid.refl {v: value}: ⊨ (v ≡ v) :=
  have binop.apply binop.eq v v = value.true, from binop.eq_of_equal_values,
  have ⊨ (value.true ≡ (v ≡ v)), from valid.binop.mp this,
  show ⊨ (v ≡ v), from valid.eq.true.mpr this

lemma valid.implies.trans {P₁ P₂ P₃: vc}:
      (⊨ vc.implies P₁ P₂) → (⊨ vc.implies P₂ P₃) → ⊨ vc.implies P₁ P₃ :=
  assume h1: ⊨ vc.implies P₁ P₂,
  assume h2: ⊨ vc.implies P₂ P₃,
  show ⊨ vc.implies P₁ P₃, from valid.implies.mp (
    assume : ⊨ P₁,
    have ⊨ P₂, from valid.implies.mpr h1 this,
    show ⊨ P₃, from valid.implies.mpr h2 this
  )

lemma valid_env.true {σ: env}: σ ⊨ value.true :=
  have h1: ⊨ value.true, from valid.tru,
  have term.subst_env σ value.true = value.true, from term.subst_env.value,
  have h2: ⊨ term.subst_env σ value.true, from this.symm ▸ h1,
  have vc.subst_env σ value.true = vc.term (term.subst_env σ value.true), from vc.subst_env.term,
  show σ ⊨ value.true, from this.symm ▸ h2

lemma valid_env.mt {σ: env} {P Q: vc}: (σ ⊨ vc.implies P Q) → (σ ⊨ Q.not) → σ ⊨ P.not :=
  assume h1: σ ⊨ vc.implies P Q,
  have vc.subst_env σ (vc.implies P Q) = vc.implies (vc.subst_env σ P) (vc.subst_env σ Q),
  from vc.subst_env.implies,
  have h2: ⊨ vc.implies (vc.subst_env σ P) (vc.subst_env σ Q), from this ▸ h1,
  assume h3: σ ⊨ Q.not,
  have vc.subst_env σ Q.not = (vc.subst_env σ Q).not, from vc.subst_env.not,
  have h4: ⊨ (vc.subst_env σ Q).not, from this ▸ h3,
  have h5: ⊨ (vc.subst_env σ P).not, from valid.mt h2 h4,
  have vc.subst_env σ P.not = (vc.subst_env σ P).not, from vc.subst_env.not,
  show σ ⊨ P.not, from this.symm ▸ h5

lemma valid_env.eq.true {σ: env} {t: term}: σ ⊨ t ↔ σ ⊨ (value.true ≡ t) :=
  iff.intro (
    assume t_valid: ⊨ vc.subst_env σ t,
    have vc.subst_env σ t = vc.term (term.subst_env σ t), from vc.subst_env.term,
    have ⊨ vc.term (term.subst_env σ t), from this ▸ t_valid,
    have h: ⊨ vc.term (value.true ≡ (term.subst_env σ t)), from valid.eq.true.mp this,
    have term.subst_env σ value.true = value.true, from term.subst_env.value,
    have h2: ⊨ vc.term ((term.subst_env σ value.true) ≡ (term.subst_env σ t)),
    from this.symm ▸ h,
    have (term.subst_env σ (value.true ≡ t)) = ((term.subst_env σ value.true) ≡ (term.subst_env σ t)),
    from term.subst_env.binop,
    have h3: ⊨ term.subst_env σ (value.true ≡ t), from this.symm ▸ h2,
    have vc.subst_env σ (value.true ≡ t) = vc.term (term.subst_env σ (value.true ≡ t)), from vc.subst_env.term,
    show σ ⊨ (value.true ≡ t), from this.symm ▸ h3
  ) (
    assume t_valid: ⊨ vc.subst_env σ (value.true ≡ t),
    have vc.subst_env σ (value.true ≡ t) = vc.term (term.subst_env σ (value.true ≡ t)), from vc.subst_env.term,
    have h: ⊨ vc.term (term.subst_env σ (value.true ≡ t)),
    from this ▸ t_valid,
    have (term.subst_env σ (value.true ≡ t)) = ((term.subst_env σ value.true) ≡ (term.subst_env σ t)),
    from term.subst_env.binop,
    have h2: ⊨ vc.term ((term.subst_env σ value.true) ≡ (term.subst_env σ t)),
    from this ▸ h,
    have term.subst_env σ value.true = value.true, from term.subst_env.value,
    have ⊨ vc.term (value.true ≡ (term.subst_env σ t)), from this ▸ h2,
    have h3: ⊨ vc.term (term.subst_env σ t), from valid.eq.true.mpr this,
    have vc.subst_env σ t = vc.term (term.subst_env σ t), from vc.subst_env.term,
    show ⊨ vc.subst_env σ t, from this.symm ▸ h3
  )

lemma valid.eq.terms {v₁ v₂: value}: (⊨ v₁ ≡ v₂) → (v₁ = v₂) :=
  begin
    assume h1,
    have h2, from valid.eq.true.mp h1,
    have h3, from valid.binop.mpr h2,
    from binop.eq.inv h3
  end

lemma valid_env.not_not {σ: env} {P: vc}: (σ ⊨ P.not.not) ↔ σ ⊨ P :=
  iff.intro (
    assume h1: σ ⊨ P.not.not,
    have vc.subst_env σ P.not.not = (vc.subst_env σ P.not).not, from vc.subst_env.not,
    have h2: ⊨ (vc.subst_env σ P.not).not, from this ▸ h1,
    have vc.subst_env σ P.not = (vc.subst_env σ P).not, from vc.subst_env.not,
    have  ⊨ (vc.subst_env σ P).not.not, from this ▸ h2,
    show σ ⊨ P, from valid.not_not.mp this
  ) (
    assume : σ ⊨ P,
    have h1: ⊨ (vc.subst_env σ P).not.not, from valid.not_not.mpr this,
    have vc.subst_env σ P.not = (vc.subst_env σ P).not, from vc.subst_env.not,
    have h2: ⊨ (vc.subst_env σ P.not).not, from this.symm ▸ h1,
    have vc.subst_env σ P.not.not = (vc.subst_env σ P.not).not, from vc.subst_env.not,
    show σ ⊨ P.not.not, from this.symm ▸ h2
  )

lemma valid_env.and {σ: env} {P Q: vc}: (σ ⊨ P) → (σ ⊨ Q) → σ ⊨ (P ⋀ Q) :=
  assume p_valid: ⊨ vc.subst_env σ P,
  assume q_valid: ⊨ vc.subst_env σ Q,
  have vc.subst_env σ (P ⋀ Q) = (vc.subst_env σ P ⋀ vc.subst_env σ Q), from vc.subst_env.and,
  show σ ⊨ (P ⋀ Q), from this.symm ▸ valid.and.mp ⟨p_valid, q_valid⟩

lemma valid_env.and.elim {σ: env} {P Q: vc}: (σ ⊨ P ⋀ Q) → (σ ⊨ P) ∧ σ ⊨ Q :=
  assume p_and_q_valid: ⊨ vc.subst_env σ (P ⋀ Q),
  have vc.subst_env σ (P ⋀ Q) = (vc.subst_env σ P ⋀ vc.subst_env σ Q), from vc.subst_env.and,
  have ⊨ (vc.subst_env σ P ⋀ vc.subst_env σ Q), from this ▸ p_and_q_valid,
  show (σ ⊨ P) ∧ (σ ⊨ Q), from valid.and.mpr this

lemma valid_env.or₁ {σ: env} {P Q: vc}: (σ ⊨ P) → σ ⊨ (P ⋁ Q) :=
  assume h1: ⊨ vc.subst_env σ P,
  have h: ⊨ vc.subst_env σ P ⋁ vc.subst_env σ Q, from valid.or.left h1,
  have vc.subst_env σ (P ⋁ Q) = (vc.subst_env σ P ⋁ vc.subst_env σ Q), from vc.subst_env.or,
  show σ ⊨ (P ⋁ Q), from this.symm ▸ h

lemma valid_env.or₂ {σ: env} {P Q: vc}: (σ ⊨ Q) → σ ⊨ (P ⋁ Q) :=
  assume h1: ⊨ vc.subst_env σ Q,
  have h: ⊨ vc.subst_env σ P ⋁ vc.subst_env σ Q, from valid.or.right h1,
  have vc.subst_env σ (P ⋁ Q) = (vc.subst_env σ P ⋁ vc.subst_env σ Q), from vc.subst_env.or,
  show σ ⊨ (P ⋁ Q), from this.symm ▸ h

lemma valid_env.or.elim {σ: env} {P Q: vc}: (σ ⊨ P ⋁ Q) → (σ ⊨ P) ∨ σ ⊨ Q :=
  assume p_or_q_valid: ⊨ vc.subst_env σ (P ⋁ Q),
  have vc.subst_env σ (P ⋁ Q) = (vc.subst_env σ P ⋁ vc.subst_env σ Q), from vc.subst_env.or,
  have ⊨ (vc.subst_env σ P ⋁ vc.subst_env σ Q), from this ▸ p_or_q_valid,
  show (σ ⊨ P) ∨ (σ ⊨ Q), from valid.or.elim this

lemma valid_env.not.mp {σ: env} {P: vc}: ¬ (σ ⊨ P) → (σ ⊨ P.not) :=
  assume h1: ¬ (σ ⊨ P),
  have h2: vc.subst_env σ P.not = (vc.subst_env σ P).not, from vc.subst_env.not,
  have ¬ ⊨ (vc.subst_env σ P), from h2 ▸ h1,
  have ⊨ (vc.subst_env σ P).not, from valid.not.mp this,
  show σ ⊨ P.not, from h2.symm ▸ this

lemma valid_env.not.mpr {σ: env} {P: vc}: (σ ⊨ P.not) → ¬ (σ ⊨ P) :=
  assume h1: σ ⊨ P.not,
  have h2: vc.subst_env σ P.not = (vc.subst_env σ P).not, from vc.subst_env.not,
  have ⊨ (vc.subst_env σ P).not, from h2 ▸ h1,
  have ¬ ⊨ (vc.subst_env σ P), from valid.not.mpr this,
  show ¬ (σ ⊨ P), from h2.symm ▸ this

lemma valid_env.mp {σ: env} {P Q: vc}: (σ ⊨ vc.implies P Q) → (σ ⊨ P) → σ ⊨ Q :=
  assume impl: σ ⊨ (vc.implies P Q),
  assume p: σ ⊨ P,
  have vc.subst_env σ (vc.implies P Q) = (vc.subst_env σ P.not ⋁ vc.subst_env σ Q), from vc.subst_env.or,
  have h: ⊨ (vc.subst_env σ P.not ⋁ vc.subst_env σ Q), from this ▸ impl,
  have vc.subst_env σ P.not = (vc.subst_env σ P).not, from vc.subst_env.not,
  have ⊨ ((vc.subst_env σ P).not ⋁ vc.subst_env σ Q), from this ▸ h,
  have ⊨ vc.implies (vc.subst_env σ P) (vc.subst_env σ Q), from this,
  show σ ⊨ Q, from valid.implies.mpr this p

lemma valid_env.mpr {σ: env} {P Q: vc}: ((σ ⊨ P) → (σ ⊨ Q)) → σ ⊨ vc.implies P Q :=
  assume : ((σ ⊨ P) → σ ⊨ Q),
  have ⊨ vc.implies (vc.subst_env σ P) (vc.subst_env σ Q), from valid.implies.mp this,
  have h1: ⊨ vc.or (vc.subst_env σ P).not (vc.subst_env σ Q), from this,
  have vc.subst_env σ P.not = (vc.subst_env σ P).not, from vc.subst_env.not,
  have h2: ⊨ vc.or (vc.subst_env σ P.not) (vc.subst_env σ Q), from this.symm ▸ h1,
  have vc.subst_env σ (P.not ⋁ Q) = (vc.subst_env σ P.not ⋁ vc.subst_env σ Q),
  from vc.subst_env.or,
  have ⊨ vc.subst_env σ (P.not ⋁ Q), from this.symm ▸ h2,
  show σ ⊨ vc.implies P Q, from this

lemma valid_env.nmt {σ: env} {P Q: vc}: (σ ⊨ vc.implies P.not Q.not) → (σ ⊨ vc.implies Q P) :=
  begin
    assume h1,
    apply valid_env.mpr,
    assume h2,
    unfold vc.implies at h1,
    cases valid_env.or.elim h1 with h3 h4,
    from valid_env.not_not.mp h3,
    have h5, from valid_env.not.mpr h4,
    contradiction
  end

lemma valid_env.implies.trans {σ: env} {P₁ P₂ P₃: vc}:
      (σ ⊨ vc.implies P₁ P₂) → (σ ⊨ vc.implies P₂ P₃) → σ ⊨ vc.implies P₁ P₃ :=
  assume h1: σ ⊨ vc.implies P₁ P₂,
  assume h2: σ ⊨ vc.implies P₂ P₃,
  show σ ⊨ vc.implies P₁ P₃, from valid_env.mpr (
    assume : σ ⊨ P₁,
    have σ ⊨ P₂, from valid_env.mp h1 this,
    show σ ⊨ P₃, from valid_env.mp h2 this
  )

lemma vc.implies.trans {σ: env} {P₁ P₂ P₃: vc}:
      (σ ⊨ vc.implies P₁ P₂) → (σ ⊨ vc.implies P₂ P₃) → σ ⊨ vc.implies P₁ P₃ := valid_env.implies.trans

lemma valid_env.univ.mp {σ: env} {x: var} {P: vc}: (∀v, σ ⊨ vc.subst x v P) → σ ⊨ vc.univ x P :=
  assume h1: ∀v, σ ⊨ vc.subst x v P,
  have h2: ⊨ vc.univ x (vc.subst_env (σ.without x) P), from valid.univ.mp (
    assume v: value,
    have h3: ⊨ vc.subst_env σ (vc.subst x v P), from h1 v,
    have vc.subst_env σ (vc.subst x v P) = vc.subst x v (vc.subst_env (σ.without x) P),
    from vc.subst_env.reorder,
    show ⊨ vc.subst x v (vc.subst_env (σ.without x) P), from this ▸ h3
  ),
  have vc.subst_env σ (vc.univ x P) = vc.univ x (vc.subst_env (σ.without x) P),
  from vc.subst_env.univ,
  have ⊨ vc.subst_env σ (vc.univ x P), from this.symm ▸ h2,
  show σ ⊨ vc.univ x P, from this

lemma env.contains_of_valid_env_term {σ: env} {x: var} {t: term}:
      x ∈ FV t → closed_subst σ t → (x ∈ σ) :=
  assume x_free_in_t: x ∈ FV t,
  assume t_closed: closed_subst σ t,
  show x ∈ σ, from t_closed x_free_in_t

lemma valid_env.subst_of_eq {σ: env} {x: var} {v: value}:
      (σ ⊨ x ≡ v) → (σ x = v) :=
  assume h1: σ ⊨ vc.term (x ≡ v),
  have h2: ⊨ vc.subst_env σ (vc.term (x ≡ v)), from h1,
  have vc.subst_env σ (vc.term (x ≡ v)) = vc.term (term.subst_env σ (x ≡ v)),
  from vc.subst_env.term,
  have h3: ⊨ vc.term (term.subst_env σ (x ≡ v)), from this ▸ h2,
  have term.subst_env σ (x ≡ v) = (term.subst_env σ x ≡ term.subst_env σ v),
  from term.subst_env.binop,
  have h4: ⊨ (term.subst_env σ x ≡ term.subst_env σ v), from this ▸ h3,
  have term.subst_env σ v = v, from term.subst_env.value,
  have h5: ⊨ (term.subst_env σ x ≡ v), from this ▸ h4,
  have x ∈ σ, by begin
    by_contradiction h6,
    have h7: x ∈ FV (x ≡ v), from free_in_term.binop₁ (free_in_term.var x),
    have h8, from free_in_vc.term h7,
    have h9, from vc.free_of_subst_env h8 h6,
    have h10, from valid.univ.free ⟨h9, h2⟩,
    have h11: (∀v': value, v ≠ v' → «false»), by begin
      assume v',
      assume h11,

      have h12, from valid.univ.mpr h10 v',
      have h13: (vc.substt x v' (vc.subst_env σ ↑(↑x ≡ ↑v))
              = vc.subst x v' (vc.subst_env σ ↑(↑x ≡ ↑v))),
      from vc.substt_value_eq_subst,
      rw[h13] at h12,
      have h14: (vc.subst_env σ (vc.subst x v' ↑(↑x ≡ ↑v))
              = vc.subst x v' (vc.subst_env σ ↑(↑x ≡ ↑v))),
      from vc.subst_env.order (or.inl h6),
      rw[h14.symm] at h12,
      have h15: σ ⊨ vc.subst x v' (vc.term (↑x ≡ ↑v)), from h12,
      unfold vc.subst at h15,
      unfold term.subst at h15,
      have h16: σ ⊨ ↑(term.subst x v' (term.var x) ≡ term.subst x v' (term.value v)),
      from h15,
      unfold term.subst at h16,
      simp at h16,
      have h17: closed (vc.term (↑v' ≡ ↑v)), by begin
        assume z,
        assume h18,
        have h19, from free_in_vc.term.inv h18,
        cases (free_in_term.binop.inv h19) with h20 h21,
        have h22: ¬ free_in_term z ↑v', from free_in_term.value.inv,
        contradiction,
        have h22: ¬ free_in_term z ↑v, from free_in_term.value.inv,
        contradiction
      end,
      have h18: (vc.subst_env σ (vc.term (↑v' ≡ ↑v)) = vc.term (↑v' ≡ ↑v)),
      from unchanged_of_subst_env_nonfree_vc h17 σ,
      have h19: ⊨ vc.subst_env σ (vc.term (↑v' ≡ ↑v)), from h16,
      rw[h18] at h19,
      have h20, from (valid.eq.terms h19).symm,
      contradiction
    end,

    by_cases (v = value.true) with h12,

    have h13: value.true ≠ value.false, by { assume h14, contradiction },
    from h11 value.false (h12.symm ▸ h13),

    have h13: value.true ≠ v, by { assume h14, have h15, from h14.symm, contradiction },
    from h11 value.true h13.symm,
  end,
  have ∃v', σ x = some v', from env.contains_apply_equiv.right.mpr this,
  let ⟨v', h6⟩ := this in
  have term.subst_env σ x = v', from (term.subst_env.var.right v').mp h6,
  have ⊨ (v' ≡ v), from this ▸ h5,
  have ⊨ value.true ≡ (v' ≡ v), from valid.eq.true.mp this,
  have binop.apply binop.eq v' v = some value.true, from valid.binop.mpr this,
  have v' = v, from binop.eq.inv this,
  show σ x = some v, from h6.symm ▸ (some.inj.inv this)

lemma valid.alpha_equiv {x y: var} {P: vc}: (⊨ P) → ⊨ vc.substt x y P :=
  begin
    assume h1,
    by_cases (free_in_vc x P) with h2,

    have h3, from valid.univ.free ⟨h2, h1⟩,
    from valid.univ.mpr h3 y,

    have h4: (vc.substt x y P = P),
    from unchanged_of_substt_nonfree_vc h2,
    rw[h4],
    from h1
  end

lemma valid.to_vc_and {P Q: prop}: (⊨ P.to_vc) → (⊨ Q.to_vc) → ⊨ (P ⋀ Q).to_vc :=
  begin
    assume h1: ⊨ P.to_vc,
    assume h2: ⊨ Q.to_vc,
    change ⊨ prop.to_vc (prop.and P Q),
    unfold prop.to_vc,
    from valid.and.mp ⟨h1, h2⟩
  end

lemma valid_env.to_vc_and {P Q: prop} {σ: env}: (σ ⊨ P.to_vc) → (σ ⊨ Q.to_vc) → σ ⊨ (P ⋀ Q).to_vc :=
  begin
    assume h1: σ ⊨ P.to_vc,
    assume h2: σ ⊨ Q.to_vc,
    change σ ⊨ prop.to_vc (prop.and P Q),
    unfold prop.to_vc,
    from valid_env.and h1 h2
  end

lemma valid_env.to_vc_and.elim {P Q: prop} {σ: env}: (σ ⊨ (P ⋀ Q).to_vc) → ((σ ⊨ P.to_vc) ∧ (σ ⊨ Q.to_vc)) :=
  begin
    assume h1: σ ⊨ (P ⋀ Q).to_vc,
    have h2: σ ⊨ (prop.and P Q).to_vc, from h1,
    unfold prop.to_vc at h2,
    from valid_env.and.elim h2
  end

lemma valid_env.to_vc_or_elim {P Q: prop} {σ: env}: (σ ⊨ (P ⋁ Q).to_vc) → (σ ⊨ P.to_vc ⋁ Q.to_vc) :=
  begin
    assume h1: σ ⊨ (P ⋁ Q).to_vc,
    have h2: σ ⊨ (prop.or P Q).to_vc, from h1,
    unfold prop.to_vc at h2,
    cases valid_env.or.elim h2 with h3 h4,
    apply valid_env.or₁,
    from h3,
    apply valid_env.or₂,
    from h4
  end

lemma val_of_free_in_env {P: prop} {σ: env} {x: var}: (⊩ σ : P) → x ∈ FV P → ∃v, σ x = some v :=
  assume env_verified: ⊩ σ: P,
  assume x_free_in_P: x ∈ FV P,
  have x ∈ σ, from contains_of_free env_verified x_free_in_P,
  show ∃v, σ x = some v, from env.contains_apply_equiv.right.mpr this

lemma val_of_free_in_pre_env {R: spec} {σ: env} {P: prop} {x: var}:
                              (⊩ σ : P) → FV R.to_prop ⊆ FV P → x ∈ FV (R.to_prop ⋀ P) → ∃v, σ x = some v :=
  assume σ_verified: ⊩ σ : P,
  assume fv_R: FV R.to_prop ⊆ FV P,
  assume x_free_in_R_P: x ∈ FV (R.to_prop ⋀ P),
  have free_in_prop x R.to_prop ∨ free_in_prop x P, from free_in_prop.and.inv x_free_in_R_P,
  have x ∈ FV P, from or.elim this.symm id (
    assume : free_in_prop x R.to_prop,
    show x ∈ FV P, from set.mem_of_mem_of_subset this fv_R
  ),
  show ∃v, σ x = some v, from val_of_free_in_env σ_verified this

lemma to_vc_implies {P Q: prop}: (prop.implies P Q).to_vc = vc.implies P.to_vc Q.to_vc :=
  begin
    unfold prop.implies,
    unfold vc.implies,
    unfold prop.to_vc,
    congr
  end

lemma valid.to_vc_implies {P Q: prop}: (⊨ (prop.implies P Q).to_vc) ↔ ⊨ vc.implies P.to_vc Q.to_vc :=
  begin
    have h1: ((prop.implies P Q).to_vc = vc.implies P.to_vc Q.to_vc), from to_vc_implies,
    rw[h1]
  end

lemma valid_env.to_vc_implies {P Q: prop} {σ: env}: (σ ⊨ (prop.implies P Q).to_vc) ↔ σ ⊨ vc.implies P.to_vc Q.to_vc :=
  begin
    have h1: ((prop.implies P Q).to_vc = vc.implies P.to_vc Q.to_vc), from to_vc_implies,
    rw[h1]
  end

lemma simple_equality_valid {σ: env} {x: var} {v: value}:
  x ∉ σ → (σ[x↦v]) ⊨ (prop.term (x ≡ v)).to_vc :=
  assume x_not_free_in_σ: x ∉ σ,
  have σ.apply x = none, from env.contains_apply_equiv.left.mpr x_not_free_in_σ,
  have h1: term.subst_env σ x = x, from term.subst_env.var.left.mp this,
  have (term.subst_env (σ[x↦v]) x = term.subst x v (term.subst_env σ x)),
  by unfold term.subst_env,
  have h2: term.subst_env (σ[x↦v]) x = term.subst x v x,
  from @eq.subst term (λa, term.subst_env (σ[x↦v]) x = term.subst x v a) (term.subst_env σ x) x h1 this,
  have term.subst x v (term.var x) = (if x = x then v else x), by unfold term.subst,
  have term.subst x v (term.var x) = v, by simp[this],
  have h3: term.subst_env (σ[x↦v]) x = v, from eq.trans h2 this,
  have h4: term.subst_env (σ[x↦v]) v = v, from term.subst_env.value,
  have term.subst_env (σ[x↦v]) (x ≡ v) = (term.subst_env (σ[x↦v]) x ≡ term.subst_env (σ[x↦v]) v),
  from term.subst_env.binop,
  have term.subst_env (σ[x↦v]) (x ≡ v) = (v ≡ term.subst_env (σ[x↦v]) v),
  from @eq.subst term (λa, term.subst_env (σ[x↦v]) (x ≡ v) = (a ≡ term.subst_env (σ[x↦v]) v))
                      (term.subst_env (σ[x↦v]) x) v h3 this,
  have h5: term.subst_env (σ[x↦v]) (x ≡ v) = (v ≡ v),
  from @eq.subst term (λa, term.subst_env (σ[x↦v]) (x ≡ v) = (v ≡ a))
                      (term.subst_env (σ[x↦v]) v) v h4 this,
  have h6: vc.term (term.subst_env (σ[x↦v]) (x ≡ v)) = vc.term (v ≡ v), by simp[h5],
  have vc.subst_env (σ[x↦v]) (x ≡ v) = vc.term (term.subst_env (σ[x↦v]) (x ≡ v)), from vc.subst_env.term,
  have h7: vc.subst_env (σ[x↦v]) (vc.term (x ≡ v)) = vc.term (v ≡ v), from eq.trans this h6,
  have prop.to_vc (prop.term (x ≡ v)) = vc.term (x ≡ v), by unfold prop.to_vc,
  have h8: vc.subst_env (σ[x↦v]) (prop.term (x ≡ v)).to_vc = vc.term (v ≡ v), from this.symm ▸ h7,
  have ⊨ vc.term (v ≡ v), from valid.refl,
  show (σ[x↦v]) ⊨ prop.to_vc (x ≡ v), from h8.symm ▸ this

lemma simple_equality_env_valid {P: prop} {σ: env} {x: var} {v: value}:
                                     (⊩ σ: P) → x ∉ σ → (σ ⊨ P.to_vc) → (σ[x↦v]) ⊨ (P ⋀ x ≡ v).to_vc :=
  assume σ_verified: ⊩ σ: P,
  assume x_not_free_in_σ: x ∉ σ,
  assume ih: σ ⊨ P.to_vc,
  have σ.apply x = none, from env.contains_apply_equiv.left.mpr x_not_free_in_σ,
  have h1: ⊨ vc.subst_env σ P.to_vc, from ih,
  have x_not_in_P: x ∉ FV (vc.subst_env σ P.to_vc), from (
    assume : x ∈ FV (vc.subst_env σ P.to_vc),
    have x ∈ FV P.to_vc, from free_in_vc.subst_env this,
    have x ∈ FV P, from set.mem_of_mem_of_subset this free_in_prop_of_free_in_to_vc,
    have ∃v, σ x = some v, from val_of_free_in_env σ_verified this,
    have x ∈ σ, from env.contains_apply_equiv.right.mp this,
    show «false», from x_not_free_in_σ this
  ),
  have vc.subst x v (vc.subst_env σ P.to_vc) = vc.subst_env σ P.to_vc,
  from unchanged_of_subst_nonfree_vc x_not_in_P,
  have h2: ⊨ vc.subst x v (vc.subst_env σ P.to_vc),
  from @eq.subst vc (λa, ⊨ a) (vc.subst_env σ P.to_vc)
          (vc.subst x v (vc.subst_env σ P.to_vc)) this.symm h1,
  have vc.subst x v (vc.subst_env σ P.to_vc)
      = vc.subst_env (σ[x↦v]) P.to_vc, by unfold vc.subst_env,
  have h3: ⊨ vc.subst_env (σ[x↦v]) P.to_vc, from this ▸ h2,
  have h4: (σ[x↦v]) ⊨ (prop.term (x ≡ v)).to_vc,
  from simple_equality_valid x_not_free_in_σ,
  have h5: (σ[x↦v]) ⊨ (P.to_vc ⋀ (prop.term (x ≡ v)).to_vc),
  from valid_env.and h3 h4,
  have (P.to_vc ⋀ (prop.term (x ≡ v)).to_vc) = prop.to_vc (prop.and P (prop.term (x ≡ v))),
  by unfold prop.to_vc,
  have (σ[x↦v]) ⊨ prop.to_vc (prop.and P (prop.term (x ≡ v))), from this ▸ h5,
  show (σ[x↦v]) ⊨ (P ⋀ x ≡ v).to_vc, from this

lemma env_translation_valid {P: prop} {σ: env}: (⊩ σ: P) → σ ⊨ P.to_vc :=
  assume env_verified: (⊩ σ : P),
  begin
    induction env_verified,
    case env.dvcgen.empty {
      unfold vc.subst_env,
      change ⊨ prop.to_vc (prop.term value.true),
      unfold prop.to_vc,
      from valid.tru
    },
    case env.dvcgen.tru σ' x' Q x_not_free_in_σ' σ'_verified ih {
      from simple_equality_env_valid σ'_verified x_not_free_in_σ' ih
    },
    case env.dvcgen.fls σ' x' Q x_not_free_in_σ' σ'_verified ih {
      from simple_equality_env_valid σ'_verified x_not_free_in_σ' ih
    },
    case env.dvcgen.num n σ' x' Q x_not_free_in_σ' σ'_verified ih {
      from simple_equality_env_valid σ'_verified x_not_free_in_σ' ih
    },
    case env.dvcgen.func σ₁ σ₂ f g gx R S e Q₁ Q₂ Q₃
      f_not_free_in_σ₁ g_not_free_in_σ₂ gx_not_free_in_σ₂ g_neq_gx σ₁_verified σ₂_verified gx_free_in_R R_fv S_fv func_verified
      S_valid ih₁ ih₂ { from (
      let vf := value.func g gx R S e σ₂ in
      have h1: ((σ₁[f↦vf]) ⊨ (Q₁ ⋀ f ≡ vf).to_vc),
      from simple_equality_env_valid σ₁_verified f_not_free_in_σ₁ ih₁,
      have h1a: (σ₁[f↦vf]) ⊨ Q₁.to_vc,
      from (valid_env.to_vc_and.elim h1).left,
      have h1b: (σ₁[f↦vf]) ⊨ (prop.term (f ≡ vf)).to_vc,
      from (valid_env.to_vc_and.elim h1).right,

      have g_subst: term.subst_env (σ₂[g↦vf]) g = vf, from (
        have h1: term.subst g vf g = vf, from term.subst.var.same,
        have σ₂ g = none, from env.contains_apply_equiv.left.mpr g_not_free_in_σ₂,
        have term.subst_env σ₂ g = g, from term.subst_env.var.left.mp this,
        have h2: term.subst g vf (term.subst_env σ₂ g) = vf, from this.symm ▸ h1,
        have term.subst_env (σ₂[g↦vf]) g = term.subst g vf (term.subst_env σ₂ g), by unfold term.subst_env,
        show term.subst_env (σ₂[g↦vf]) g = vf, from eq.trans this h2
      ),

      have h2: ⊨ prop.to_vc (prop.subst_env (σ₂[g↦vf]) (term.unop unop.isFunc g)), from (
        have unop.apply unop.isFunc vf = value.true, by unfold unop.apply,
        have ⊨ (value.true ≡ term.unop unop.isFunc vf), from valid.unop.mp this,
        have ⊨ term.unop unop.isFunc vf, from valid.eq.true.mpr this,
        have h3: ⊨ term.unop unop.isFunc (term.subst_env (σ₂[g↦vf]) g), from g_subst.symm ▸ this,
        have term.subst_env (σ₂[g↦vf]) (term.unop unop.isFunc g) = term.unop unop.isFunc (term.subst_env (σ₂[g↦vf]) g),
        from term.subst_env.unop,
        have h4: ⊨ vc.term (term.subst_env (σ₂[g↦vf]) (term.unop unop.isFunc g)), from this.symm ▸ h3,
        have prop.to_vc (prop.term (term.subst_env (σ₂[g↦vf]) (term.unop unop.isFunc g)))
           = vc.term (term.subst_env (σ₂[g↦vf]) (term.unop unop.isFunc g)),
        by unfold prop.to_vc,
        have h5: ⊨ prop.to_vc (prop.term (term.subst_env (σ₂[g↦vf]) (term.unop unop.isFunc g))), from this.symm ▸ h4,
        have prop.subst_env (σ₂[g↦vf]) (prop.term (term.unop unop.isFunc g))
           = prop.term (term.subst_env (σ₂[g↦vf]) (term.unop unop.isFunc g)), from prop.subst_env.term,
        show ⊨ prop.to_vc (prop.subst_env (σ₂[g↦vf]) (term.unop unop.isFunc g)), from this.symm ▸ h5
      ),

      let forallp := prop.implies R.to_prop (prop.pre g gx)
                  ⋀ prop.implies (prop.post g gx) (Q₃ (term.app g gx) ⋀ S.to_prop) in
      let pfunc: prop := prop.subst_env (σ₂[g↦vf]) (prop.func g gx R (Q₃ (term.app g gx) ⋀ S)) in

      have h4: ∀v, ⊨ vc.subst gx v (prop.subst_env (σ₂[g↦vf]) forallp).to_vc, from (
        assume v: value,

        have h5: ⊨ (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.implies R.to_prop (prop.pre g gx))).to_vc, from (

          have h51: (σ₂[g↦vf][gx↦v]).dom = σ₂.dom ∪ {g, gx}, from env.dom.two_elems,
          have σ₂.dom = FV Q₂, from free_iff_contains σ₂_verified,
          have h52: (σ₂[g↦vf][gx↦v]).dom = FV Q₂ ∪ {g, gx}, from this ▸ h51,
          have FV R.to_prop ⊆ (σ₂[g↦vf][gx↦v]).dom, from h52.symm ▸ R_fv,
          have closed (prop.subst_env (σ₂[g↦vf][gx↦v]) R.to_prop), from prop.closed_of_closed_subst this,
          have h53: closed (prop.subst_env (σ₂[g↦vf][gx↦v]) R.to_prop).to_vc,
          from to_vc_closed_of_closed this,

          have FV (prop.pre g gx) ⊆ FV Q₂ ∪ {g, gx}, from (
            assume x: var,
            assume : x ∈ FV (prop.pre g gx),
            or.elim (free_in_prop.pre.inv this) (
              assume : free_in_term x g,
              have x = g, from free_in_term.var.inv this,
              have x ∈ {g, gx}, from set.two_elems_mem.inv (or.inl this),
              show x ∈ FV Q₂ ∪ {g, gx}, from set.mem_union_right (FV Q₂) this
            ) (
              assume : free_in_term x gx,
              have x = gx, from free_in_term.var.inv this,
              have x ∈ {g, gx}, from set.two_elems_mem.inv (or.inr this),
              show x ∈ FV Q₂ ∪ {g, gx}, from set.mem_union_right (FV Q₂) this
            )
          ),
          have FV (prop.pre g gx) ⊆ (σ₂[g↦vf][gx↦v]).dom, from h52.symm ▸ this,
          have closed (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.pre g gx)), from prop.closed_of_closed_subst this,
          have h54: closed (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.pre g gx)).to_vc,
          from to_vc_closed_of_closed this,

          have h6: ⊨ vc.implies (prop.subst_env (σ₂[g↦vf][gx↦v]) R.to_prop).to_vc
                                (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.pre g gx)).to_vc,
          from valid.implies.mp (
            assume h8: ⊨ (prop.subst_env (σ₂[g↦vf][gx↦v]) R.to_prop).to_vc,
            have vc.subst_env (σ₂[g↦vf][gx↦v]) R.to_prop.to_vc
                = (prop.subst_env (σ₂[g↦vf][gx↦v]) R.to_prop).to_vc,
            from subst_env_distrib_to_vc,
            have ⊨ vc.subst_env (σ₂[g↦vf][gx↦v]) R.to_prop.to_vc, from this.symm ▸ h8,
            have h9: ⊨ vc.pre vf v, from valid.pre.mp this,
            have term.subst gx v gx = v, from term.subst.var.same,
            have h10: ⊨ vc.pre vf (term.subst gx v gx), from this.symm ▸ h9,
            have ¬(gx = g ∨ gx ∈ σ₂), from not_or_distrib.mpr ⟨g_neq_gx.symm, gx_not_free_in_σ₂⟩,
            have gx ∉ (σ₂[g↦vf]), from (mt env.contains.inv) this,
            have (σ₂[g↦vf]) gx = none, from env.contains_apply_equiv.left.mpr this,
            have term.subst_env (σ₂[g↦vf]) gx = gx, from term.subst_env.var.left.mp this,
            have h11: ⊨ vc.pre vf (term.subst gx v (term.subst_env (σ₂[g↦vf]) gx)),
            from this.symm ▸ h10,
            have term.subst_env (σ₂[g↦vf][gx↦v]) gx = term.subst gx v (term.subst_env (σ₂[g↦vf]) gx),
            by unfold term.subst_env,
            have h12: ⊨ vc.pre vf (term.subst_env (σ₂[g↦vf][gx↦v]) gx),
            from this.symm ▸ h11,
            have term.subst gx v (term.value vf) = vf, by unfold term.subst,
            have ⊨ vc.pre (term.subst gx v vf) (term.subst_env (σ₂[g↦vf][gx↦v]) gx),
            from this.symm ▸ h12,
            have h13: ⊨ vc.pre (term.subst gx v (term.subst_env (σ₂[g↦vf]) g)) (term.subst_env (σ₂[g↦vf][gx↦v]) gx),
            from g_subst.symm ▸ this,
            have term.subst_env (σ₂[g↦vf][gx↦v]) g = term.subst gx v (term.subst_env (σ₂[g↦vf]) g),
            by unfold term.subst_env,
            have h14: ⊨ vc.pre (term.subst_env (σ₂[g↦vf][gx↦v]) g) (term.subst_env (σ₂[g↦vf][gx↦v]) gx),
            from this.symm ▸ h13,
            have prop.to_vc (prop.pre (term.subst_env (σ₂[g↦vf][gx↦v]) g) (term.subst_env (σ₂[g↦vf][gx↦v]) gx))
               = (vc.pre (term.subst_env (σ₂[g↦vf][gx↦v]) g) (term.subst_env (σ₂[g↦vf][gx↦v]) gx)),
            by unfold prop.to_vc,
            have h15: ⊨ (prop.pre (term.subst_env (σ₂[g↦vf][gx↦v]) g) (term.subst_env (σ₂[g↦vf][gx↦v]) gx)).to_vc,
            from this.symm ▸ h14,
            have prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.pre g gx)
               = prop.pre (term.subst_env (σ₂[g↦vf][gx↦v]) g) (term.subst_env (σ₂[g↦vf][gx↦v]) gx),
            from prop.subst_env.pre,
            show ⊨ (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.pre g gx)).to_vc, from this.symm ▸ h15
          ),
          have h8: ⊨ (prop.implies (prop.subst_env (σ₂[g↦vf][gx↦v]) R.to_prop)
                                   (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.pre g gx))).to_vc,
          from valid.to_vc_implies.mp h6,
          have prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.implies R.to_prop (prop.pre g gx))
             = prop.implies (prop.subst_env (σ₂[g↦vf][gx↦v]) R.to_prop)
                            (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.pre g gx)),
          from prop.subst_env.implies,
          show ⊨ (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.implies R.to_prop (prop.pre g gx))).to_vc,
          from this.symm ▸ h8
        ),

        have h6: ⊨ (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.implies (prop.post g gx)
                                                     (Q₃ (term.app g gx) ⋀ S.to_prop))).to_vc, from (

          have h61: (σ₂[g↦vf][gx↦v]).dom = σ₂.dom ∪ {g, gx}, from env.dom.two_elems,
          have σ₂.dom = FV Q₂, from free_iff_contains σ₂_verified,
          have h62: (σ₂[g↦vf][gx↦v]).dom = FV Q₂ ∪ {g, gx}, from this ▸ h61,

          have FV (Q₃ (term.app g gx) ⋀ S.to_prop) ⊆ FV Q₂ ∪ {g, gx}, from (
            assume x: var,
            assume : x ∈ FV (Q₃ (term.app g gx) ⋀ S.to_prop),
            or.elim (free_in_prop.and.inv this) (
              assume : x ∈ FV (Q₃ (term.app g gx)),
              have x ∈ FV (term.app g gx) ∨ x ∈ FV (Q₂ ⋀ spec.func ↑g gx R S ⋀ R),
              from exp.post_free func_verified (term.app g gx) this,
              or.elim this (
                assume : x ∈ FV (term.app g gx),
                or.elim (free_in_term.app.inv this) (
                  assume : free_in_term x g,
                  have x = g, from free_in_term.var.inv this,
                  have x ∈ {g, gx}, from set.two_elems_mem.inv (or.inl this),
                  show x ∈ FV Q₂ ∪ {g, gx}, from set.mem_union_right (FV Q₂) this
                ) (
                  assume : free_in_term x gx,
                  have x = gx, from free_in_term.var.inv this,
                  have x ∈ {g, gx}, from set.two_elems_mem.inv (or.inr this),
                  show x ∈ FV Q₂ ∪ {g, gx}, from set.mem_union_right (FV Q₂) this
                )
              ) (
                assume : x ∈ FV (Q₂ ⋀ spec.func ↑g gx R S ⋀ R),
                or.elim (free_in_prop.and.inv this) (
                  assume : x ∈ FV Q₂,
                  show x ∈ FV Q₂ ∪ {g, gx}, from set.mem_union_left {g, gx} this
                ) (
                  assume : free_in_prop x (spec.func ↑g gx R S ⋀ R),
                  have free_in_prop x (spec.func ↑g gx R S ⋀ R), from this,
                  or.elim (free_in_prop.and.inv this) (
                    assume : free_in_prop x (spec.func ↑g gx R S),
                    have h63: free_in_prop x (spec.func ↑g gx R S).to_prop, from this,
                    have spec.to_prop (spec.func ↑g gx R S) = (prop.func ↑g gx R.to_prop S.to_prop),
                    by unfold spec.to_prop,
                    have h64: free_in_prop x (prop.func ↑g gx R S), from this ▸ h63,
                    let forallp := prop.implies R.to_prop (prop.pre g gx)
                                ⋀ prop.implies (prop.post g gx) S.to_prop in
                    have prop.func g gx R.to_prop S.to_prop
                      = (term.unop unop.isFunc g ⋀ prop.forallc gx forallp),
                    by unfold prop.func,
                    have free_in_prop x (term.unop unop.isFunc g ⋀ prop.forallc gx forallp),
                    from this ▸ h64,
                    or.elim (free_in_prop.and.inv this) (
                      assume : free_in_prop x (term.unop unop.isFunc g),
                      have free_in_term x (term.unop unop.isFunc g), from free_in_prop.term.inv this,
                      have free_in_term x g, from free_in_term.unop.inv this,
                      have x = g, from free_in_term.var.inv this,
                      have x ∈ {g, gx}, from set.two_elems_mem.inv (or.inl this),
                      show x ∈ FV Q₂ ∪ {g, gx}, from set.mem_union_right (FV Q₂) this
                    ) (
                      assume : free_in_prop x (prop.forallc gx forallp),
                      have x_neq_gx: x ≠ gx, from (free_in_prop.forallc.inv this).left,
                      have free_in_prop x forallp, from (free_in_prop.forallc.inv this).right,
                      or.elim (free_in_prop.and.inv this) (
                        assume : free_in_prop x (prop.implies R.to_prop (prop.pre g gx)),
                        or.elim (free_in_prop.implies.inv this) (
                          assume : free_in_prop x R.to_prop,
                          show x ∈ FV Q₂ ∪ {g, gx}, from R_fv this
                        ) (
                          assume : x ∈ FV (prop.pre g gx),
                          or.elim (free_in_prop.pre.inv this) (
                            assume : free_in_term x g,
                            have x = g, from free_in_term.var.inv this,
                            have x ∈ {g, gx}, from set.two_elems_mem.inv (or.inl this),
                            show x ∈ FV Q₂ ∪ {g, gx}, from set.mem_union_right (FV Q₂) this
                          ) (
                            assume : free_in_term x gx,
                            have x = gx, from free_in_term.var.inv this,
                            have x ∈ {g, gx}, from set.two_elems_mem.inv (or.inr this),
                            show x ∈ FV Q₂ ∪ {g, gx}, from set.mem_union_right (FV Q₂) this
                          )
                        )
                      ) (
                        assume : free_in_prop x (prop.implies (prop.post g gx) S.to_prop),
                        or.elim (free_in_prop.implies.inv this) (
                          assume : x ∈ FV (prop.post g gx),
                          or.elim (free_in_prop.post.inv this) (
                            assume : free_in_term x g,
                            have x = g, from free_in_term.var.inv this,
                            have x ∈ {g, gx}, from set.two_elems_mem.inv (or.inl this),
                            show x ∈ FV Q₂ ∪ {g, gx}, from set.mem_union_right (FV Q₂) this
                          ) (
                            assume : free_in_term x gx,
                            have x = gx, from free_in_term.var.inv this,
                            have x ∈ {g, gx}, from set.two_elems_mem.inv (or.inr this),
                            show x ∈ FV Q₂ ∪ {g, gx}, from set.mem_union_right (FV Q₂) this
                          )
                        ) (
                          assume : free_in_prop x S.to_prop,
                          show x ∈ FV Q₂ ∪ {g, gx}, from S_fv this
                        )
                      )
                    )
                  ) (
                    assume : free_in_prop x R,
                    show x ∈ FV Q₂ ∪ {g, gx}, from R_fv this
                  )
                )
              )
            ) (
              assume : free_in_prop x S.to_prop,
              show x ∈ FV Q₂ ∪ {g, gx}, from S_fv this
            )
          ),

          have FV (Q₃ (term.app g gx) ⋀ S.to_prop) ⊆ (σ₂[g↦vf][gx↦v]).dom, from h62.symm ▸ this,
          have closed (prop.subst_env (σ₂[g↦vf][gx↦v]) (Q₃ (term.app g gx) ⋀ S.to_prop)),
          from prop.closed_of_closed_subst this,
          have h63: closed (prop.subst_env (σ₂[g↦vf][gx↦v]) (Q₃ (term.app g gx) ⋀ S.to_prop)).to_vc,
          from to_vc_closed_of_closed this,

          have FV (prop.post g gx) ⊆ FV Q₂ ∪ {g, gx}, from (
            assume x: var,
            assume : x ∈ FV (prop.post g gx),
            or.elim (free_in_prop.post.inv this) (
              assume : free_in_term x g,
              have x = g, from free_in_term.var.inv this,
              have x ∈ {g, gx}, from set.two_elems_mem.inv (or.inl this),
              show x ∈ FV Q₂ ∪ {g, gx}, from set.mem_union_right (FV Q₂) this
            ) (
              assume : free_in_term x gx,
              have x = gx, from free_in_term.var.inv this,
              have x ∈ {g, gx}, from set.two_elems_mem.inv (or.inr this),
              show x ∈ FV Q₂ ∪ {g, gx}, from set.mem_union_right (FV Q₂) this
            )
          ),
          have FV (prop.post g gx) ⊆ (σ₂[g↦vf][gx↦v]).dom, from h62.symm ▸ this,
          have closed (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.post g gx)), from prop.closed_of_closed_subst this,
          have h64: closed (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.post g gx)).to_vc,
          from to_vc_closed_of_closed this,

          have h7: ⊨ vc.implies (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.post g gx)).to_vc
                                (prop.subst_env (σ₂[g↦vf][gx↦v]) (Q₃ (term.app g gx) ⋀ S.to_prop)).to_vc,
          from valid.implies.mp (
            assume h8: ⊨ (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.post g gx)).to_vc,
            have prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.post g gx)
               = prop.post (term.subst_env (σ₂[g↦vf][gx↦v]) g) (term.subst_env (σ₂[g↦vf][gx↦v]) gx),
            from prop.subst_env.post,
            have h9: ⊨ (prop.post (term.subst_env (σ₂[g↦vf][gx↦v]) g)
                                  (term.subst_env (σ₂[g↦vf][gx↦v]) gx)).to_vc,
            from this ▸ h8,

            have (prop.post (term.subst_env (σ₂[g↦vf][gx↦v]) g) (term.subst_env (σ₂[g↦vf][gx↦v]) gx)).to_vc
                = vc.post (term.subst_env (σ₂[g↦vf][gx↦v]) g) (term.subst_env (σ₂[g↦vf][gx↦v]) gx),
            by unfold prop.to_vc,
            have h10: ⊨ vc.post (term.subst_env (σ₂[g↦vf][gx↦v]) g) (term.subst_env (σ₂[g↦vf][gx↦v]) gx),
            from this ▸ h9,
            have term.subst_env (σ₂[g↦vf][gx↦v]) g = term.subst gx v (term.subst_env (σ₂[g↦vf]) g),
            by unfold term.subst_env,
            have ⊨ vc.post (term.subst gx v (term.subst_env (σ₂[g↦vf]) g)) (term.subst_env (σ₂[g↦vf][gx↦v]) gx),
            from this ▸ h10,
            have h11: ⊨ vc.post (term.subst gx v vf) (term.subst_env (σ₂[g↦vf][gx↦v]) gx), from g_subst ▸ this,
            have term.subst gx v (term.value vf) = vf, by unfold term.subst,
            have h12: ⊨ vc.post vf (term.subst_env (σ₂[g↦vf][gx↦v]) gx), from this ▸ h11,
            have term.subst_env (σ₂[g↦vf][gx↦v]) gx = term.subst gx v (term.subst_env (σ₂[g↦vf]) gx),
            by unfold term.subst_env,
            have h13: ⊨ vc.post vf (term.subst gx v (term.subst_env (σ₂[g↦vf]) gx)), from this ▸ h12,
            have ¬(gx = g ∨ gx ∈ σ₂), from not_or_distrib.mpr ⟨g_neq_gx.symm, gx_not_free_in_σ₂⟩,
            have gx ∉ (σ₂[g↦vf]), from (mt env.contains.inv) this,
            have (σ₂[g↦vf]) gx = none, from env.contains_apply_equiv.left.mpr this,
            have term.subst_env (σ₂[g↦vf]) gx = gx, from term.subst_env.var.left.mp this,
            have h14: ⊨ vc.post vf (term.subst gx v gx), from this ▸ h13,
            have term.subst gx v gx = v, from term.subst.var.same,
            have ⊨ vc.post vf v, from this ▸ h14,
            have (σ₂[g↦vf][gx↦v] ⊨ (Q₃ (term.app g gx)).to_vc ⋀ S.to_prop.to_vc),
            from valid.post.mpr σ₂_verified func_verified this,
            have h15: (σ₂[g↦vf][gx↦v] ⊨ (Q₃ (term.app g gx) ⋀ S.to_prop).to_vc),
            from valid_env.to_vc_and (valid_env.and.elim this).left (valid_env.and.elim this).right,
            have vc.subst_env (σ₂[g↦vf][gx↦v]) (Q₃ (term.app g gx) ⋀ S.to_prop).to_vc
              = (prop.subst_env (σ₂[g↦vf][gx↦v]) (Q₃ (term.app g gx) ⋀ S.to_prop)).to_vc,
            from subst_env_distrib_to_vc,
            show ⊨ (prop.subst_env (σ₂[g↦vf][gx↦v]) (Q₃ (term.app g gx) ⋀ S.to_prop)).to_vc,
            from this ▸ h15
          ),
          have h8: ⊨ (prop.implies (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.post g gx))
                                   (prop.subst_env (σ₂[g↦vf][gx↦v]) (Q₃ (term.app g gx) ⋀ S.to_prop))).to_vc,
          from valid.to_vc_implies.mp h7,
          have prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.implies (prop.post g gx) (Q₃ (term.app g gx) ⋀ S.to_prop))
             = prop.implies (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.post g gx))
                            (prop.subst_env (σ₂[g↦vf][gx↦v]) (Q₃ (term.app g gx) ⋀ S.to_prop)),
          from prop.subst_env.implies,
          show ⊨ (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.implies (prop.post g gx)
                                                      (Q₃ (term.app g gx) ⋀ S.to_prop))).to_vc,
          from this.symm ▸ h8
        ),

        have h7: ⊨ (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.implies R.to_prop (prop.pre g gx)) ⋀
                    prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.implies (prop.post g gx)
                                                                   (Q₃ (term.app g gx) ⋀ S.to_prop))).to_vc,
        from valid.to_vc_and h5 h6,
        have prop.subst_env (σ₂[g↦vf][gx↦v]) forallp
           = (prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.implies R.to_prop (prop.pre g gx)) ⋀
             prop.subst_env (σ₂[g↦vf][gx↦v]) (prop.implies (prop.post g gx) (Q₃ (term.app g gx) ⋀ S.to_prop))),
        from prop.subst_env.and,
        have h8: ⊨ (prop.subst_env (σ₂[g↦vf][gx↦v]) forallp).to_vc, from this.symm ▸ h7,
        have prop.subst_env (σ₂[g↦vf][gx↦v]) forallp = prop.subst gx v (prop.subst_env (σ₂[g↦vf]) forallp),
        by unfold prop.subst_env,
        have h9: ⊨ (prop.subst gx v (prop.subst_env (σ₂[g↦vf]) forallp)).to_vc, from this ▸ h8,
        have vc.subst gx v (prop.subst_env (σ₂[g↦vf]) forallp).to_vc
           = (prop.subst gx v (prop.subst_env (σ₂[g↦vf]) forallp)).to_vc,
        from subst_distrib_to_vc,
        show ⊨ vc.subst gx v (prop.subst_env (σ₂[g↦vf]) forallp).to_vc, from this.symm ▸ h9
      ),

      have h5: ⊨ prop.to_vc (prop.subst_env (σ₂[g↦vf]) (prop.forallc gx forallp)), from (
        have h6: ⊨ vc.univ gx (prop.subst_env (σ₂[g↦vf]) forallp).to_vc, from valid.univ.mp h4,
        have prop.to_vc (prop.forallc gx (prop.subst_env (σ₂[g↦vf]) forallp))
           = vc.univ gx (prop.subst_env (σ₂[g↦vf]) forallp).to_vc,
        by unfold prop.to_vc,
        have h7: ⊨ prop.to_vc (prop.forallc gx (prop.subst_env (σ₂[g↦vf]) forallp)), from this.symm ▸ h6,
        have ¬(gx = g ∨ gx ∈ σ₂), from not_or_distrib.mpr ⟨g_neq_gx.symm, gx_not_free_in_σ₂⟩,
        have gx ∉ (σ₂[g↦vf]), from (mt env.contains.inv) this,
        have (prop.subst_env (σ₂[g↦vf]) (prop.forallc gx forallp)
            = prop.forallc gx (prop.subst_env (σ₂[g↦vf]) forallp)),
        from prop.subst_env.forallc_not_in this,
        show ⊨ prop.to_vc (prop.subst_env (σ₂[g↦vf]) (prop.forallc gx forallp)), from this.symm ▸ h7
      ),

      have h7: ⊨ prop.to_vc (prop.subst_env (σ₂[g↦vf]) (term.unop unop.isFunc g) ⋀
                             prop.subst_env (σ₂[g↦vf]) (prop.forallc gx forallp)),
      from valid.to_vc_and h2 h5,
      have prop.subst_env (σ₂[g↦vf]) (term.unop unop.isFunc g ⋀ prop.forallc gx forallp)
         = (prop.subst_env (σ₂[g↦vf]) (term.unop unop.isFunc g) ⋀ prop.subst_env (σ₂[g↦vf]) (prop.forallc gx forallp)),
      from prop.subst_env.and,
      have h8: ⊨ prop.to_vc (prop.subst_env (σ₂[g↦vf]) (term.unop unop.isFunc g ⋀ prop.forallc gx forallp)),
      from this.symm ▸ h7,
      have prop.func g gx R.to_prop (Q₃ (term.app g gx) ⋀ S.to_prop)
         = (term.unop unop.isFunc g ⋀ prop.forallc gx forallp),
      by unfold prop.func,
      have ⊨ prop.to_vc (prop.subst_env (σ₂[g↦vf]) (prop.func g gx R (Q₃ (term.app g gx) ⋀ S))),
      from this.symm ▸ h8,
      have h9: ⊨ prop.to_vc pfunc, from this,

      have h10: (∀x, x ∉ FV pfunc), from (
        have ⊩ (σ₂[g↦vf]) : Q₂
          ⋀ (g ≡ (vf))
          ⋀ prop.subst_env (σ₂[g↦vf]) (prop.func g gx R (Q₃ (term.app g gx) ⋀ S)),
        from env.dvcgen.func g_not_free_in_σ₂ g_not_free_in_σ₂ gx_not_free_in_σ₂ g_neq_gx
             σ₂_verified σ₂_verified gx_free_in_R R_fv S_fv func_verified S_valid,
        prop_func_closed this
      ),

      have h11: (∀x, x ∉ FV pfunc.to_vc), from (
        assume x: var,
        assume : x ∈ FV pfunc.to_vc,
        have x ∈ FV pfunc, from set.mem_of_mem_of_subset this free_in_prop_of_free_in_to_vc,
        show «false», from (h10 x) this
      ),

      have vc.subst_env (σ₁[f↦vf]) pfunc.to_vc = pfunc.to_vc,
      from unchanged_of_subst_env_nonfree_vc h11 (σ₁[f↦vf]),
      have (σ₁[f↦vf]) ⊨ pfunc.to_vc, from this.symm ▸ h9,

      have (σ₁[f↦vf]) ⊨ ((prop.term (f ≡ vf)) ⋀ pfunc).to_vc,
      from valid_env.to_vc_and h1b this,
      show (σ₁[f↦vf]) ⊨ (Q₁ ⋀ (f ≡ vf) ⋀ pfunc).to_vc,
      from valid_env.to_vc_and h1a this
    )}
  end

lemma consequent_of_pre_P {R: spec} {σ: env} {P Q: prop}:
      (⊩ σ: P) → closed_subst σ R.to_prop → (σ ⊨ R.to_prop.to_vc) →
     closed_subst σ Q → ⦃ prop.implies (R ⋀ P) Q ⦄ → σ ⊨ Q.to_vc :=
  assume env_verified: (⊩ σ : P),
  assume R_closed: closed_subst σ R.to_prop,
  assume R_valid: (σ ⊨ R.to_prop.to_vc),
  assume Q_closed: closed_subst σ Q,
  assume vc_valid: ⦃ prop.implies (R ⋀ P) Q ⦄,

  have closed_subst σ P, from env_translation_closed_subst env_verified,
  have closed_subst σ (↑R ⋀ P), from prop.closed_subst.and R_closed this,
  have closed_subst σ (prop.implies (↑R ⋀ P) Q), from prop.closed_subst.implies this Q_closed,
  have impl: σ ⊨ (prop.implies (↑R ⋀ P) Q).to_vc, from vc_valid σ this,
  have (prop.implies (↑R ⋀ P) Q).to_vc = vc.implies (↑R ⋀ P).to_vc Q.to_vc,
  by { unfold prop.implies, unfold vc.implies, unfold prop.to_vc, congr },
  have impl2: σ ⊨ vc.implies (↑R ⋀ P).to_vc Q.to_vc, from this ▸ impl,
  have σ ⊨ P.to_vc, from env_translation_valid env_verified,
  have σ ⊨ (↑R ⋀ P).to_vc, from valid_env.to_vc_and R_valid this,
  show σ ⊨ Q.to_vc, from valid_env.mp impl2 this

lemma consequent_of_pre_P_call {R: spec} {σ: env} {P Q: prop} {x: var}:
      (⊩ σ: P) → closed_subst σ R.to_prop → (σ ⊨ R.to_prop.to_vc) → x ∈ σ →
     closed_subst σ Q → ⦃ prop.implies ((R ⋀ P) ⋀ prop.call x) Q ⦄ → σ ⊨ Q.to_vc :=
  assume env_verified: (⊩ σ : P),
  assume R_closed: closed_subst σ R.to_prop,
  assume R_valid: (σ ⊨ R.to_prop.to_vc),
  assume env_has_x: x ∈ σ,
  assume Q_closed: closed_subst σ Q,
  assume vc_valid: ⦃ prop.implies ((R ⋀ P) ⋀ prop.call x) Q ⦄,

  have closed_subst σ P, from env_translation_closed_subst env_verified,
  have h1: closed_subst σ (↑R ⋀ P), from prop.closed_subst.and R_closed this,
  have closed_subst σ (prop.call x), by begin
    assume y: var,
    assume h1,
    have h2, from free_in_prop.call.inv h1,
    have h3: (y = x), from free_in_term.var.inv h2,
    rw[←h3] at env_has_x,
    from env_has_x
  end,
  have closed_subst σ ((↑R ⋀ P) ⋀ prop.call x), from prop.closed_subst.and h1 this,
  have closed_subst σ (prop.implies ((↑R ⋀ P) ⋀ prop.call x) Q),
  from prop.closed_subst.implies this Q_closed,
  have impl: σ ⊨ (prop.implies ((↑R ⋀ P) ⋀ prop.call x) Q).to_vc, from vc_valid σ this,
  have (prop.implies (↑R ⋀ P) Q).to_vc = vc.implies (↑R ⋀ P).to_vc Q.to_vc,
  by { unfold prop.implies, unfold vc.implies, unfold prop.to_vc, congr },
  have impl2: σ ⊨ vc.implies ((↑R ⋀ P) ⋀ prop.call x).to_vc Q.to_vc, from this ▸ impl,
  have σ ⊨ P.to_vc, from env_translation_valid env_verified,
  have h2: σ ⊨ (↑R ⋀ P).to_vc, from valid_env.to_vc_and R_valid this,
  have h3: σ ⊨ value.true, from valid_env.true,
  have prop.to_vc (prop.call x) = value.true, by { unfold prop.to_vc, congr },
  have σ ⊨ (prop.call x).to_vc, from this.symm ▸ h3,
  have σ ⊨ ((↑R ⋀ P) ⋀ prop.call x).to_vc, from valid_env.to_vc_and h2 this,
  show σ ⊨ Q.to_vc, from valid_env.mp impl2 this

lemma vc.implies.self {σ: env} {P: vc}: σ ⊨ vc.implies P P :=
  begin
    apply valid_env.mpr,
    from id
  end

lemma vc.implies.and_left_intro {P Q: prop} {σ: env}:
      ((σ ⊨ Q.to_vc) → σ ⊨ P.to_vc) → σ ⊨ vc.implies Q.to_vc (P ⋀ Q).to_vc :=
  begin
    assume h1,
    apply valid_env.mpr,
    assume h2,
    apply valid_env.to_vc_and,
    from h1 h2,
    from h2
  end

lemma vc.implies.and_right_intro {P Q: prop} {σ: env}:
      ((σ ⊨ P.to_vc) → σ ⊨ Q.to_vc) → σ ⊨ vc.implies P.to_vc (P ⋀ Q).to_vc :=
  begin
    assume h1,
    apply valid_env.mpr,
    assume h2,
    apply valid_env.to_vc_and,
    from h2,
    from h1 h2
  end

lemma vc.implies.and_intro {σ: env} {P P' Q Q': prop}:
      (σ ⊨ vc.implies P.to_vc P'.to_vc) → ((σ ⊨ P.to_vc) → σ ⊨ vc.implies Q.to_vc Q'.to_vc) →
      (σ ⊨ vc.implies (P ⋀ Q).to_vc (P' ⋀ Q').to_vc) :=
  begin
    assume h1,
    assume h2,
    apply valid_env.mpr,
    assume h3,
    have h4, from (valid_env.to_vc_and.elim h3).left,
    have h5, from (valid_env.to_vc_and.elim h3).right,
    have h6, from h2 h4,
    apply valid_env.to_vc_and,
    from valid_env.mp h1 h4,
    from valid_env.mp h6 h5
  end

lemma vc.implies.and_symm {σ: env} {P Q: prop}: (σ ⊨ vc.implies (P ⋀ Q).to_vc (Q ⋀ P).to_vc) :=
  begin
    apply valid_env.mpr,
    assume h1,
    apply valid_env.to_vc_and,
    from (valid_env.to_vc_and.elim h1).right,
    from (valid_env.to_vc_and.elim h1).left
  end

lemma vc.implies.and_elim_left {σ: env} {P₁ P₂ P₃: prop}:
      (σ ⊨ vc.implies P₁.to_vc (P₂ ⋀ P₃).to_vc) → (σ ⊨ vc.implies P₁.to_vc P₂.to_vc) :=
  begin
    assume h1,
    apply valid_env.mpr,
    assume h2,
    have h3, from valid_env.mp h1 h2,
    from (valid_env.to_vc_and.elim h3).left
  end

lemma vc.implies.and_assoc {σ: env} {P₁ P₂ P₃: prop}:
      σ ⊨ vc.implies (P₁ ⋀ P₂ ⋀ P₃).to_vc ((P₁ ⋀ P₂) ⋀ P₃).to_vc :=
  begin
    apply valid_env.mpr,
    assume h1,
    have h2, from (valid_env.to_vc_and.elim h1).right,

    apply valid_env.to_vc_and,
    apply valid_env.to_vc_and,
    from (valid_env.to_vc_and.elim h1).left,
    from (valid_env.to_vc_and.elim h2).left,
    from (valid_env.to_vc_and.elim h2).right
  end

lemma vc.implies.subst {σ: env} {x: var} {v: value} {P: prop}:
      (σ x = v) → (σ ⊨ vc.implies (prop.subst x v P).to_vc P.to_vc) :=
  begin
    assume h1,
    apply valid_env.mpr,
    assume h2,
    have h3: (vc.subst x v (prop.to_vc P) = prop.to_vc (prop.subst x v P)),
    from subst_distrib_to_vc,
    rw[h3.symm] at h2,
    have h4: (vc.subst_env σ (vc.subst x v (prop.to_vc P)) = vc.subst_env σ (prop.to_vc P)),
    from vc.subst_env_inner h1,
    rw[h4] at h2,
    from h2
  end

lemma valid_with_additional_var {P: vc} {x: var} {v: value} {σ: env}:
      (σ ⊨ P) → ((σ[x↦v]) ⊨ P) :=
  begin
    assume h1,

    by_cases (x ∈ σ) with h4,
    unfold vc.subst_env,
    have h7: x ∉ FV (vc.subst_env σ P), from vc.not_free_of_subst_env h4,
    have h8: (vc.subst x v (vc.subst_env σ P) = vc.subst_env σ P),
    from unchanged_of_subst_nonfree_vc h7,
    rw[←h8] at h1,
    from h1,

    by_cases (free_in_vc x P) with h5,

    have h8: x ∈ FV (vc.subst_env σ P),
    from vc.free_of_subst_env h5 h4,
    have h9, from valid.univ.free ⟨h8, h1⟩,
    have h10, from valid.univ.mpr h9 v,

    have h11: (vc.substt x ↑v (vc.subst_env σ P) = vc.subst x v (vc.subst_env σ P)),
    from vc.substt_value_eq_subst,
    rw[h11] at h10,
    unfold vc.subst_env,
    from h10,

    have h9: x ∉ FV (vc.subst_env σ P), by begin
      assume h10,
      have h11, from vc.free_of_free_subst_env h10,
      contradiction
    end,
    have h10: (vc.substt x v (vc.subst_env σ P) = vc.subst_env σ P),
    from unchanged_of_substt_nonfree_vc h9,
    unfold vc.subst_env,
    have h11: (vc.substt x ↑v (vc.subst_env σ P) = vc.subst x v (vc.subst_env σ P)),
    from vc.substt_value_eq_subst,
    have h12: (vc.subst_env σ P = vc.subst x v (vc.subst_env σ P)), from eq.trans h10.symm h11,
    rw[←h12],
    from h1
  end

lemma valid_with_additional_vars {P: vc} {σ: env}: (⊨ P) → (σ ⊨ P) :=
  begin
    assume h1,

    induction σ with σ' x v ih,

    show env.empty ⊨ P, by begin
      unfold vc.subst_env,
      from h1
    end,

    show (σ'[x↦v]) ⊨ P, by begin
      from valid_with_additional_var ih
    end
  end

lemma vc.implies.exis {σ: env} {x: var} {P: prop}:
      σ ⊨ vc.implies P.to_vc (prop.exis x P).to_vc :=
  begin
    apply valid_env.nmt,
    apply valid_env.mpr,
    assume h1,
    apply valid_env.not.mp,
    by_contradiction h2,
    unfold prop.to_vc at h1,
    have h3, from valid_env.not_not.mp h1,
    have h4: (vc.subst_env σ (vc.univ x (vc.not (prop.to_vc P)))
           = vc.univ x (vc.subst_env (σ.without x) (vc.not (prop.to_vc P)))),
    from vc.subst_env.univ,
    rw[h4] at h3,

    by_cases (x ∈ σ) with h4,
    have h5, from env.contains_apply_equiv.right.mpr h4,
    cases h5 with v h6,
    have h7, from valid.univ.mpr h3 v,
    have h8: (vc.substt x ↑v (vc.subst_env (env.without σ x) (vc.not (prop.to_vc P)))
            = vc.subst x v (vc.subst_env (env.without σ x) (vc.not (prop.to_vc P)))),
    from vc.substt_value_eq_subst,
    rw[h8] at h7,
    have h9: (vc.subst x v (vc.subst_env (env.without σ x) (vc.not (prop.to_vc P)))
     = vc.subst_env ((env.without σ x)[x↦v]) (vc.not (prop.to_vc P))),
    by unfold vc.subst_env,
    rw[h9] at h7,
    have h10: (vc.subst_env ((env.without σ x)[x↦v]) (vc.not (prop.to_vc P)) = vc.subst_env σ (vc.not (prop.to_vc P))),
    from vc.subst_env_with_without_equivalent h6,
    rw[h10] at h7,
    have h11, from valid_env.not.mpr h7,
    contradiction,

    have h5: (env.without σ x = σ), from env.without_nonexisting h4,
    rw[h5] at h3,
    by_cases (free_in_vc x P.to_vc) with h6,

    have h7: x ∈ FV P.to_vc, from h6,
    have h8: x ∈ FV (vc.subst_env σ P.to_vc),
    from vc.free_of_subst_env h7 h4,
    have h9, from valid.univ.free ⟨h8, h2⟩,
    have h10, from valid.univ.mpr h3 value.true,
    have h11, from valid.univ.mpr h9 value.true,
    have h12: (vc.subst_env σ (vc.substt x value.true (vc.not (prop.to_vc P)))
             = vc.substt x value.true (vc.subst_env σ (vc.not (prop.to_vc P)))),
    from vc.substt_env.order (λx, free_in_term.value.inv) h4,
    rw[h12.symm] at h10,
    have h13: (vc.subst_env σ (vc.substt x value.true (prop.to_vc P))
             = vc.substt x value.true (vc.subst_env σ (prop.to_vc P))),
    from vc.substt_env.order (λx, free_in_term.value.inv) h4,
    rw[h13.symm] at h11,
    unfold vc.substt at h10,
    have h14, from valid_env.not.mpr h10,
    contradiction,

    have h7, from valid.univ.mpr h3 value.true,
    have h8: x ∉ FV (vc.not P.to_vc), by begin
      assume h9,
      have h10, from free_in_vc.not.inv h9,
      contradiction
    end,
    have h9: x ∉ FV (vc.subst_env σ (vc.not (prop.to_vc P))), by begin
      assume h10,
      have h11, from vc.free_of_free_subst_env h10,
      contradiction
    end,
    have h10: (vc.substt x ↑value.true (vc.subst_env σ (vc.not (prop.to_vc P)))
            = (vc.subst_env σ (vc.not (prop.to_vc P)))),
    from unchanged_of_substt_nonfree_vc h9,
    rw[h10] at h7,
    have h11, from valid_env.not.mpr h7,
    contradiction
  end

lemma vc.implies.same_right {σ: env} {P P' Q: prop}:
  ((σ ⊨ Q.to_vc) → σ ⊨ vc.implies P.to_vc P'.to_vc) → (σ ⊨ vc.implies (P ⋀ Q).to_vc (P' ⋀ Q).to_vc) :=
  begin
    assume h1: (σ ⊨ Q.to_vc) → σ ⊨ vc.implies P.to_vc P'.to_vc,
    apply valid_env.mpr,
    assume h2: σ ⊨ (P ⋀ Q).to_vc,
    apply valid_env.to_vc_and,
    have h3, from (valid_env.to_vc_and.elim h2).left,
    from valid_env.mp (h1 (valid_env.to_vc_and.elim h2).right) h3,
    from (valid_env.to_vc_and.elim h2).right
  end

lemma vc.implies.and_assoc.symm {P₁ P₂ P₃: prop} {σ: env}:
      σ ⊨ vc.implies ((P₁ ⋀ P₂) ⋀ P₃).to_vc (P₁ ⋀ P₂ ⋀ P₃).to_vc :=
  have h1: σ ⊨ vc.implies ((P₁ ⋀ P₂) ⋀ P₃).to_vc (P₃ ⋀ P₁ ⋀ P₂).to_vc, from vc.implies.and_symm,
  have h2: σ ⊨ vc.implies (P₃ ⋀ P₁ ⋀ P₂).to_vc ((P₃ ⋀ P₁) ⋀ P₂).to_vc, from vc.implies.and_assoc,
  have h3: σ ⊨ vc.implies ((P₃ ⋀ P₁) ⋀ P₂).to_vc (P₂ ⋀ P₃ ⋀ P₁).to_vc, from vc.implies.and_symm,
  have h4: σ ⊨ vc.implies (P₂ ⋀ P₃ ⋀ P₁).to_vc ((P₂ ⋀ P₃) ⋀ P₁).to_vc, from vc.implies.and_assoc,
  have h5: σ ⊨ vc.implies ((P₂ ⋀ P₃) ⋀ P₁).to_vc (P₁ ⋀ P₂ ⋀ P₃).to_vc , from vc.implies.and_symm,
  show σ ⊨ vc.implies ((P₁ ⋀ P₂) ⋀ P₃).to_vc (P₁ ⋀ P₂ ⋀ P₃).to_vc,
  from vc.implies.trans h1 (vc.implies.trans h2 (vc.implies.trans h3 (vc.implies.trans h4 h5)))

lemma vc.implies.shuffle {P Q R S: prop} {σ: env}:
      σ ⊨ vc.implies (P ⋀ Q ⋀ R ⋀ S).to_vc ((P ⋀ Q ⋀ R) ⋀ S).to_vc :=
  have h1: σ ⊨ vc.implies (P ⋀ Q ⋀ R ⋀ S).to_vc ((Q ⋀ R ⋀ S) ⋀ P).to_vc, from vc.implies.and_symm,
  have h2: σ ⊨ vc.implies ((Q ⋀ R ⋀ S) ⋀ P).to_vc (((Q ⋀ R) ⋀ S) ⋀ P).to_vc,
  from vc.implies.same_right (λ_, vc.implies.and_assoc),
  have h3: σ ⊨ vc.implies  (((Q ⋀ R) ⋀ S) ⋀ P).to_vc ((Q ⋀ R) ⋀ S ⋀ P).to_vc, from vc.implies.and_assoc.symm,
  have h4: σ ⊨ vc.implies ((Q ⋀ R) ⋀ S ⋀ P).to_vc ((S ⋀ P) ⋀ Q ⋀ R).to_vc, from vc.implies.and_symm,
  have h5: σ ⊨ vc.implies ((S ⋀ P) ⋀ Q ⋀ R).to_vc (S ⋀ P ⋀ Q ⋀ R).to_vc, from vc.implies.and_assoc.symm,
  have h6: σ ⊨ vc.implies (S ⋀ P ⋀ Q ⋀ R).to_vc ((P ⋀ Q ⋀ R) ⋀ S).to_vc, from vc.implies.and_symm,
  show σ ⊨ vc.implies  (P ⋀ Q ⋀ R ⋀ S).to_vc ((P ⋀ Q ⋀ R) ⋀ S).to_vc,
  from vc.implies.trans h1 (vc.implies.trans h2 (vc.implies.trans h3 (vc.implies.trans h4 (vc.implies.trans h5 h6))))

lemma vc.implies.same_left {σ: env} {P Q Q': prop}:
      ((σ ⊨ P.to_vc) → σ ⊨ vc.implies Q.to_vc Q'.to_vc) → σ ⊨ vc.implies (P ⋀ Q).to_vc (P ⋀ Q').to_vc :=
  assume h1: (σ ⊨ P.to_vc) → σ ⊨ vc.implies Q.to_vc Q'.to_vc,
  have h2: σ ⊨ vc.implies (P ⋀ Q).to_vc (Q ⋀ P).to_vc, from vc.implies.and_symm,
  have h3: σ ⊨ vc.implies (Q ⋀ P).to_vc (Q' ⋀ P).to_vc, from vc.implies.same_right h1,
  have h4: σ ⊨ vc.implies (Q' ⋀ P).to_vc (P ⋀ Q').to_vc, from vc.implies.and_symm,
  show σ ⊨ vc.implies (P ⋀ Q).to_vc (P ⋀ Q').to_vc,
  from vc.implies.trans h2 (vc.implies.trans h3 h4)

lemma vc.implies.and_elim_right {σ: env} {P₁ P₂ P₃: prop}:
      (σ ⊨ vc.implies P₁.to_vc (P₂ ⋀ P₃).to_vc) → σ ⊨ vc.implies P₁.to_vc P₃.to_vc :=
  assume h1: σ ⊨ vc.implies P₁.to_vc (P₂ ⋀ P₃).to_vc,
  have h2: σ ⊨ vc.implies (P₂ ⋀ P₃).to_vc (P₃ ⋀ P₂).to_vc, from vc.implies.and_symm,
  have h3: σ ⊨ vc.implies P₁.to_vc (P₃ ⋀ P₂).to_vc, from vc.implies.trans h1 h2,
  show σ ⊨ vc.implies P₁.to_vc P₃.to_vc, from vc.implies.and_elim_left h3

lemma vc.implies.left_elim {P₁ P₂ P₃: prop} {σ: env}:
      ((σ ⊨ P₁.to_vc) → σ ⊨ vc.implies P₂.to_vc P₃.to_vc) → σ ⊨ vc.implies (P₁ ⋀ P₂).to_vc P₃.to_vc :=
  assume h1: (σ ⊨ P₁.to_vc) → σ ⊨ vc.implies P₂.to_vc P₃.to_vc,
  have h2: σ ⊨ vc.implies (P₁ ⋀ P₂).to_vc (P₁ ⋀ P₃).to_vc, from vc.implies.same_left h1,
  show σ ⊨ vc.implies (P₁ ⋀ P₂).to_vc P₃.to_vc, from vc.implies.and_elim_right h2

lemma vc.implies.right_elim {P₁ P₂ P₃: prop} {σ: env}:
      ((σ ⊨ P₂.to_vc) → σ ⊨ vc.implies P₁.to_vc P₃.to_vc) → σ ⊨ vc.implies (P₁ ⋀ P₂).to_vc P₃.to_vc :=
  assume h1: (σ ⊨ P₂.to_vc) → σ ⊨ vc.implies P₁.to_vc P₃.to_vc,
  have h2: σ ⊨ vc.implies (P₁ ⋀ P₂).to_vc (P₃ ⋀ P₂).to_vc, from vc.implies.same_right h1,
  show σ ⊨ vc.implies (P₁ ⋀ P₂).to_vc P₃.to_vc, from vc.implies.and_elim_left h2

lemma vc.implies.of_and_left {P₁ P₂: prop} {σ: env}: σ ⊨ vc.implies (P₁ ⋀ P₂).to_vc P₁.to_vc :=
  have σ ⊨ vc.implies (P₁ ⋀ P₂).to_vc (P₁ ⋀ P₂).to_vc, from vc.implies.self,
  show σ ⊨ vc.implies (P₁ ⋀ P₂).to_vc P₁.to_vc, from vc.implies.and_elim_left this

lemma vc.implies.of_and_right {P₁ P₂: prop} {σ: env}: σ ⊨ vc.implies (P₁ ⋀ P₂).to_vc P₂.to_vc :=
  have h1: σ ⊨ vc.implies (P₁ ⋀ P₂).to_vc (P₂ ⋀ P₁).to_vc, from vc.implies.and_symm,
  have h2: σ ⊨ vc.implies (P₂ ⋀ P₁).to_vc P₂.to_vc, from vc.implies.of_and_left,
  show σ ⊨ vc.implies (P₁ ⋀ P₂).to_vc P₂.to_vc, from vc.implies.trans h1 h2

lemma vc.implies.equiv_subst {σ₁ σ₂: env} {P: prop}:
  (∀y, y ∈ σ₁ → (σ₁ y = σ₂ y)) → σ₂ ⊨ vc.implies (prop.subst_env σ₁ P).to_vc P.to_vc :=
  begin
    assume env_equiv,

    induction σ₁ with σ' x v ih,

    show σ₂ ⊨ vc.implies (prop.to_vc (prop.subst_env env.empty P)) (prop.to_vc P), by begin
      unfold prop.subst_env,
      from vc.implies.self
    end,

    unfold prop.subst_env,
    have h2: σ₂ ⊨ vc.implies (prop.subst x v (prop.subst_env σ' P)).to_vc (prop.subst_env σ' P).to_vc, by begin
      by_cases (x ∈ σ') with h,

      have h3: x ∉ FV (prop.subst_env σ' P), from prop.not_free_of_subst_env h,
      have h4: (prop.subst x v (prop.subst_env σ' P) = prop.subst_env σ' P),
      from unchanged_of_subst_nonfree_prop h3,
      have h5: σ₂ ⊨ vc.implies (prop.subst_env σ' P).to_vc (prop.subst_env σ' P).to_vc, from vc.implies.self,
      from h4.symm ▸ h5,

      have h2, from env_equiv x env.contains.same,
      have h3: ((σ'[x↦v]) x = v), from env.apply_of_contains h,
      have h4: (σ₂ x = v), from eq.trans h2.symm h3,
      show σ₂ ⊨ vc.implies (prop.subst x v (prop.subst_env σ' P)).to_vc (prop.subst_env σ' P).to_vc,
      from vc.implies.subst h4
    end,
    have h3: (∀ (y : var), y ∈ σ' → (σ' y = σ₂ y)), by begin
      assume y,
      assume h3,
      have h4: y ∈ (σ'[x↦v]), from env.contains.rest h3,
      have h5, from env_equiv y h4,
      have h6: (∃ (v : value), env.apply σ' y = some v), from env.contains_apply_equiv.right.mpr h3,
      have h7, from option.is_some_iff_exists.mpr h6,
      have h8, from option.some_iff_not_none.mp h7,
      have h9: (x ≠ y ∨ ¬ (option.is_none (env.apply σ' y))), from or.inr h8,
      have h10: ¬ (x = y ∧ (option.is_none (env.apply σ' y))), from not_and_distrib.mpr h9,
      have h11: (env.apply (σ'[x↦v]) y = (σ' y)), by { unfold env.apply, simp[h10], refl },
      from eq.trans h11.symm h5
    end,
    have h4, from ih h3,
    from vc.implies.trans h2 h4
  end

lemma valid_env.equiv_env {σ₁ σ₂: env} {P: prop}: (∀y, y ∈ σ₁ → (σ₁ y = σ₂ y)) → (σ₁ ⊨ P.to_vc) → σ₂ ⊨ P.to_vc :=
  begin
    assume h1,
    have h2: σ₂ ⊨ vc.implies (prop.subst_env σ₁ P).to_vc P.to_vc, from vc.implies.equiv_subst h1,
    have h3, from valid_env.mp h2,
    assume h4,
    have h5: (σ₂ ⊨ prop.to_vc (prop.subst_env σ₁ P)), by begin
      have h6: (vc.subst_env σ₁ (prop.to_vc P) = prop.to_vc (prop.subst_env σ₁ P)),
      from subst_env_distrib_to_vc,
      rw[h6] at h4,
      from valid_with_additional_vars h4
    end,
    from h3 h5
  end


/-
Copyright (c) 2023 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.constructions.repeat

/-!
# Repeated Computation Until a Condition

This file defines a construction `try_until oa p n` that repeats a computation until `p` holds.
The parameter `n` gives a bound on the number of runs (called "gas" in some formulations).
This solves the problem of an unbounded computation, by giving a finite computation depth.
Because this may not always produce a final result, we use an option type to represent failure.

We implement this as a mapping of `oracle_comp.repeat` for simplicity in deriving lemmas.
This means that the computation always "runs" `n` times even if a result is found before that.
However it isn't clear that this is commonly a problem, so we take this approach for now.
-/

namespace oracle_comp

open oracle_spec

variables {α β γ : Type} {spec spec' : oracle_spec}

/-- Computation that repeats `oa` until `p` holds on the result, with at most `n` attempts. -/
def try_until (oa : oracle_comp spec α) (p : α → Prop) [decidable_pred p]
  (n : ℕ) : oracle_comp spec (option α) :=
(λ xs, (vector.to_list xs).find p) <$> (repeat oa n)

variables (oa : oracle_comp spec α) (p : α → Prop) [decidable_pred p] (n : ℕ)

lemma try_until_zero : oa.try_until p 0 =
  (λ xs, (vector.to_list xs).find p) <$> (return vector.nil) := rfl

lemma try_until_succ : oa.try_until p n.succ =
  (λ xs, (vector.to_list xs).find p) <$> do {a ← oa, as ← oa.repeat n, return (a ::ᵥ as)} := rfl

instance try_until.decidable [decidable_eq α] [decidable oa] : decidable (oa.try_until p n) :=
oracle_comp.decidable_map _ _

section support

/-- Any positive result of `oa.try_until p n` will be some output of `oa`. -/
lemma mem_support_of_some_mem_support_try_until (x : α)
  (hx : some x ∈ (oa.try_until p n).support) : x ∈ oa.support :=
begin
  simp_rw [try_until, support_map, set.mem_image, mem_support_repeat_iff_forall] at hx,
  exact let ⟨xs, hxs, hxs'⟩ := hx in hxs x (list.find_mem hxs')
end

/-- Any positive result of `oa.try_until p n` will satisfy the predicate `p`. -/
lemma pos_of_some_mem_support_try_until (x : α)
  (hx : some x ∈ (oa.try_until p n).support) : p x :=
begin
  simp_rw [try_until, support_map, set.mem_image, mem_support_repeat_iff_forall] at hx,
  exact let ⟨xs, hxs, hxs'⟩ := hx in list.find_some hxs',
end

/-- Running a computation zero times will never return a positive result. -/
@[simp] lemma support_try_until_zero : (oa.try_until p 0).support = {none} :=
by rw [try_until_zero, support_map, support_return, set.image_singleton,
  vector.to_list_nil, list.find_nil]

lemma mem_support_try_until_zero_iff (x : option α) : x ∈ (oa.try_until p 0).support ↔ x = none :=
by rw [support_try_until_zero, set.mem_singleton_iff]

/-- `oa.try_until p n` can fail to find a result iff there's an output `x` of `oa` with `¬ p x`. -/
lemma none_mem_support_try_until_succ_iff :
  none ∈ (oa.try_until p n.succ).support ↔ ∃ x ∈ oa.support, ¬ p x :=
begin
  simp only [try_until, mem_support_map_iff, list.find_eq_none],
  exact ⟨λ h, let ⟨xs, hxs, hp⟩ := h in ⟨xs.head, mem_support_of_mem_of_support_repeat hxs
    xs.head_mem, hp _ xs.head_mem⟩, λ h, let ⟨x, hx, hp⟩ := h in ⟨vector.repeat x n.succ,
      repeat_mem_support_repeat n.succ hx, λ y hy, (list.eq_of_mem_repeat hy).symm ▸ hp⟩⟩
end

lemma none_not_mem_support_try_until (hx : ∀ x ∈ oa.support, p x) :
  none ∉ (oa.try_until p n.succ).support :=
mt (none_mem_support_try_until_succ_iff oa p n).1 (by simpa only [not_exists, not_not] using hx)

/-- The possible successful results of `oa.try_until p n` are outputs `x` of `oa` with `p x`. -/
lemma some_mem_support_try_until_succ_iff (x : α) :
  some x ∈ (oa.try_until p n.succ).support ↔ x ∈ oa.support ∧ p x :=
begin
  simp only [try_until, mem_support_map_iff],
  refine ⟨λ h, let ⟨xs, hxs, hp⟩ := h in ⟨mem_support_of_mem_of_support_repeat hxs
    (list.find_mem hp), list.find_some hp⟩, λ h, ⟨vector.repeat x n.succ, repeat_mem_support_repeat
      _ h.1, _⟩,

      ⟩,
  simp only [vector.repeat, list.find_repeat, vector.to_list, h.2],
  simp only [nat.succ_pos', and_self, if_true]
end

lemma some_mem_support_try_until_succ {x : α} (hx : x ∈ oa.support) (h : p x) :
  some x ∈ (oa.try_until p n.succ).support :=
(some_mem_support_try_until_succ_iff oa p n x).2 ⟨hx, h⟩

/-- If at least one result of `oa` doesn't satisfy `p` then the result of `oa.try_until p n.succ`
is either `none` (in the case of failure) or `some x` for some output `x` of `oa` with `p x`. -/
lemma support_try_until_succ_of_exists_neg (h : ∃ x ∈ oa.support, ¬ p x) :
  (oa.try_until p n.succ).support = insert none (option.some '' {x | x ∈ oa.support ∧ p x}) :=
begin
  obtain ⟨x, hx, hpx⟩ := h,
  refine set.ext (λ y, _),
  rw [try_until, support_map, support_repeat_eq_forall],
  cases y with y,
  { simp only [set.mem_image, set.mem_set_of_eq, list.find_eq_none, set.mem_insert_iff,
      eq_self_iff_true, and_false, exists_false, or_false, iff_true],
    refine ⟨vector.repeat x n.succ, λ y hy, _, λ y hy, _⟩;
    { rw [vector.repeat, vector.to_list, list.mem_repeat_succ_iff] at hy,
      simpa only [hy] } },
  { simp only [set.mem_image, set.mem_set_of_eq, set.mem_insert_iff, exists_eq_right, false_or],
    refine ⟨λ h, let ⟨xs, hxs⟩ := h in ⟨hxs.1 _ (list.find_mem hxs.2), list.find_some hxs.2⟩,
    λ h, ⟨vector.repeat y n.succ, λ z hz, _, list.find_cons_of_pos _ h.2⟩⟩,
    rw [vector.repeat, vector.to_list, list.mem_repeat_succ_iff] at hz,
    exact hz.symm ▸ h.1 }
end

/-- If all results of `oa` satisfy `p`, then `oa.try_until p n.succ` will just return `some x`,
for some `x ∈ oa.support`(in particular the result of the first of the `n.succ` runs). -/
lemma support_try_until_succ_of_forall_pos (hp : ∀ x ∈ oa.support, p x) :
  (oa.try_until p n.succ).support = option.some '' oa.support :=
begin
  refine set.ext (λ y, ⟨λ h, _, λ h, _⟩),
  { cases y with y,
    { exact false.elim (none_not_mem_support_try_until oa p n hp h) },
    { exact ⟨y, mem_support_of_some_mem_support_try_until oa p _ y h, rfl⟩ } },
  { exact let ⟨x, hx⟩ := h in hx.2 ▸ some_mem_support_try_until_succ oa p _ hx.1 (hp x hx.1) }
end

end support

end oracle_comp