module Lecture where

-- Prelude (ignore this) --

postulate
  Level : Set
  zero  : Level
  suc   : Level → Level

{-# BUILTIN LEVEL     Level #-}
{-# BUILTIN LEVELZERO zero  #-}
{-# BUILTIN LEVELSUC  suc   #-}

-- A datatype of equality proofs. The only way to construct an
-- equality proof is if both sides are actually the same.
data _≡_ {a}{A : Set a}(x : A) : A → Set a where
  refl : x ≡ x

{-# BUILTIN EQUALITY _≡_ #-}
{-# BUILTIN REFL refl #-}

subst : ∀ {A : Set}{P : A → Set}{x y : A} → x ≡ y → P x → P y
subst refl px = px

{-
  Formalizing Chapter 3 in the book. 
-}

-- Terms and values --

data Term : Set where
  false true : Term
  if_then_else_ : (a b c : Term) → Term

ex₁ : Term
ex₁ = if true then false else true

data Value : Set where
  false true : Value

value : Value → Term
value false = false
value true  = true

-- Single step reduction --

data _⟶_ : Term → Term → Set where
  E-IfFalse : ∀ {a b} → if false then a else b ⟶ b
  E-IfTrue  : ∀ {a b} → if true  then a else b ⟶ a
  E-If      : ∀ {a₁ a₂ b c} →
              (a₁ ⟶ a₂) →
              if a₁ then b else c ⟶ if a₂ then b else c

red-ex₁ : ex₁ ⟶ false
red-ex₁ = E-IfTrue

--   Theorem 3.5.4: Determinacy of one-step evaluation
determinacy : ∀ {a b c} → (a ⟶ b) → (a ⟶ c) → b ≡ c
determinacy E-IfFalse E-IfFalse = refl
determinacy E-IfFalse (E-If ())
determinacy E-IfTrue E-IfTrue = refl
determinacy E-IfTrue (E-If ())
determinacy (E-If ()) E-IfFalse
determinacy (E-If ()) E-IfTrue
determinacy (E-If p) (E-If q) rewrite determinacy p q = refl

-- determinacy (E-If p) (E-If q) with determinacy p q
-- determinacy (E-If p) (E-If q)    | refl = refl


-- Normal forms --

--   The empty type, logical 'false' and negation.
data ⊥ : Set where

¬_ : Set → Set
¬ A = A → ⊥

--   False implies anything.
contradiction : {A : Set} → ⊥ → A
contradiction ()

--   A normal form is a term that cannot be reduced. First we define
--   what it means that a term _can_ be reduced.
data Reduces (a : Term) : Set where
  red : ∀ b → (a ⟶ b) → Reduces a

--   Our example can be reduced.
reduces-ex₁ : Reduces ex₁
reduces-ex₁ = red false red-ex₁

--   Now we can define what it means to be a normal form.
NF : Term → Set
NF a = ¬ Reduces a

--   Theorem 3.5.7: Every value is in normal form.
val-is-nf : (v : Value) → NF (value v)
val-is-nf false (red b ())
val-is-nf true (red b ())

--   Next we'll prove that every normal form is a value

--   First we need a predicate which says when a term is a value
data IsValue : Term → Set where
  val : ∀ v → IsValue (value v)
  -- V-False : IsValue false
  -- V-True  : IsValue true

--   We need a lemma that proves that an if_then_else_ can always
--   be reduced.
if-reduce : ∀ a b c → Reduces (if a then b else c)
if-reduce false b c = red c E-IfFalse
if-reduce true  b c = red b E-IfTrue
if-reduce (if a then a₁ else a₂) b c with if-reduce a a₁ a₂
if-reduce (if a then a₁ else a₂) b c | red a′ x =
  red (if a′ then b else c) (E-If x)

--   Theorem 3.5.8: Every normal form is a value
nf-is-val : ∀ a → NF a → IsValue a
nf-is-val false nf = val false
nf-is-val true  nf = val true
nf-is-val (if a then a₁ else a₂) nf =
  contradiction (nf (if-reduce a a₁ a₂))

-- Many-step reduction --

--   A many-step reduction is just a list of single step reduction
--   chained together.
data _⟶*_ : Term → Term → Set where
  []  : ∀ {a} → a ⟶* a
  _∷_ : ∀ {a b c} → (a ⟶ b) → (b ⟶* c) → (a ⟶* c)

--   Transitivity of many-step reduction (a.k.a. list append).
_++_ : ∀ {a b c} → (a ⟶* b) → (b ⟶* c) → (a ⟶* c)
[]       ++ ys = ys
(x ∷ xs) ++ ys = x ∷ (xs ++ ys)

map : ∀ {f : Term → Term}
        (g : ∀ {a b} → (a ⟶ b) → (f a ⟶ f b)) →
        ∀ {a b} → (a ⟶* b) → (f a ⟶* f b)
map g [] = []
map g (x ∷ xs) = g x ∷ map g xs

--   We can lift the E-If rule to work on many-step reductions.
E-If* : ∀ {a₁ a₂ b c} → (a₁ ⟶* a₂) →
        (if a₁ then b else c ⟶* if a₂ then b else c)
E-If* = map E-If
-- E-If* []       = []
-- E-If* (x ∷ xs) = E-If x ∷ E-If* xs

-- Termination of many-step reduction --

--   First we define what it means to terminate.
--   Note: weak normalization.
data Terminates (a : Term) : Set where
  terminates : ∀ v → a ⟶* value v → Terminates a

term* : ∀ {a b} → a ⟶* b → Terminates b → Terminates a
term* xs (terminates v ys) = terminates v (xs ++ ys)

--   Theorem 3.5.12: Termination of evaluation
termination : ∀ a → Terminates a
termination false = terminates false []
termination true  = terminates true  []
termination (if a then b else c) with termination a
termination (if a then b else c) | terminates false xs =
  term* (E-If* xs ++ (E-IfFalse ∷ [])) (termination c)
termination (if a then b else c) | terminates true xs =
  term* (E-If* xs ++ (E-IfTrue ∷ [])) (termination b)
--   with termination a | termination b | termination c
-- termination (if a then b else c) | terminates false pa | _
--                                  | terminates v pc
--   = terminates v (map E-If pa ++ (E-IfFalse ∷ pc))
-- termination (if a then b else c) | terminates true pa
--                                  | terminates v pb | tc
--   = terminates v (map E-If pa ++ (E-IfTrue ∷ pb))


-- Strong termination, which we talked about but didn't
-- do in the lecture. 
data StronglyTerminates : Term → Set where
                -- a is strongly terminating if _any_ step you can take
                -- from a lands you in a strongly terminating term
  strong-step : ∀ {a} → (∀ b → (a ⟶ b) → StronglyTerminates b) →
                StronglyTerminates a
  -- Why no base case? strong-step turns into a base case if a is a normal
  -- form, since in that case there will be no b with a ⟶ b.

-- We can prove strong termination from weak termination by appealing to
-- determinacy. Basically: there is only one possible reduction sequence
-- for each term so there's no difference in saying that some sequence should
-- terminate and saying that all sequences should terminate.

-- Lemma: values are strongly terminating.
strong-val : (v : Value) → StronglyTerminates (value v)
strong-val v = strong-step λ b r → contradiction (val-is-nf v (red b r))
-- strong-val false = strong-step λ b ()
-- strong-val true  = strong-step λ b ()

-- Determinacy guarantees that any step we might want to take will match that
-- of the weak termination proof.
weak⇒strong : ∀ {a} → Terminates a → StronglyTerminates a
weak⇒strong (terminates v [])       = strong-val v
weak⇒strong (terminates v (x ∷ xs)) =
  strong-step (λ b y → subst (determinacy x y)
                              (weak⇒strong (terminates v xs)))

strong-termination : ∀ a → StronglyTerminates a
strong-termination a = weak⇒strong (termination a)