File size: 5,942 Bytes
80d7559 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 | -- CarryQuantum.QuantumSpec
-- Agda dependent-type specification.
-- Illegal FSM transitions are unrepresentable at the type level.
-- Compile: agda QuantumSpec.agda
module QuantumSpec where
open import Data.Nat using (β; _<_; suc; zero; _+_)
open import Data.Bool using (Bool; true; false)
open import Data.Product using (_Γ_; _,_; β)
open import Data.Sum using (_β_; injβ; injβ)
open import Relation.Binary.PropositionalEquality using (_β‘_; refl)
open import Data.Empty using (β₯; β₯-elim)
-- ============================================================
-- FSM States
-- ============================================================
data FSMState : Set where
Init : FSMState
Prepare : FSMState
Entangle : FSMState
Compute : FSMState
Measure : FSMState
Verify : FSMState
Commit : FSMState
Halted : FSMState
CycleLimit : FSMState
-- ============================================================
-- Allowed Transition β encoded as a type index.
-- A value of type `Transition s s'` is a proof that the edge exists.
-- An illegal (s, s') pair has no constructor β it is unrepresentable.
-- ============================================================
data Transition : FSMState β FSMState β Set where
T-Init-Prepare : Transition Init Prepare
T-Prep-Entangle : Transition Prepare Entangle
T-Ent-Compute : Transition Entangle Compute
T-Comp-Measure : Transition Compute Measure
T-Meas-Verify : Transition Measure Verify
T-Veri-Commit : Transition Verify Commit
T-Comm-Prepare : Transition Commit Prepare -- loop back
T-Comm-Commit : Transition Commit Commit -- terminal commit
T-Any-Halted : β {s} β Transition s Halted -- emergency halt
-- ============================================================
-- Terminal states
-- ============================================================
data Terminal : FSMState β Set where
T-Halted : Terminal Halted
T-Cycle : Terminal CycleLimit
-- INV-5 by construction:
-- There is no constructor of type `Transition Halted s'` for s' β Halted.
-- Proof: inspect every constructor β T-Any-Halted is the only one where
-- Halted appears, and it appears on the RIGHT. So Halted as a source
-- produces no constructors at all (except via T-Any-Halted arriving at Halted).
-- The type Transition Halted (non-Halted) is uninhabited.
-- We can prove this:
halted-absorbing : β {s'} β Transition Halted s' β s' β‘ Halted
halted-absorbing T-Any-Halted = refl
-- No other constructor has Halted as its first argument β proof is total.
cyclelimit-absorbing : β {s'} β Transition CycleLimit s' β s' β‘ Halted
cyclelimit-absorbing T-Any-Halted = refl
-- ============================================================
-- FSM record with cycle budget
-- ============================================================
record FSM : Set where
field
state : FSMState
cycle : β
maxCycle : β
bounded : cycle < suc maxCycle -- cycle β€ maxCycle
-- ============================================================
-- Step function β INV-4 guaranteed by type signature.
-- `step` only accepts a `Transition (fsm .state) s'` witness.
-- If you cannot construct that witness, you cannot call step.
-- ============================================================
data StepResult : Set where
Ok : FSM β StepResult
Err : StepResult
step : (fsm : FSM) β (s' : FSMState) β Transition (FSM.state fsm) s' β StepResult
step fsm s' t with FSM.cycle fsm < FSM.maxCycle
... | false = Ok (record fsm { state = CycleLimit })
... | true = Ok (record fsm
{ state = s'
; cycle = suc (FSM.cycle fsm)
; bounded = {!!} -- obligation: suc cycle β€ suc maxCycle
})
-- step never returns Err for allowed transitions β that is the type guarantee.
-- For terminal states the caller cannot construct a Transition witness at all,
-- so they cannot call step. No runtime check needed.
-- ============================================================
-- Normalisation
-- ============================================================
postulate
Amp : Set
normSq : Amp β β -- simplified; use rationals or reals in full version
-- A statevector of dimension 2^n
StateVec : β β Set
StateVec n = (i : β) β Amp -- domain is Fin(2^n) in a full version
postulate
sumNormSq : β {n} β StateVec n β β
-- DEF-1: Normalised
Normalised : β {n} β StateVec n β Set
Normalised {n} Ο = sumNormSq Ο β‘ 1
-- DEF-2: Unitary (norm-preserving)
IsUnitary : β {n} β (StateVec n β StateVec n) β Set
IsUnitary {n} U = β Ο β Normalised Ο β Normalised (U Ο)
-- INV-1: Unitary gates preserve normalisation β direct from the definition
inv1 : β {n} (Ο : StateVec n) (U : StateVec n β StateVec n)
β IsUnitary U β Normalised Ο β Normalised (U Ο)
inv1 Ο U hU hN = hU Ο hN
-- ============================================================
-- Agent ownership
-- ============================================================
postulate
QubitSet : Set
β
: QubitSet
_β©_ : QubitSet β QubitSet β QubitSet
emptyInter : β (a b : QubitSet) β Set -- a β© b β‘ β
-- DEF-7: Disjoint ownership
OwnershipDisjoint : QubitSet β QubitSet β Set
OwnershipDisjoint a b = emptyInter a b
-- INV-7: If ownership is disjoint, agent A's qubits are not in agent B's set
postulate
inv7 : β (a b : QubitSet) β OwnershipDisjoint a b
β β q β q β a β q β b -- β/β defined over QubitSet
where
postulate
_β_ : β β QubitSet β Set
_β_ : β β QubitSet β Set
|