Imports
Concrete verifier: reusable rejecting phases
namespace CLRS.Chapter34.Turing.GeneralCircuitVerifieropen Computability StateTransitionopen _root_.Turingprivate abbrev transition := flip Option.bind stepA configuration reaches the canonical one-symbol rejection halt.
def Rejects (start : machine.Cfg) : Prop :=
∃ steps, transition^[steps] (some start) = some (haltList machine [false])Any one-step transition into the common cleanup path rejects.
theorem rejects_after_cleanup_step (start : machine.Cfg) (state : State)
(input : List (Option CircuitSym)) (certificate values scratch : List Bool)
(gateCount index saved : Nat)
(hstep : step start = some (cfg (some (.clearInput false)) state input []
certificate values scratch gateCount index saved)) :
Rejects start := by
refine ⟨cleanupSteps input certificate values scratch gateCount index saved + 1, ?_⟩
exact step_then _ hstep
(cleanup_phase state false input certificate values scratch gateCount index saved)Rejection is closed under a preceding concrete step.
theorem Rejects.before_step {start next : machine.Cfg}
(hstep : step start = some next) (hreject : Rejects next) : Rejects start := by
rcases hreject with ⟨steps, hrun⟩
exact ⟨steps + 1, step_then steps hstep hrun⟩Rejection is closed under an exact preceding phase.
theorem Rejects.before_steps {start next : machine.Cfg} (phaseSteps : Nat)
(hrun : transition^[phaseSteps] (some start) = some next)
(hreject : Rejects next) : Rejects start := by
rcases hreject with ⟨rejectSteps, hreject⟩
exact ⟨rejectSteps + phaseSteps,
step_comp phaseSteps rejectSteps hrun hreject⟩Consume a specified run of input-arity markers while preserving the certificate-validity flag.
theorem input_count_args_phase (state : State) (count remaining : Nat)
(input : List (Option CircuitSym)) (certificate values scratch : List Bool)
(index saved : Nat) :
∃ finalState,
finalState.validAssignment = state.validAssignment ∧
transition^[count]
(some (cfg (some .inputCount) state
(List.replicate count (some .argMark) ++ input)
[] certificate values scratch (remaining + count) index saved)) =
some (cfg (some .inputCount) finalState input [] certificate values scratch
remaining index saved) := by
induction count generalizing state remaining with
| zero => exact ⟨state, rfl, by simp⟩
| succ count ih =>
let nextState : State :=
{ state with inputBuffer := some (some .argMark), counterPresent := true }
rcases ih nextState remaining with ⟨finalState, hvalid, hrun⟩
refine ⟨finalState, by simpa [nextState] using hvalid, ?_⟩
have hfirst := input_count_arg_step state
(List.replicate count (some .argMark) ++ input) [] certificate values scratch
(remaining + count) index saved
have hfull := step_then count hfirst hrun
simpa [nextState, List.replicate_succ, Nat.add_assoc, Nat.add_left_comm,
Nat.add_comm] using hfullHeader checking rejects exactly when the certificate count differs from the declared arity or the scanned certificate contained a non-Boolean symbol.
theorem input_count_reject (state : State) (inputCount certificateCount : Nat)
(input : List (Option CircuitSym)) (certificate values scratch : List Bool)
(index saved : Nat)
(hbad : certificateCount ≠ inputCount ∨ state.validAssignment = false) :
Rejects (cfg (some .inputCount) state
(List.map some (encNat inputCount) ++ input)
[] certificate values scratch certificateCount index saved) := by
rcases Nat.lt_trichotomy certificateCount inputCount with hshort | heq | hlong
· obtain ⟨remaining, hinputCount⟩ :
∃ remaining, inputCount = certificateCount + remaining + 1 := by
exact ⟨inputCount - certificateCount - 1, by omega⟩
rcases input_count_args_phase state certificateCount 0
(List.replicate (remaining + 1) (some .argMark) ++
some .endMark :: input) certificate values scratch index saved with
⟨afterArgs, _, hargs⟩
have hstream : List.map some (encNat inputCount) ++ input =
List.replicate certificateCount (some .argMark) ++
(List.replicate (remaining + 1) (some .argMark) ++
some .endMark :: input) := by
simp only [encNat, List.map_append, List.map_replicate, List.map_cons,
List.map_nil]
rw [hinputCount, show certificateCount + remaining + 1 =
certificateCount + (remaining + 1) by omega,
List.replicate_add certificateCount (remaining + 1)
(some CircuitSym.argMark : Option CircuitSym)]
simp [List.replicate_add, List.append_assoc]
have hargs' : transition^[certificateCount]
(some (cfg (some .inputCount) state
(List.map some (encNat inputCount) ++ input)
[] certificate values scratch certificateCount index saved)) =
some (cfg (some .inputCount) afterArgs
(List.replicate (remaining + 1) (some .argMark) ++
some .endMark :: input)
[] certificate values scratch 0 index saved) := by
rw [hstream]
simpa only [Nat.zero_add] using hargs
apply Rejects.before_steps certificateCount hargs'
exact rejects_after_cleanup_step _ _
(List.replicate remaining (some .argMark) ++ some .endMark :: input)
certificate values scratch 0 index saved
(by
simpa [List.replicate_succ] using
input_count_arg_underflow_step afterArgs
(List.replicate remaining (some .argMark) ++ some .endMark :: input)
[] certificate values scratch index saved)
· subst certificateCount
rcases hbad with hne | hinvalid
· exact False.elim (hne rfl)
· rcases input_count_args_phase state inputCount 0
(some .endMark :: input) certificate values scratch index saved with
⟨afterArgs, hvalid, hargs⟩
have hinvalid' : afterArgs.validAssignment = false := by
rw [hvalid]
exact hinvalid
have hargs' : transition^[inputCount]
(some (cfg (some .inputCount) state
(List.map some (encNat inputCount) ++ input)
[] certificate values scratch inputCount index saved)) =
some (cfg (some .inputCount) afterArgs (some .endMark :: input)
[] certificate values scratch 0 index saved) := by
simpa [encNat, List.map_append, List.append_assoc] using hargs
apply Rejects.before_steps inputCount hargs'
exact rejects_after_cleanup_step _ _ input certificate values scratch
0 index saved
(input_count_end_invalid_step afterArgs input [] certificate values scratch
index saved hinvalid')
· obtain ⟨extra, hcertificateCount⟩ :
∃ extra, certificateCount = inputCount + extra + 1 := by
exact ⟨certificateCount - inputCount - 1, by omega⟩
rcases input_count_args_phase state inputCount (extra + 1)
(some .endMark :: input) certificate values scratch index saved with
⟨afterArgs, _, hargs⟩
have hargs' : transition^[inputCount]
(some (cfg (some .inputCount) state
(List.map some (encNat inputCount) ++ input)
[] certificate values scratch certificateCount index saved)) =
some (cfg (some .inputCount) afterArgs (some .endMark :: input)
[] certificate values scratch (extra + 1) index saved) := by
simpa [encNat, hcertificateCount, List.map_append, List.append_assoc,
Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using hargs
apply Rejects.before_steps inputCount hargs'
exact rejects_after_cleanup_step _ _ input certificate values scratch
extra index saved
(input_count_end_nonempty_step afterArgs input [] certificate values scratch
extra index saved)The circuit input-count parser rejects every malformed unary number.
theorem input_count_reject_of_decNat_none (state : State)
(symbols : List CircuitSym) (certificate values scratch : List Bool)
(gateCount index saved : Nat) (hdecode : decNat symbols = none) :
Rejects (cfg (some .inputCount) state (List.map some symbols)
[] certificate values scratch gateCount index saved) := by
induction symbols generalizing state gateCount with
| nil =>
exact rejects_after_cleanup_step _ _ [] certificate values scratch
gateCount index saved
(input_count_eof_reject_step state [] certificate values scratch
gateCount index saved)
| cons symbol symbols ih =>
by_cases harg : symbol = .argMark
· subst symbol
simp only [decNat, Option.map_eq_none_iff] at hdecode
cases gateCount with
| zero =>
exact rejects_after_cleanup_step _ _ (List.map some symbols)
certificate values scratch 0 index saved
(input_count_arg_underflow_step state (List.map some symbols)
[] certificate values scratch index saved)
| succ gateCount =>
let nextState : State :=
{ state with inputBuffer := some (some .argMark), counterPresent := true }
have hfirst := input_count_arg_step state (List.map some symbols)
[] certificate values scratch gateCount index saved
apply Rejects.before_step (by simpa [nextState] using hfirst)
exact ih nextState gateCount hdecode
· by_cases hend : symbol = .endMark
· subst symbol
simp [decNat] at hdecode
· exact rejects_after_cleanup_step _ _ (List.map some symbols)
certificate values scratch gateCount index saved
(input_count_bad_symbol_reject_step state symbol harg hend
(List.map some symbols) [] certificate values scratch gateCount index saved)Every continuation unary parser rejects malformed unary input.
theorem parse_nat_reject_of_decNat_none (state : State) (ret : Return)
(symbols : List CircuitSym) (certificate values scratch : List Bool)
(gateCount index saved : Nat) (hdecode : decNat symbols = none) :
Rejects (cfg (some (.parseNat ret)) state (List.map some symbols)
[] certificate values scratch gateCount index saved) := by
induction symbols generalizing state index with
| nil =>
exact rejects_after_cleanup_step _ _ [] certificate values scratch
gateCount index saved
(parse_nat_eof_reject_step state ret [] certificate values scratch
gateCount index saved)
| cons symbol symbols ih =>
by_cases harg : symbol = .argMark
· subst symbol
simp only [decNat, Option.map_eq_none_iff] at hdecode
let nextState : State := { state with inputBuffer := some (some .argMark) }
have hfirst := parse_nat_arg_step state ret (List.map some symbols)
[] certificate values scratch gateCount index saved
apply Rejects.before_step (by simpa [nextState] using hfirst)
exact ih nextState (index + 1) hdecode
· by_cases hend : symbol = .endMark
· subst symbol
simp [decNat] at hdecode
· exact rejects_after_cleanup_step _ _ (List.map some symbols)
certificate values scratch gateCount index saved
(parse_nat_bad_symbol_reject_step state ret symbol harg hend
(List.map some symbols) [] certificate values scratch
gateCount index saved)An indexed certificate lookup rejects whenever the requested position is not present.
theorem certificate_lookup_reject (state : State) (certificate : List Bool)
(index : Nat) (input : List (Option CircuitSym)) (values scratch : List Bool)
(gateCount saved : Nat) (hout : certificate.length ≤ index) :
Rejects (cfg (some .certificateLookup) state input [] certificate values scratch
gateCount index saved) := by
induction certificate generalizing state index scratch saved with
| nil =>
cases index with
| zero =>
exact rejects_after_cleanup_step _ _ input [] values scratch gateCount 0 saved
(certificate_lookup_target_underflow_step state input [] values scratch
gateCount saved)
| succ index =>
exact rejects_after_cleanup_step _ _ input [] values scratch gateCount index saved
(certificate_lookup_prefix_underflow_step state input [] values scratch
gateCount index saved)
| cons bit certificate ih =>
cases index with
| zero => simp at hout
| succ index =>
let nextState : State :=
{ state with boolBuffer := some bit, counterPresent := true }
have hfirst := certificate_lookup_prefix_step state bit input [] certificate
values scratch gateCount index saved
apply Rejects.before_step hfirst
apply ih nextState index (bit :: scratch) (saved + 1)
simpa using houtA predecessor lookup rejects whenever its source is at least the current gate count. This theorem covers both exhausting the counter too early and the exact-boundary transfer from an empty value prefix.
theorem gate_lookup_reject (state : State) (ret : Return)
(gateCount source : Nat) (input : List (Option CircuitSym))
(certificate values scratch : List Bool) (saved : Nat)
(hout : gateCount ≤ source) :
Rejects (cfg (some (.gateSubtract ret)) state input [] certificate values scratch
gateCount source saved) := by
induction gateCount generalizing state source saved with
| zero =>
cases source with
| zero =>
let nextState : State := { state with counterPresent := false }
have hfirst := gate_subtract_done_step state ret input [] certificate values
scratch 0 saved
apply Rejects.before_step hfirst
exact rejects_after_cleanup_step _ _ input certificate values scratch 0 0 saved
(gate_transfer_first_underflow_step nextState ret input [] certificate
values scratch saved)
| succ source =>
exact rejects_after_cleanup_step _ _ input certificate values scratch
0 source saved
(gate_subtract_underflow_step state ret input [] certificate values scratch
source saved)
| succ gateCount ih =>
cases source with
| zero => simp at hout
| succ source =>
let nextState : State := { state with counterPresent := true }
have hfirst := gate_subtract_step state ret input [] certificate values scratch
gateCount source saved
apply Rejects.before_step hfirst
exact ih nextState source (saved + 1) (by omega)end CLRS.Chapter34.Turing.GeneralCircuitVerifier