From 69ecaeb7b8d128e6690a30d72382ec0acf796c67 Mon Sep 17 00:00:00 2001
From: Michael Zhang <mail@mzhang.io>
Date: Wed, 8 Dec 2021 20:57:30 -0600
Subject: [PATCH] compile?

---
 src/Project/Cesk.agda        | 12 +++++++++---
 src/Project/Definitions.agda |  7 ++++---
 src/Project/Do.agda          | 21 +++++++++++++++++----
 3 files changed, 30 insertions(+), 10 deletions(-)

diff --git a/src/Project/Cesk.agda b/src/Project/Cesk.agda
index d0d9e16..8f89707 100644
--- a/src/Project/Cesk.agda
+++ b/src/Project/Cesk.agda
@@ -35,6 +35,12 @@ step (mkState Tc Γ (C₁ · C₂) E (kont k)) =
   do-apply-kont C₁′ C₂′ k
 step (mkState Tc Γ (atomic x) E halt) = done $ astep x E
 step (mkState Tc Γ (atomic x) E (kont k)) = part $ do-kont k $ astep x E
-step (mkState .((_ ⇒ _) ⇒ _) Γ (call/cc C) E K) =
-  let C′ = C · {!   !} in
-  {!   !}
+
+step (mkState Tc Γ (call/cc C) E halt) =
+  let proc = astep C E in
+  let value = kont halt in
+  do-apply-halt {!   !} value
+step (mkState Tc Γ (call/cc C) E (kont k)) =
+  let proc = astep C E in
+  let value = kont (kont k) in
+  do-apply-kont {!   !} value k
diff --git a/src/Project/Definitions.agda b/src/Project/Definitions.agda
index 6d02800..0e5fd77 100644
--- a/src/Project/Definitions.agda
+++ b/src/Project/Definitions.agda
@@ -12,7 +12,7 @@ infixr 7 _⇒_
 
 data Type : Set where
   _⇒_ : Type → Type → Type
-  -- _k⇒_ : Type → Type → Type
+  _k⇒_ : Type → Type → Type
   `ℕ : Type
 
 data Context : Set where
@@ -58,7 +58,7 @@ data Exp Γ where
   -- _∘_ : ∀ {A B} → Aexp Γ (A k⇒ B) → Exp Γ B
 
   -- Call/cc
-  call/cc : ∀ {Ki Ko R} → Aexp (Γ , Ki) ((Ki ⇒ Ko) ⇒ R) → Exp Γ ((Ki ⇒ Ko) ⇒ R)
+  call/cc : ∀ {A B Tω} → Aexp Γ (A ⇒ Tω) → Exp Γ (A ⇒ B)
 
 data Kont (Tω : Type) : Type → Set
 
@@ -71,7 +71,8 @@ data Value where
   clo : ∀ {Γ} {A B : Type} → Exp (Γ , A) B → Env Γ → Value (A ⇒ B)
 
   -- Call/CC
-  kont : ∀ {Tω Ki Ko} → Kont Tω (Ki ⇒ Ko) → Value ((Ki ⇒ Ko) ⇒ Tω)
+  -- kont : ∀ {Tω Ki Ko} → Kont Tω (Ki ⇒ Ko) → Value ((Ki ⇒ Ko) k⇒ Tω)
+  kont : ∀ {A Tω} → Kont Tω A → Value (A ⇒ Tω)
 
 record Letk (Tv Tω : Type) : Set
 
diff --git a/src/Project/Do.agda b/src/Project/Do.agda
index 157ce38..57f22c8 100644
--- a/src/Project/Do.agda
+++ b/src/Project/Do.agda
@@ -1,4 +1,4 @@
-{-# OPTIONS --allow-unsolved-metas #-}
+-- {-# OPTIONS --allow-unsolved-metas #-}
 
 module Project.Do where
 
@@ -16,12 +16,25 @@ do-kont {Tv} {Tω} (letk {Tc} Γ C E k) v =
   let E′ = E [ Tv ∶ v ] in
   mkState Tc Γ′ C E′ k
 
+applykont : ∀ {Tv Tω} → Letk Tv Tω → Value Tv → StepResult Tω
+applykont {Tv} (letk {Tc} Γ C E K) v =
+  part $ mkState Tc (Γ , Tv) C (E [ Tv ∶ v ]) K
+
+chain-kont : ∀ {A B C} → Letk A B → Letk B C → Letk A C
+chain-kont (letk Γ C E halt) b = letk Γ C E $ kont b
+chain-kont (letk Γ C E (kont k)) b = letk Γ C E $ kont $ chain-kont k b
+
 do-apply-kont : ∀ {A B Tω} → Value (A ⇒ B) → Value A → Letk B Tω → StepResult Tω
 do-apply-kont (clo {Γ} {A} {B} body e) v k =
   let Γ′ = Γ , A in
   let E′ = e [ A ∶ v ] in
   part $ mkState B Γ′ body E′ (kont k)
-do-apply-kont (kont x) b k = part $ do-kont k {!   !}
+do-apply-kont (kont halt) a k = part $ do-kont k a
+do-apply-kont {A} {B} {Tω} (kont (kont x)) a k = 
+  let k′ = chain-kont x k in
+  part $ do-kont k′ a
+-- do-apply-kont (kont halt) b (letk Γ C E K) = {! done b  !}
+-- do-apply-kont (kont (kont x)) b (letk Γ C E K) = {!   !}
 
 -- This needs to be a separate function in order to unify B with Tω
 do-apply-halt : ∀ {A Tω} → Value (A ⇒ Tω) → Value A → StepResult Tω
@@ -29,5 +42,5 @@ do-apply-halt {A} {Tω} (clo {Γ} body e) v =
   let Γ′ = Γ , A in
   let E′ = e [ A ∶ v ] in
   part $ mkState Tω Γ′ body E′ halt
-do-apply-halt (kont halt) b = done b
-do-apply-halt (kont (kont x)) b = part $ do-kont x b
\ No newline at end of file
+do-apply-halt (kont halt) a = done a
+do-apply-halt (kont (kont k)) a = part $ do-kont k a
\ No newline at end of file