%%% Continuation-Passing Machine for Mini-ML %%% Progress theorem %%% Author: Frank Pfenning %%% Valid Machine States %%% Instructions valid : inst -> tp -> type. %name valid VL. %mode valid +I *T. % Evaluation and return vi_ev : valid (ev E) T <- of E T. vi_return : valid (return V) T <- of V T <- value V. % Natural Numbers vi_case1 : valid (case1 V1 E2 E3) T <- of V1 nat <- of E2 T <- ({x:exp} of x nat -> of (E3 x) T) <- value V1. % Pairs vi_pair1 : valid (pair1 V1 E2) (cross T1 T2) <- of V1 T1 <- of E2 T2 <- value V1. vi_fst1 : valid (fst1 V') T1 <- of V' (cross T1 T2) <- value V'. vi_snd1 : valid (snd1 V') T2 <- of V' (cross T1 T2) <- value V'. % Functions vi_app1 : valid (app1 V1 E2) T1 <- of V1 (arrow T2 T1) <- of E2 T2 <- value V1. vi_app2 : valid (app2 V1 V2) T1 <- of V1 (arrow T2 T1) <- of V2 T2 <- value V1 <- value V2. %%% Continuations validk : cont -> tp -> tp -> type. %name validk VK. %mode validk +K *T *S. vk_init : validk (init) T T. vk_; : validk (K ; I) T S <- ({x:exp} value x -> of x T -> valid (I x) T') <- validk K T' S. %%% States valids : state -> tp -> type. %name valids VS. vs_# : valids (K # I) S <- valid I T <- validk K T S. vs_answer : valids (answer V) T <- of V T <- value V. %%% Validity Preservation %{ If VL : valids S T and C : S => S' then VL' : valids S' T Proof: By cases on VL and C, using inversion on typing and value derivations. }% vps : valids S T -> S => S' -> valids S' T -> type. %mode vps +VS +C -VS'. % Natural Numbers vps_z : vps (vs_# VK (vi_ev (tp_z))) (st_z) (vs_# VK (vi_return (val_z) (tp_z))). vps_s : vps (vs_# VK (vi_ev (tp_s P))) (st_s) (vs_# (vk_; VK ([x] [w:value x] [p:of x nat] vi_return (val_s w) (tp_s p))) (vi_ev P)). vps_case : vps (vs_# VK (vi_ev (tp_case P3 P2 P1))) (st_case) (vs_# (vk_; VK ([x1] [w1:value x1] [p1:of x1 nat] vi_case1 w1 P3 P2 p1)) (vi_ev P1)). vps_case1_z : vps (vs_# VK (vi_case1 W1 P3 P2 P1)) (st_case1_z) (vs_# VK (vi_ev P2)). vps_case1_s : vps (vs_# VK (vi_case1 W1 P3 P2 (tp_s P1'))) (st_case1_s) (vs_# VK (vi_ev (P3 V1' P1'))). % Pairs vps_pair : vps (vs_# VK (vi_ev (tp_pair P2 P1))) (st_pair) (vs_# (vk_; VK ([x1] [w1:value x1] [p1:of x1 T1] vi_pair1 w1 P2 p1)) (vi_ev P1)). vps_pair1 : vps (vs_# VK (vi_pair1 W1 P2 P1)) (st_pair1) (vs_# (vk_; VK ([x2] [w2:value x2] [p2:of x2 T2] vi_return (val_pair w2 W1) (tp_pair p2 P1))) (vi_ev P2)). vps_fst : vps (vs_# VK (vi_ev (tp_fst P'))) (st_fst) (vs_# (vk_; VK ([x'] [w':value x'] [p':of x' (cross T1 T2)] vi_fst1 w' p')) (vi_ev P')). vps_fst1 : vps (vs_# VK (vi_fst1 (val_pair W2 W1) (tp_pair P2 P1))) (st_fst1) (vs_# VK (vi_return W1 P1)). vps_snd : vps (vs_# VK (vi_ev (tp_snd P'))) (st_snd) (vs_# (vk_; VK ([x'] [w':value x'] [p':of x' (cross T1 T2)] vi_snd1 w' p')) (vi_ev P')). vps_snd1 : vps (vs_# VK (vi_snd1 (val_pair W2 W1) (tp_pair P2 P1))) (st_snd1) (vs_# VK (vi_return W2 P2)). % Functions vps_lam : vps (vs_# VK (vi_ev (tp_lam P'))) (st_lam) (vs_# VK (vi_return (val_lam) (tp_lam P'))). vps_app : vps (vs_# VK (vi_ev (tp_app P2 P1))) (st_app) (vs_# (vk_; VK ([x1] [w1:value x1] [p1:of x1 (arrow T2 T1)] vi_app1 w1 P2 p1)) (vi_ev P1)). vps_app1 : vps (vs_# VK (vi_app1 W1 P2 P1)) (st_app1) (vs_# (vk_; VK ([x2] [w2:value x2] [p2:of x2 T2] vi_app2 w2 W1 p2 P1)) (vi_ev P2)). vps_app2 : vps (vs_# VK (vi_app2 W2 (val_lam) P2 (tp_lam P1'))) (st_app2) (vs_# VK (vi_ev (P1' V1 P2))). % Definitions vps_letv : vps (vs_# VK (vi_ev (tp_letv P2 P1))) (st_letv) (vs_# (vk_; VK ([x1] [w1:value x1] [p1:of x1 T1] vi_ev (P2 x1 p1))) (vi_ev P1)). vps_letn : vps (vs_# VK (vi_ev (tp_letn P2 P1))) (st_letn) (vs_# VK (vi_ev P2)). % Recursion vps_fix : vps (vs_# VK (vi_ev (tp_fix P'))) (st_fix) (vs_# VK (vi_ev (P' (fix E') (tp_fix P')))). % Return Instructions vps_return : vps (vs_# (vk_; VK C) (vi_return W P)) (st_return) (vs_# VK (C V W P)). vps_init : vps (vs_# (vk_init) (vi_return W P)) (st_init) (vs_answer W P). %terminates {} (vps VS C _). %%% Multi-Step Validity Preservation %{ If VL : valids S T and C* : S =>* S' then VL' : valids S' Proof: By induction on C*, using validity preservation. }% vps* : valids S T -> S =>* S' -> valids S' T -> type. %mode vps* +VS +C* -VS'. vps*_stop : vps* VS (stop) VS. vps*_<< : vps* VS (C2* << C1) VS2 <- vps VS C1 VS1 <- vps* VS1 C2* VS2. %terminates C* (vps* VS C* _). %%% Progress %{ If VL : valids (K # I) T then there is S' : state such that C' : (K # I) => S' and valids S' T. }% % Implemented with the same type family vps! % New mode: % %mode vps +VS -C -VS'.