This is a partial formalization of Scott J Maddox’s Untyped Concatenative Calculus.
open import Data.Product hiding (swap; _,′_) open import Data.Nat open import Function hiding (_∘′_) open import Relation.Binary open import Relation.Binary.PropositionalEquality
data Int : Set where swap : Int clone : Int drop : Int quot : Int compose : Int apply : Int infix 5 [_] infixl 7 _∘′_ infix 9 `_ data Expr : Set where `_ : Int → Expr [_] : Expr → Expr _∘′_ : Expr → Expr → Expr
data Value : Expr → Set where ⟦_⟧ : (e : Expr) → Value [ e ] infixl 4 _,′_ data Stack : Set where ⟨⟩ : Stack _,′_ : ∀ {e} → (V : Stack) → (v : Value e) → Stack
infix 3 ⟨_⟩_→⟨_⟩ data ⟨_⟩_→⟨_⟩ : Stack → Expr → Stack → Set where
i-swap : ∀ {V e e′} → (v : Value e) → (v′ : Value e′) ----------------------------------------- → ⟨ V ,′ v ,′ v′ ⟩ ` swap →⟨ V ,′ v′ ,′ v ⟩ i-clone : ∀ {V e} → (v : Value e) ----------------------------------- → ⟨ V ,′ v ⟩ ` clone →⟨ V ,′ v ,′ v ⟩ i-drop : ∀ {V e} → (v : Value e) ------------------------ → ⟨ V ,′ v ⟩ ` drop →⟨ V ⟩ i-quote : ∀ {V e} → (v : Value e) --------------------------------- → ⟨ V ,′ v ⟩ ` quot →⟨ V ,′ ⟦ e ⟧ ⟩ i-compose : ∀ {V e e′} -------------------------------------------------------- → ⟨ V ,′ ⟦ e ⟧ ,′ ⟦ e′ ⟧ ⟩ ` compose →⟨ V ,′ ⟦ e ∘′ e′ ⟧ ⟩ i-apply : ∀ {V V′ e} → ⟨ V ⟩ e →⟨ V′ ⟩ ------------------------------ → ⟨ V ,′ ⟦ e ⟧ ⟩ ` apply →⟨ V′ ⟩
e-quote : ∀ {V e} --------------------------- → ⟨ V ⟩ [ e ] →⟨ V ,′ ⟦ e ⟧ ⟩ _e-∘_ : ∀ {V V′ W e e′} → ⟨ V ⟩ e →⟨ V′ ⟩ → ⟨ V′ ⟩ e′ →⟨ W ⟩ -------------------- → ⟨ V ⟩ e ∘′ e′ →⟨ W ⟩
e-comp-assoc′ : ∀ {V W e₁ e₂ e₃} → ⟨ V ⟩ (e₁ ∘′ e₂) ∘′ e₃ →⟨ W ⟩ ↔ ⟨ V ⟩ e₁ ∘′ (e₂ ∘′ e₃) →⟨ W ⟩ e-comp-assoc′ = mk↔ {f = λ{ ((l e-∘ l₁) e-∘ r) → l e-∘ (l₁ e-∘ r) }} {f⁻¹ = λ{ (l e-∘ (r e-∘ r₁)) → (l e-∘ r) e-∘ r₁ }} ((λ{ (l e-∘ (r e-∘ r₁)) → refl }) , λ{ ((l e-∘ l₁) e-∘ r) → refl })
⊥ = [ \text{drop} ]
⊥ : Expr ⊥ = [ ` drop ] ⊥ᵥ : Value ⊥ ⊥ᵥ = ⟦ ` drop ⟧
⊤ = [ \text{swap} \ \text{drop} ]
⊤ : Expr ⊤ = [ ` swap ∘′ ` drop ] ⊤ᵥ : Value ⊤ ⊤ᵥ = ⟦ ` swap ∘′ ` drop ⟧
⊥-thm : ∀ {V e e′} → (v : Value e) → (v′ : Value e′) → ⟨ V ,′ v ,′ v′ ⟩ ⊥ ∘′ ` apply →⟨ V ,′ v ⟩ ⊥-thm {V} v v′ = e-quote e-∘ i-apply (i-drop v′) ⊤-thm : ∀ {V e e′} → (v : Value e) → (v′ : Value e′) → ⟨ V ,′ v ,′ v′ ⟩ ⊤ ∘′ ` apply →⟨ V ,′ v′ ⟩ ⊤-thm {V} {e} {e′} v v′ = e-quote e-∘ i-apply (i-swap v v′ e-∘ i-drop v)
∨ : Expr ∨ = ` clone ∘′ ` apply
∨-⊥-⊥ : ∀ {V e} → ⟨ V ,′ ⟦ e ⟧ ,′ ⊥ᵥ ⟩ ∨ →⟨ V ,′ ⟦ e ⟧ ⟩ ∨-⊥-⊥ = i-clone ⟦ ` drop ⟧ e-∘ i-apply (i-drop ⟦ ` drop ⟧) ∨-⊤ : ∀ {V e} → ⟨ V ,′ ⟦ e ⟧ ,′ ⊤ᵥ ⟩ ∨ →⟨ V ,′ ⊤ᵥ ⟩ ∨-⊤ {V} {e} = i-clone ⟦ ` swap ∘′ ` drop ⟧ e-∘ i-apply (i-swap ⟦ e ⟧ ⟦ ` swap ∘′ ` drop ⟧ e-∘ i-drop ⟦ e ⟧)
quoteₙ : ℕ → Expr quoteₙ zero = ` quot quoteₙ (suc n) = quoteₙ n ∘′ ` swap ∘′ ` quot ∘′ ` swap ∘′ ` compose
quote₂-thm : ∀ {V e e′} → (v : Value e) → (v′ : Value e′) ------------------------------------------- → ⟨ V ,′ v ,′ v′ ⟩ quoteₙ 1 →⟨ V ,′ ⟦ e ∘′ e′ ⟧ ⟩ quote₂-thm {V} {e} {e′} v v′ = (((i-quote v′ e-∘ i-swap v ⟦ e′ ⟧) e-∘ i-quote v) e-∘ i-swap ⟦ e′ ⟧ ⟦ e ⟧) e-∘ i-compose
composeₙ : ℕ → Expr composeₙ zero = ` compose composeₙ (suc n) = ` compose ∘′ composeₙ n
– TODO: Canonical forms – TODO: Progress – TODO: Preservation – TODO: Evaluation