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