% Tethered sequent calculus for JS4 % Proves identity and cut % William Lovas, Frank Pfenning, Jason Reed % February 2010 atom : type. %name atom P. prop : type. %name prop A. ? : atom -> prop. %prefix 25 ?. ⊃ : prop -> prop -> prop. %infix right 10 ⊃. ∨ : prop -> prop -> prop. %infix none 15 ∨. ⊥ : prop. □ : prop -> prop. %prefix 20 □. ◇ : prop -> prop. %prefix 20 ◇. world : type. %name world W α. ε : world. succedent : type. %name succedent J. right : prop -> succedent. %postfix 7 right. poss : prop -> succedent. %postfix 7 poss. at : succedent -> world -> type. %infix none 5 at. left : prop -> world -> type. %infix none 5 left. valid : prop -> type. %postfix 7 valid. %name at D. %name left X x. %name valid U u. % judgmental rules init : (? P) left W -> (? P) right at W. copy : (A left W -> J at W) -> (A valid -> J at W). here : A right at W -> A poss at W. % A ⊃ B ⊃R : (A left W -> B right at W) -> A ⊃ B right at W. ⊃L : A right at W -> (B left W -> J at W) -> (A ⊃ B left W -> J at W). % A ∨ B ∨R1 : A right at W -> A ∨ B right at W. ∨R2 : B right at W -> A ∨ B right at W. ∨L : (A left W -> J at W) -> (B left W -> J at W) -> (A ∨ B left W -> J at W). % ⊥ % no ⊥R ⊥L : ⊥ left W -> J at W. % □ A □R : ({α} A right at α) -> □ A right at W. □L : (A valid -> J at W) -> (□ A left W -> J at W). % ◇ A ◇R : A poss at W -> ◇ A right at W. ◇L : ({α} A left α -> C poss at α) -> (◇ A left W -> C poss at W). % for termination order weight : type. wtrue : weight. wvalid : weight. wposs : weight. meas : weight -> type. tr : meas wtrue. vl : meas wtrue -> meas wvalid. po : meas wtrue -> meas wposs. % cut admissibility cut : {A:prop} meas wtrue -> A right at W -> (A left W -> J at W') -> J at W' -> type. cut□ : {A:prop} meas wvalid -> ({α} A right at α) -> (A valid -> J at W') -> J at W' -> type. cut◇ : {A:prop} meas wposs -> A poss at W -> ({α} A left α -> C poss at α) -> C poss at W -> type. %mode cut +A +M +D +E -F. %mode cut□ +A +M +D +E -F. %mode cut◇ +A +M +D +E -F. % initial cuts cut/init/- : cut (? P) tr (init X) ([x] E x) (E X). cut/-/init : cut (? P) tr D ([x] init x) D. % judgmental transitions cut□/-/copy : cut□ A (vl tr) ([α] D α) ([u] copy ([x] E2 u x) u) F <- ({x} cut□ A (vl tr) ([α] D α) ([u] E2 u x) (E2' x)) <- cut A tr (D W) ([x] E2' x) F. cut◇/here/- : cut◇ A (po tr) (here D1) ([α][x] E α x) F <- cut A tr D1 ([x] E W x) F. % principal cuts cut/⊃R/⊃L : cut (A1 ⊃ A2) tr (⊃R [x1] D2 x1) ([x] ⊃L (E1 x) ([x2] E2 x x2) x) F <- cut (A1 ⊃ A2) tr (⊃R [x1] D2 x1) ([x] E1 x) E1' <- ({x2} cut (A1 ⊃ A2) tr (⊃R [x1] D2 x1) ([x] E2 x x2) (E2' x2)) <- cut A1 tr E1' ([x1] D2 x1) F2 <- cut A2 tr F2 ([x2] E2' x2) F. % no cut/⊥R/⊥L cut/∨R1/∨L : cut (A1 ∨ A2) tr (∨R1 D1) ([x] ∨L ([x1] E1 x x1) ([x2] E2 x x2) x) F <- ({x1} cut (A1 ∨ A2) tr (∨R1 D1) ([x] E1 x x1) (E1' x1)) <- cut A1 tr D1 ([x1] E1' x1) F. cut/∨R2/∨L : cut (A1 ∨ A2) tr (∨R2 D2) ([x] ∨L ([x1] E1 x x1) ([x2] E2 x x2) x) F <- ({x2} cut (A1 ∨ A2) tr (∨R2 D2) ([x] E2 x x2) (E2' x2)) <- cut A2 tr D2 ([x2] E2' x2) F. cut/□R/□L : cut (□ A1) tr (□R [α] D1 α) ([x] □L ([u1] E2 x u1) x) F <- ({u1} cut (□ A1) tr (□R [α] D1 α) ([x] E2 x u1) (E2' u1)) <- cut□ A1 (vl tr) ([α] D1 α) ([u1] E2' u1) F. cut/◇R/◇L : cut (◇ A1) tr (◇R D1) ([x] ◇L ([α] [x1] E2 x α x1) x) F <- ({α}{x1} cut (◇ A1) tr (◇R D1) ([x] E2 x α x1) (E2' α x1)) <- cut◇ A1 (po tr) D1 ([α] [x1] E2' α x1) F. % commuting cut up the right side cut/-/init : cut A tr D ([x] init Z) (init Z). cut/-/copy : cut A tr D ([x] copy ([y] E2 x y) U) (copy ([y] E2' y) U) <- ({y} cut A tr D ([x] E2 x y) (E2' y)). cut/-/here : cut A tr D ([x] here (E2 x)) (here E2') <- cut A tr D ([x] E2 x) E2'. cut/-/⊃R : cut A tr D ([x] ⊃R ([y] E2 x y)) (⊃R [y] E2' y) <- ({y} cut A tr D ([x] E2 x y) (E2' y)). cut/-/⊃L : cut A tr D ([x] ⊃L (E1 x) ([y] E2 x y) Z) (⊃L E1' ([y] E2' y) Z) <- cut A tr D ([x] E1 x) E1' <- ({y} cut A tr D ([x] E2 x y) (E2' y)). cut/-/∨R1 : cut A tr D ([x] ∨R1 (E1 x)) (∨R1 E1') <- cut A tr D ([x] E1 x) E1'. cut/-/∨R2 : cut A tr D ([x] ∨R2 (E2 x)) (∨R2 E2') <- cut A tr D ([x] E2 x) E2'. cut/-/∨L : cut A tr D ([x] ∨L ([x1] E1 x x1) ([x2] E2 x x2) Z) (∨L ([x1] E1' x1) ([x2] E2' x2) Z) <- ({x1} cut A tr D ([x] E1 x x1) (E1' x1)) <- ({x2} cut A tr D ([x] E2 x x2) (E2' x2)). % no cut/-/⊥R cut/-/⊥L : cut A tr D ([x] ⊥L Z) (⊥L Z). cut/-/□R : cut A tr D ([x] □R ([α] E1 x α)) (□R ([α] E1' α)) <- ({α} cut A tr D ([x] E1 x α) (E1' α)). cut/-/□L : cut A tr D ([x] □L ([u] E1 x u) Z) (□L ([u] E1' u) Z) <- ({u} cut A tr D ([x] E1 x u) (E1' u)). cut/-/◇R : cut A tr D ([x] ◇R (E1 x)) (◇R E1') <- cut A tr D ([x] E1 x) E1'. cut/-/◇L : cut A tr D ([x] ◇L ([β][y] E1 x β y) Z) (◇L ([β][y] E1' β y) Z) <- ({β}{y} cut A tr D ([x] E1 x β y) (E1' β y)). % commuting cut up the left side % cut/init/- (see above) cut/copy/- : cut A tr (copy ([y] D1 y) Z) ([x] E x) (copy ([y] D1' y) Z) <- ({y} cut A tr (D1 y) ([x] E x) (D1' y)). % cut/here/- (see cut◇/here/-) % cut/⊃R/- (no commuting cases) cut/⊃L/- : cut A tr (⊃L D1 ([y] D2 y) Z) ([x] E x) (⊃L D1 ([y] D2' y) Z) <- ({y} cut A tr (D2 y) ([x] E x) (D2' y)). % cut/∨R1/- (no commuting cases) % cut/∨R2/- (no commuting cases) cut/∨L/- : cut A tr (∨L ([y1] D1 y1) ([y2] D2 y2) Z) ([x] E x) (∨L ([y1] D1' y1) ([y2] D2' y2) Z) <- ({y1} cut A tr (D1 y1) ([x] E x) (D1' y1)) <- ({y2} cut A tr (D2 y2) ([x] E x) (D2' y2)). % no cut/⊥R/- cut/⊥L/- : cut A tr (⊥L Z) ([x] E x) (⊥L Z). % cut/□R/- (no commuting cases) cut/□L/- : cut A tr (□L ([u] D1 u) Z) ([x] E x) (□L ([u] D1' u) Z) <- ({u} cut A tr (D1 u) ([x] E x) (D1' u)). % cut/◇R/- (no commuting cases) % cut/◇L/- (see cut◇/◇L/-) % commuting cut□ up the right side cut□/-/init : cut□ A (vl tr) ([α] D α) ([u] init Y) (init Y). cut□/-/copy : cut□ A (vl tr) ([α] D α) ([u] copy ([y] E u y) V) (copy ([y] E' y) V) <- ({y} cut□ A (vl tr) ([α] D α) ([u] E u y) (E' y)). cut□/-/here : cut□ A (vl tr) ([α] D α) ([u] here (E u)) (here E') <- cut□ A (vl tr) ([α] D α) ([u] E u) E'. cut□/-/⊃R : cut□ A (vl tr) ([α] D α) ([u] ⊃R ([y] E1 u y)) (⊃R ([y] E1' y)) <- ({y} cut□ A (vl tr) ([α] D α) ([u] E1 u y) (E1' y)). cut□/-/⊃L : cut□ A (vl tr) ([α] D α) ([u] ⊃L (E1 u) ([y] E2 u y) Z) (⊃L E1' ([y] E2' y) Z) <- cut□ A (vl tr) ([α] D α) ([u] E1 u) E1' <- ({y} cut□ A (vl tr) ([α] D α) ([u] E2 u y) (E2' y)). cut□/-/∨R1 : cut□ A (vl tr) ([α] D α) ([u] ∨R1 (E1 u)) (∨R1 E1') <- cut□ A (vl tr) ([α] D α) ([u] E1 u) E1'. cut□/-/∨R2 : cut□ A (vl tr) ([α] D α) ([u] ∨R2 (E2 u)) (∨R2 E2') <- cut□ A (vl tr) ([α] D α) ([u] E2 u) E2'. cut□/-/∨L : cut□ A (vl tr) ([α] D α) ([u] ∨L ([y1] E1 u y1) ([y2] E2 u y2) Z) (∨L ([y1] E1' y1) ([y2] E2' y2) Z) <- ({y1} cut□ A (vl tr) ([α] D α) ([u] E1 u y1) (E1' y1)) <- ({y2} cut□ A (vl tr) ([α] D α) ([u] E2 u y2) (E2' y2)). % not cut□/-/⊥R cut□/-/⊥L : cut□ A (vl tr) ([α] D α) ([u] ⊥L Z) (⊥L Z). cut□/-/□R : cut□ A (vl tr) ([α] D α) ([u] □R ([β] E1 u β)) (□R ([β] E1' β)) <- ({β} cut□ A (vl tr) ([α] D α) ([u] E1 u β) (E1' β)). cut□/-/□R : cut□ A (vl tr) ([α] D α) ([u] □L ([v] E1 u v) Z) (□L ([v] E1' v) Z) <- ({v} cut□ A (vl tr) ([α] D α) ([u] E1 u v) (E1' v)). cut□/-/◇R : cut□ A (vl tr) ([α] D α) ([u] ◇R (E1 u)) (◇R E1') <- cut□ A (vl tr) ([α] D α) ([u] E1 u) E1'. cut□/-/◇L : cut□ A (vl tr) ([α] D α) ([u] ◇L ([β][y] E1 u β y) Z) (◇L ([β][y] E1' β y) Z) <- ({β} {y} cut□ A (vl tr) ([α] D α) ([u] E1 u β y) (E1' β y)). % commuting cut◇ up the left side % cut◇/init/- (no commuting cases) cut◇/copy/- : cut◇ A (po tr) (copy ([y] D1 y) U) ([α][x] E α x) (copy ([y] D1' y) U) <- ({y} cut◇ A (po tr) (D1 y) ([α][x] E α x) (D1' y)). % cut◇/here/- (see above) % cut◇/⊃R/- (no commuting cases) cut◇/⊃L/- : cut◇ A (po tr) (⊃L D1 ([y] D2 y) Z) ([α][x] E α x) (⊃L D1 ([y] D2' y) Z) <- ({y} cut◇ A (po tr) (D2 y) ([α][x] E α x) (D2' y)). % cut◇/∨R1/- (no commuting cases) % cut◇/∨R2/- (no commuting cases) cut◇/∨L/- : cut◇ A (po tr) (∨L ([y1] D1 y1) ([y2] D2 y2) Z) ([α][x] E α x) (∨L ([y1] D1' y1) ([y2] D2' y2) Z) <- ({y1} cut◇ A (po tr) (D1 y1) ([α][x] E α x) (D1' y1)) <- ({y2} cut◇ A (po tr) (D2 y2) ([α][x] E α x) (D2' y2)). % no cut◇/⊥R/- cut◇/⊥L/- : cut◇ A (po tr) (⊥L Z) ([α][x] E α x) (⊥L Z). % cut◇/□R/- (no commuting cases) cut◇/□L/- : cut◇ A (po tr) (□L ([v] D1 v) Z) ([α][x] E α x) (□L ([v] D1' v) Z) <- ({v} cut◇ A (po tr) (D1 v) ([α][x] E α x) (D1' v)). % cut◇/◇R/- (no commuting cases) cut◇/◇L/- : cut◇ A (po tr) (◇L ([β][y] D1 β y) Z) ([α][x] E α x) (◇L ([β][y] D1' β y) Z) <- ({β}{y} cut◇ A (po tr) (D1 β y) ([α][x] E α x) (D1' β y)). % identity id : {A:prop} {W:world} (A left W -> A right at W) -> type. %mode id +A +W -D. id/? : id (? P) W ([x] init x). id/⊃ : id (A1 ⊃ A2) W ([x] ⊃R ([x1] ⊃L (D1 x1) ([x2] D2 x2) x)) <- id A1 W ([x1] D1 x1) <- id A2 W ([x2] D2 x2). id/∨ : id (A1 ∨ A2) W ([x] ∨L ([x1] ∨R1 (D1 x1)) ([x2] ∨R2 (D2 x2)) x) <- id A1 W ([x1] D1 x1) <- id A2 W ([x2] D2 x2). id/⊥ : id ⊥ W ([x] ⊥L x). id/□ : id (□ A1) W ([x] □L ([u] □R ([α] copy ([x1] D1 α x1) u)) x) <- ({α} id A1 α ([x1] D1 α x1)). id/◇ : id (◇ A1) W ([x] ◇R (◇L ([α][x1] here (D1 α x1)) x)) <- ({α} id A1 α ([x1] D1 α x1)). %block b_atom : block {p:atom}. %block b_world : block {α:world}. %block b_left : some {A:prop} {W:world} block {x:A left W}. %block b_valid : some {A:prop} block {u:A valid}. %worlds (b_atom | b_world) (id A W D). %terminates A (id A W D). %total A (id A W D). %worlds (b_atom | b_world | b_left | b_valid) (cut A1 M1 D1 E1 F1) (cut□ A2 M2 D2 E2 F2) (cut◇ A3 M3 D3 E3 F3). %terminates {(A1 A2 A3) (M1 M2 M3) [(D1 D2 D3) (E1 E2 E3)]} (cut A1 M1 D1 E1 F1) (cut□ A2 M2 D2 E2 F2) (cut◇ A3 M3 D3 E3 F3). %total {(A1 A2 A3) (M1 M2 M3) [(D1 D2 D3) (E1 E2 E3)]} (cut A1 M1 D1 E1 F1) (cut□ A2 M2 D2 E2 F2) (cut◇ A3 M3 D3 E3 F3). % examples _ : □ ? P ⊃ ? P right at ε = ⊃R ([x] □L ([u] copy ([y] init y) u) x). _ : □ (? P) ⊃ □ □ ? P right at ε = ⊃R ([x] □L ([u] □R [α] □R [β] copy ([y] init y) u) x). _ : □ (? P ⊃ ? Q) ⊃ (□ ? P ⊃ □ ? Q) right at ε = ⊃R ([x] ⊃R ([y] □L ([u] □L ([v] □R ([α] copy ([x'] copy ([y'] ⊃L (init y') ([z] init z) x') v) u)) y) x)). _ : ? P ⊃ ◇ ? P right at ε = ⊃R ([x] ◇R (here (init x))). _ : ◇ ◇ ? P ⊃ ◇ ? P right at ε = ⊃R ([x] ◇R (◇L ([α] [y] ◇L ([β] [z] here (init z)) y) x)). _ : □ (? P ⊃ ? Q) ⊃ (◇ ? P ⊃ ◇ ? Q) right at ε = ⊃R ([x] ⊃R ([y] ◇R (□L ([u] ◇L ([α] [v] copy ([x'] ⊃L (init v) ([y'] here (init y')) x') u) y) x))). % counterexamples % system is consistent; this works void : type. %name void V. noLeft : A left W -> void -> type. %mode noLeft +D -V. % no cases %worlds (b_atom | b_world) (noLeft X V). %total [] (noLeft X V). no⊥ : ⊥ right at W -> void -> type. %mode no⊥ +D -V. % one case, so Twelf will split (on D) - : no⊥ (⊥L X) V <- noLeft X V. %worlds (b_atom) (no⊥ D V). %total [] (no⊥ D V). %{ % A does not entail □ A; this does not work no1 : (? P left W -> {α} A right at α) -> void -> type. - : no1 ([x] [α] ⊥L (Y α)) V <- ({α} noLeft (Y α) V). %mode no1 +D -V. %worlds (b_atom | b_world) (no1 D V). %total [] (no1 D V). no_p->□p : (? P left W -> □ ? P right at W) -> void -> type. - : no_p->□p ([x] □R ([α] D α x)) V %mode no_p->□p +D -V. %worlds (b_atom) (no_p->□p D V). %total [] (no_p->□p D V). }%