Reindent, add line breaks

Reindent, add line breaks

import Parametric.Syntax.Type as Type
import Parametric.Syntax.Term as Term
import Parametric.Syntax.MType as MType

module Parametric.Syntax.MTerm
    {Base : Type.Structure}
    (Const : Term.Structure Base)
  where

open Type.Structure Base
open MType.Structure Base
open Term.Structure Base Const

-- Our extension points are sets of primitives, indexed by the
-- types of their arguments and their return type.

-- We want different types of constants; some produce values, some produce
-- computations. In all cases, arguments are assumed to be values (though
-- individual primitives might require thunks).

ValConstStructure : Set₁
ValConstStructure = ValContext → ValType → Set

CompConstStructure : Set₁
CompConstStructure = ValContext → CompType → Set

module Structure (ValConst : ValConstStructure) (CompConst : CompConstStructure) where
  mutual
    -- Analogues of Terms
    Vals : ValContext → ValContext → Set
    Vals Γ = DependentList (Val Γ)

    Comps : ValContext → List CompType → Set
    Comps Γ = DependentList (Comp Γ)

    data Val Γ : (τ : ValType) → Set where
      vVar : ∀ {τ} (x : ValVar Γ τ) → Val Γ τ
      -- XXX Do we need thunks? The draft in the paper doesn't have them.
      -- However, they will start being useful if we deal with CBN source
      -- languages.
      vThunk : ∀ {τ} → Comp Γ τ → Val Γ (U τ)
      vConst : ∀ {Σ τ} →
        (c : ValConst Σ τ) →
        (args : Vals Γ Σ) →
        Val Γ τ

    data Comp Γ : (τ : CompType) → Set where
      cConst : ∀ {Σ τ} →
        (c : CompConst Σ τ) →
        (args : Vals Γ Σ) →
        Comp Γ τ

      cForce : ∀ {τ} → Val Γ (U τ) → Comp Γ τ
      cReturn : ∀ {τ} (v : Val Γ τ) → Comp Γ (F τ)
      {-
      -- Originally, M to x in N. But here we have no names!
      _into_ : ∀ {σ τ} →
        (e₁ : Comp Γ (F σ)) →
        (e₂ : Comp (σ •• Γ) τ) →
        Comp Γ τ
      -}
      -- The following constructor is the main difference between CBPV and this
      -- monadic calculus. This is better for the caching transformation.
      _into_ : ∀ {σ τ} →
        (e₁ : Comp Γ (F σ)) →
        (e₂ : Comp (σ •• Γ) (F τ)) →
        Comp Γ (F τ)
      cAbs : ∀ {σ τ} →
        (t : Comp (σ •• Γ) τ) →
        Comp Γ (σ ⇛ τ)
      cApp : ∀ {σ τ} →
        (s : Comp Γ (σ ⇛ τ)) →
        (t : Val Γ σ) →
        Comp Γ τ

  weaken-val : ∀ {Γ₁ Γ₂ τ} →
    (Γ₁≼Γ₂ : Γ₁ ≼≼ Γ₂) →
    Val Γ₁ τ →
    Val Γ₂ τ

  weaken-comp : ∀ {Γ₁ Γ₂ τ} →
    (Γ₁≼Γ₂ : Γ₁ ≼≼ Γ₂) →
    Comp Γ₁ τ →
    Comp Γ₂ τ

  weaken-vals : ∀ {Γ₁ Γ₂ Σ} →
    (Γ₁≼Γ₂ : Γ₁ ≼≼ Γ₂) →
    Vals Γ₁ Σ →
    Vals Γ₂ Σ

  weaken-val Γ₁≼Γ₂ (vVar x) = vVar (weaken-val-var Γ₁≼Γ₂ x)
  weaken-val Γ₁≼Γ₂ (vThunk x) = vThunk (weaken-comp Γ₁≼Γ₂ x)
  weaken-val Γ₁≼Γ₂ (vConst c args) = vConst c (weaken-vals Γ₁≼Γ₂ args)
  weaken-comp Γ₁≼Γ₂ (cConst c args) = cConst c (weaken-vals Γ₁≼Γ₂ args)
  weaken-comp Γ₁≼Γ₂ (cForce x) = cForce (weaken-val Γ₁≼Γ₂ x)
  weaken-comp Γ₁≼Γ₂ (cReturn v) = cReturn (weaken-val Γ₁≼Γ₂ v)
  weaken-comp Γ₁≼Γ₂ (_into_ {σ} c c₁) = (weaken-comp Γ₁≼Γ₂ c) into (weaken-comp (keep σ •• Γ₁≼Γ₂) c₁)
  weaken-comp Γ₁≼Γ₂ (cAbs {σ} c) = cAbs (weaken-comp (keep σ •• Γ₁≼Γ₂) c)
  weaken-comp Γ₁≼Γ₂ (cApp s t) = cApp (weaken-comp Γ₁≼Γ₂ s) (weaken-val Γ₁≼Γ₂ t)

  weaken-vals Γ₁≼Γ₂ ∅ = ∅
  weaken-vals Γ₁≼Γ₂ (px • ts) = (weaken-val Γ₁≼Γ₂ px) • (weaken-vals Γ₁≼Γ₂ ts)

  fromCBN : ∀ {Γ τ} (t : Term Γ τ) → Comp (fromCBNCtx Γ) (cbnToCompType τ)

  fromCBNTerms : ∀ {Γ Σ} → Terms Γ Σ → Vals (fromCBNCtx Γ) (fromCBNCtx Σ)
  fromCBNTerms ∅ = ∅
  fromCBNTerms (px • ts) = vThunk (fromCBN px) • fromCBNTerms ts

  open import UNDEFINED
  -- This is really supposed to be part of the plugin interface.
  cbnToCompConst : ∀ {Σ τ} → Const Σ τ → CompConst (fromCBNCtx Σ) (cbnToCompType τ)
  cbnToCompConst = reveal UNDEFINED

  fromCBN (const c args) = cConst (cbnToCompConst c) (fromCBNTerms args)
  fromCBN (var x) = cForce (vVar (fromVar cbnToValType x))
  fromCBN (app s t) = cApp (fromCBN s) (vThunk (fromCBN t))
  fromCBN (abs t) = cAbs (fromCBN t)

  -- To satisfy termination checking, we'd need to inline fromCBV and weaken: fromCBV needs to produce a term in a bigger context.
  -- But let's ignore that.
  {-# NO_TERMINATION_CHECK #-}
  fromCBV : ∀ {Γ τ} (t : Term Γ τ) → Comp (fromCBVCtx Γ) (cbvToCompType τ)

  -- This is really supposed to be part of the plugin interface.
  cbvToCompConst : ∀ {Σ τ} → Const Σ τ → CompConst (fromCBVCtx Σ) (cbvToCompType τ)
  cbvToCompConst = reveal UNDEFINED

  cbvTermsToComps : ∀ {Γ Σ} → Terms Γ Σ → Comps (fromCBVCtx Γ) (fromCBVToCompList Σ)
  cbvTermsToComps ∅ = ∅
  cbvTermsToComps (px • ts) = fromCBV px • cbvTermsToComps ts

  dequeValContexts : ValContext → ValContext → ValContext
  dequeValContexts ∅ Γ = Γ
  dequeValContexts (x • Σ) Γ = dequeValContexts Σ (x • Γ)

  dequeValContexts≼≼ : ∀ Σ Γ → Γ ≼≼ dequeValContexts Σ Γ
  dequeValContexts≼≼ ∅ Γ = ≼≼-refl
  dequeValContexts≼≼ (x • Σ) Γ = ≼≼-trans (drop_••_ x ≼≼-refl) (dequeValContexts≼≼ Σ (x • Γ))

  dequeContexts : Context → Context → ValContext
  dequeContexts Σ Γ = dequeValContexts (fromCBVCtx Σ) (fromCBVCtx Γ)

  fromCBVArg :
    ∀ {σ Γ τ} → Term Γ τ →
      (Val (cbvToValType τ • fromCBVCtx Γ) (cbvToValType τ) →
        Comp (cbvToValType τ • fromCBVCtx Γ) (cbvToCompType σ)) →
      Comp (fromCBVCtx Γ) (cbvToCompType σ)
  fromCBVArg t k =
    (fromCBV t) into
      k (vVar vThis)

  fromCBVArgs :
    ∀ {Σ Γ τ} → Terms Γ Σ →
      (Vals (dequeContexts Σ Γ) (fromCBVCtx Σ) →
        Comp (dequeContexts Σ Γ) (cbvToCompType τ)) →
      Comp (fromCBVCtx Γ) (cbvToCompType τ)
  fromCBVArgs ∅ k = k ∅
  fromCBVArgs {σ • Σ} {Γ} (t • ts) k =
    fromCBVArg t (λ v →
      fromCBVArgs
        (weaken-terms (drop_•_ _ ≼-refl) ts) (λ vs →
          k (weaken-val (dequeValContexts≼≼ (fromCBVCtx Σ) _) v • vs)))

  -- Transform a constant application into
  --
  --   arg1 to x1 in (arg2 to x2 in ... (argn to xn in (cConst (cbvToCompConst c) (x1 :: x2 :: ... xn)))).

  fromCBVConstCPSRoot : ∀ {Σ Γ τ} → Const Σ τ → Terms Γ Σ → Comp (fromCBVCtx Γ) (cbvToCompType τ)
  fromCBVConstCPSRoot c ts = fromCBVArgs ts (cConst (cbvToCompConst c))

  fromCBV (const c args) = fromCBVConstCPSRoot c args
  fromCBV (app s t) =
    (fromCBV s) into
      (fromCBV (weaken (drop _ • ≼-refl) t) into
        cApp (cForce (vVar (vThat vThis))) (vVar vThis))
  -- Values
  fromCBV (var x) = cReturn (vVar (fromVar cbvToValType x))
  fromCBV (abs t) = cReturn (vThunk (cAbs (fromCBV t)))

  -- This reflects the CBV conversion of values in TLCA '99, but we can't write
  -- this because it's partial on the Term type. Instead, we duplicate thunking
  -- at the call site.
  {-
  fromCBVToVal : ∀ {Γ τ} (t : Term Γ τ) → Val (fromCBVCtx Γ) (cbvToValType τ)
  fromCBVToVal (var x) = vVar (fromVar cbvToValType x)
  fromCBVToVal (abs t) = vThunk (cAbs (fromCBV t))

  fromCBVToVal (const c args) = {!!}
  fromCBVToVal (app t t₁) = {!!} -- Not a value
  -}

import Parametric.Syntax.Type as Type
import Parametric.Syntax.Term as Term
import Parametric.Syntax.MType as MType

module Parametric.Syntax.MTerm
    {Base : Type.Structure}
    (Const : Term.Structure Base)
  where

open Type.Structure Base
open MType.Structure Base
open Term.Structure Base Const

-- Our extension points are sets of primitives, indexed by the
-- types of their arguments and their return type.

-- We want different types of constants; some produce values, some produce
-- computations. In all cases, arguments are assumed to be values (though
-- individual primitives might require thunks).

ValConstStructure : Set₁
ValConstStructure = ValContext → ValType → Set

CompConstStructure : Set₁
CompConstStructure = ValContext → CompType → Set

module Structure (ValConst : ValConstStructure) (CompConst : CompConstStructure) where
  mutual
    -- Analogues of Terms
    Vals : ValContext → ValContext → Set
    Vals Γ = DependentList (Val Γ)

    Comps : ValContext → List CompType → Set
    Comps Γ = DependentList (Comp Γ)

    data Val Γ : (τ : ValType) → Set where
      vVar : ∀ {τ} (x : ValVar Γ τ) → Val Γ τ
      -- XXX Do we need thunks? The draft in the paper doesn't have them.
      -- However, they will start being useful if we deal with CBN source
      -- languages.
      vThunk : ∀ {τ} → Comp Γ τ → Val Γ (U τ)
      vConst : ∀ {Σ τ} →
        (c : ValConst Σ τ) →
        (args : Vals Γ Σ) →
        Val Γ τ

    data Comp Γ : (τ : CompType) → Set where
      cConst : ∀ {Σ τ} →
        (c : CompConst Σ τ) →
        (args : Vals Γ Σ) →
        Comp Γ τ

      cForce : ∀ {τ} → Val Γ (U τ) → Comp Γ τ
      cReturn : ∀ {τ} (v : Val Γ τ) → Comp Γ (F τ)
      {-
      -- Originally, M to x in N. But here we have no names!
      _into_ : ∀ {σ τ} →
        (e₁ : Comp Γ (F σ)) →
        (e₂ : Comp (σ •• Γ) τ) →
        Comp Γ τ
      -}
      -- The following constructor is the main difference between CBPV and this
      -- monadic calculus. This is better for the caching transformation.
      _into_ : ∀ {σ τ} →
        (e₁ : Comp Γ (F σ)) →
        (e₂ : Comp (σ •• Γ) (F τ)) →
        Comp Γ (F τ)
      cAbs : ∀ {σ τ} →
        (t : Comp (σ •• Γ) τ) →
        Comp Γ (σ ⇛ τ)
      cApp : ∀ {σ τ} →
        (s : Comp Γ (σ ⇛ τ)) →
        (t : Val Γ σ) →
        Comp Γ τ

  weaken-val : ∀ {Γ₁ Γ₂ τ} →
    (Γ₁≼Γ₂ : Γ₁ ≼≼ Γ₂) →
    Val Γ₁ τ →
    Val Γ₂ τ

  weaken-comp : ∀ {Γ₁ Γ₂ τ} →
    (Γ₁≼Γ₂ : Γ₁ ≼≼ Γ₂) →
    Comp Γ₁ τ →
    Comp Γ₂ τ

  weaken-vals : ∀ {Γ₁ Γ₂ Σ} →
    (Γ₁≼Γ₂ : Γ₁ ≼≼ Γ₂) →
    Vals Γ₁ Σ →
    Vals Γ₂ Σ

  weaken-val Γ₁≼Γ₂ (vVar x) = vVar (weaken-val-var Γ₁≼Γ₂ x)
  weaken-val Γ₁≼Γ₂ (vThunk x) = vThunk (weaken-comp Γ₁≼Γ₂ x)
  weaken-val Γ₁≼Γ₂ (vConst c args) = vConst c (weaken-vals Γ₁≼Γ₂ args)
  weaken-comp Γ₁≼Γ₂ (cConst c args) = cConst c (weaken-vals Γ₁≼Γ₂ args)
  weaken-comp Γ₁≼Γ₂ (cForce x) = cForce (weaken-val Γ₁≼Γ₂ x)
  weaken-comp Γ₁≼Γ₂ (cReturn v) = cReturn (weaken-val Γ₁≼Γ₂ v)
  weaken-comp Γ₁≼Γ₂ (_into_ {σ} c c₁) = (weaken-comp Γ₁≼Γ₂ c) into (weaken-comp (keep σ •• Γ₁≼Γ₂) c₁)
  weaken-comp Γ₁≼Γ₂ (cAbs {σ} c) = cAbs (weaken-comp (keep σ •• Γ₁≼Γ₂) c)
  weaken-comp Γ₁≼Γ₂ (cApp s t) = cApp (weaken-comp Γ₁≼Γ₂ s) (weaken-val Γ₁≼Γ₂ t)

  weaken-vals Γ₁≼Γ₂ ∅ = ∅
  weaken-vals Γ₁≼Γ₂ (px • ts) = (weaken-val Γ₁≼Γ₂ px) • (weaken-vals Γ₁≼Γ₂ ts)

  fromCBN : ∀ {Γ τ} (t : Term Γ τ) → Comp (fromCBNCtx Γ) (cbnToCompType τ)

  fromCBNTerms : ∀ {Γ Σ} → Terms Γ Σ → Vals (fromCBNCtx Γ) (fromCBNCtx Σ)
  fromCBNTerms ∅ = ∅
  fromCBNTerms (px • ts) = vThunk (fromCBN px) • fromCBNTerms ts

  open import UNDEFINED
  -- This is really supposed to be part of the plugin interface.
  cbnToCompConst : ∀ {Σ τ} → Const Σ τ → CompConst (fromCBNCtx Σ) (cbnToCompType τ)
  cbnToCompConst = reveal UNDEFINED

  fromCBN (const c args) = cConst (cbnToCompConst c) (fromCBNTerms args)
  fromCBN (var x) = cForce (vVar (fromVar cbnToValType x))
  fromCBN (app s t) = cApp (fromCBN s) (vThunk (fromCBN t))
  fromCBN (abs t) = cAbs (fromCBN t)

  -- To satisfy termination checking, we'd need to inline fromCBV and weaken: fromCBV needs to produce a term in a bigger context.
  -- But let's ignore that.
  {-# NO_TERMINATION_CHECK #-}
  fromCBV : ∀ {Γ τ} (t : Term Γ τ) → Comp (fromCBVCtx Γ) (cbvToCompType τ)

  -- This is really supposed to be part of the plugin interface.
  cbvToCompConst : ∀ {Σ τ} → Const Σ τ → CompConst (fromCBVCtx Σ) (cbvToCompType τ)
  cbvToCompConst = reveal UNDEFINED

  cbvTermsToComps : ∀ {Γ Σ} → Terms Γ Σ → Comps (fromCBVCtx Γ) (fromCBVToCompList Σ)
  cbvTermsToComps ∅ = ∅
  cbvTermsToComps (px • ts) = fromCBV px • cbvTermsToComps ts

  module _ where

    dequeValContexts : ValContext → ValContext → ValContext
    dequeValContexts ∅ Γ = Γ
    dequeValContexts (x • Σ) Γ = dequeValContexts Σ (x • Γ)

    dequeValContexts≼≼ : ∀ Σ Γ → Γ ≼≼ dequeValContexts Σ Γ
    dequeValContexts≼≼ ∅ Γ = ≼≼-refl
    dequeValContexts≼≼ (x • Σ) Γ = ≼≼-trans (drop_••_ x ≼≼-refl) (dequeValContexts≼≼ Σ (x • Γ))

    dequeContexts : Context → Context → ValContext
    dequeContexts Σ Γ = dequeValContexts (fromCBVCtx Σ) (fromCBVCtx Γ)

    fromCBVArg : ∀ {σ Γ τ} → Term Γ τ → (Val (cbvToValType τ • fromCBVCtx Γ) (cbvToValType τ) → Comp (cbvToValType τ • fromCBVCtx Γ) (cbvToCompType σ)) → Comp (fromCBVCtx Γ) (cbvToCompType σ)
    fromCBVArg t k = (fromCBV t) into k (vVar vThis)

    fromCBVArgs : ∀ {Σ Γ τ} → Terms Γ Σ → (Vals (dequeContexts Σ Γ) (fromCBVCtx Σ) → Comp (dequeContexts Σ Γ) (cbvToCompType τ)) → Comp (fromCBVCtx Γ) (cbvToCompType τ)
    fromCBVArgs ∅ k = k ∅
    fromCBVArgs {σ • Σ} {Γ} (t • ts) k = fromCBVArg t (λ v → fromCBVArgs (weaken-terms (drop_•_ _ ≼-refl) ts) (λ vs → k (weaken-val (dequeValContexts≼≼ (fromCBVCtx Σ) _) v • vs)))

    -- Transform a constant application into
    --
    --   arg1 to x1 in (arg2 to x2 in ... (argn to xn in (cConst (cbvToCompConst c) (x1 :: x2 :: ... xn)))).

    fromCBVConstCPSRoot : ∀ {Σ Γ τ} → Const Σ τ → Terms Γ Σ → Comp (fromCBVCtx Γ) (cbvToCompType τ)
    -- pass that as a closure to compose with (_•_ x) for each new variable.
    fromCBVConstCPSRoot c ts = fromCBVArgs ts (λ vs → cConst (cbvToCompConst c) vs)

  fromCBV (const c args) = fromCBVConstCPSRoot c args
  fromCBV (app s t) =
    (fromCBV s) into
      (fromCBV (weaken (drop _ • ≼-refl) t) into
        cApp (cForce (vVar (vThat vThis))) (vVar vThis))
  -- Values
  fromCBV (var x) = cReturn (vVar (fromVar cbvToValType x))
  fromCBV (abs t) = cReturn (vThunk (cAbs (fromCBV t)))

  -- This reflects the CBV conversion of values in TLCA '99, but we can't write
  -- this because it's partial on the Term type. Instead, we duplicate thunking
  -- at the call site.
  {-
  fromCBVToVal : ∀ {Γ τ} (t : Term Γ τ) → Val (fromCBVCtx Γ) (cbvToValType τ)
  fromCBVToVal (var x) = vVar (fromVar cbvToValType x)
  fromCBVToVal (abs t) = vThunk (cAbs (fromCBV t))

  fromCBVToVal (const c args) = {!!}
  fromCBVToVal (app t t₁) = {!!} -- Not a value
  -}


Only reordering.

Only reordering.

Ignore-this: c41f338dcf084cc236557506f6503040

darcs-hash:20100909125858-3bd4e-185c01385b3db0af31b9ba1e1e2fe88df9c9ee41.gz

------------------------------------------------------------------------------
-- Properties related with lists
------------------------------------------------------------------------------

module LTC.Data.List.Properties where

open import LTC.Minimal

open import LTC.Data.Nat.Type using ( N ; sN ; zN )
open import LTC.Data.List using
  ( [] ; _∷_
  ; _++_ ; ++-[]
  ; List ; consL ; nilL
  ; length
  ; map
  ; replicate
  ; reverse
  )

------------------------------------------------------------------------------
-- Closure properties

++-List : {xs ys : D} → List xs → List ys → List (xs ++ ys)
++-List {ys = ys} nilL ysL = prf
  where
    postulate prf : List ([] ++ ys)
    {-# ATP prove prf #-}

++-List {ys = ys} (consL x {xs} xsL) ysL = prf (++-List xsL ysL)
  where
    postulate prf : List (xs ++ ys) →
                    List ((x ∷ xs) ++ ys)
    {-# ATP prove prf consL #-}

reverse-List : {xs : D} → List xs → List (reverse xs)
reverse-List nilL = prf
  where
    postulate prf : List (reverse [])
    {-# ATP prove prf nilL #-}

reverse-List (consL x {xs} xsL) = prf (reverse-List xsL)
  where
    postulate prf : List (reverse xs) →
                    List (reverse (x ∷ xs))
    {-# ATP prove prf consL nilL ++-List #-}

++-leftIdentity : {xs : D} → List xs → [] ++ xs ≡ xs
++-leftIdentity {xs} _ = ++-[] xs

++-rightIdentity : {xs : D} → List xs → xs ++ [] ≡ xs
++-rightIdentity nilL = prf
  where
    postulate prf : [] ++ [] ≡ []
    {-# ATP prove prf #-}

++-rightIdentity (consL x {xs} xsL) = prf (++-rightIdentity xsL)
  where
    postulate prf : xs ++ [] ≡ xs →
                    (x ∷ xs) ++ [] ≡ x ∷ xs
    {-# ATP prove prf #-}

++-assoc : {as bs cs : D} → List as → List bs → List cs →
           (as ++ bs) ++ cs ≡ as ++ (bs ++ cs)
++-assoc .{[]} {bs} {cs} nilL bsL csL = prf
  where
    postulate prf : ([] ++ bs) ++ cs ≡ [] ++ bs ++ cs
    {-# ATP prove prf #-}

++-assoc .{x ∷ xs} {bs} {cs} (consL x {xs} xsL) bsL csL =
  prf (++-assoc xsL bsL csL)
  where
    postulate prf : (xs ++ bs) ++ cs ≡ xs ++ bs ++ cs →
                    ((x ∷ xs) ++ bs) ++ cs ≡ (x ∷ xs) ++ bs ++ cs
    {-# ATP prove prf #-}

postulate
  reverse-[x]≡[x] : (x : D) → reverse (x ∷ []) ≡ x ∷ []
{-# ATP prove reverse-[x]≡[x] #-}

reverse-++ : {xs ys : D} → List xs → List ys →
             reverse (xs ++ ys) ≡ reverse ys ++ reverse xs
reverse-++ {ys = ys} nilL ysL = prf
  where
    postulate prf : reverse ([] ++ ys) ≡ reverse ys ++ reverse []
    {-# ATP prove prf ++-rightIdentity reverse-List #-}

reverse-++ {ys = ys} (consL x {xs} xsL) ysL = prf (reverse-++ xsL ysL)
  where
    postulate prf : reverse (xs ++ ys) ≡ reverse ys ++ reverse xs →
                    reverse ((x ∷ xs) ++ ys) ≡ reverse ys ++ reverse (x ∷ xs)
    -- E 1.2 cannot prove this postulate with --time=180.
    {-# ATP prove prf ++-assoc nilL consL reverse-List ++-List #-}

reverse² : {xs : D} → List xs → reverse (reverse xs) ≡ xs
reverse² nilL = prf
  where
    postulate prf : reverse (reverse []) ≡ []
    {-# ATP prove prf #-}

reverse² (consL x {xs} xsL) = prf (reverse² xsL)
  where
    postulate prf : reverse (reverse xs) ≡ xs →
                    reverse (reverse (x ∷ xs)) ≡ x ∷ xs
    {-# ATP prove prf reverse-++ consL nilL reverse-List ++-List #-}

map-++ : (f : D){xs ys : D} → List xs → List ys →
         map f (xs ++ ys) ≡ map f xs ++ map f ys
map-++ f {ys = ys} nilL ysL = prf
  where
    postulate prf : map f ([] ++ ys) ≡ map f [] ++ map f ys
    {-# ATP prove prf #-}
map-++ f {ys = ys} (consL x {xs} xsL) ysL = prf (map-++ f xsL ysL)
  where
    postulate prf : map f (xs ++ ys) ≡ map f xs ++ map f ys →
                    map f ((x ∷ xs) ++ ys) ≡ map f (x ∷ xs) ++ map f ys
    -- E 1.2 cannot prove this postulate with --time=180.
    {-# ATP prove prf #-}

length-replicate : {n : D} → N n → (d : D) → length (replicate n d) ≡ n
length-replicate zN d = prf
  where
    postulate prf : length (replicate zero d) ≡ zero
    {-# ATP prove prf #-}
length-replicate (sN {n} Nn) d = prf (length-replicate Nn d)
  where
    postulate prf : length (replicate n d) ≡ n →
                    length (replicate (succ n) d) ≡ succ n
    {-# ATP prove prf #-}

------------------------------------------------------------------------------
-- Properties related with lists
------------------------------------------------------------------------------

module LTC.Data.List.Properties where

open import LTC.Minimal

open import LTC.Data.Nat.Type using ( N ; sN ; zN )
open import LTC.Data.List using
  ( [] ; _∷_
  ; _++_ ; ++-[]
  ; List ; consL ; nilL
  ; length
  ; map
  ; replicate
  ; reverse
  )

------------------------------------------------------------------------------

++-List : {xs ys : D} → List xs → List ys → List (xs ++ ys)
++-List {ys = ys} nilL ysL = prf
  where
    postulate prf : List ([] ++ ys)
    {-# ATP prove prf #-}

++-List {ys = ys} (consL x {xs} xsL) ysL = prf (++-List xsL ysL)
  where
    postulate prf : List (xs ++ ys) →
                    List ((x ∷ xs) ++ ys)
    {-# ATP prove prf consL #-}

++-leftIdentity : {xs : D} → List xs → [] ++ xs ≡ xs
++-leftIdentity {xs} _ = ++-[] xs

++-rightIdentity : {xs : D} → List xs → xs ++ [] ≡ xs
++-rightIdentity nilL = prf
  where
    postulate prf : [] ++ [] ≡ []
    {-# ATP prove prf #-}

++-rightIdentity (consL x {xs} xsL) = prf (++-rightIdentity xsL)
  where
    postulate prf : xs ++ [] ≡ xs →
                    (x ∷ xs) ++ [] ≡ x ∷ xs
    {-# ATP prove prf #-}

++-assoc : {as bs cs : D} → List as → List bs → List cs →
           (as ++ bs) ++ cs ≡ as ++ (bs ++ cs)
++-assoc .{[]} {bs} {cs} nilL bsL csL = prf
  where
    postulate prf : ([] ++ bs) ++ cs ≡ [] ++ bs ++ cs
    {-# ATP prove prf #-}

++-assoc .{x ∷ xs} {bs} {cs} (consL x {xs} xsL) bsL csL =
  prf (++-assoc xsL bsL csL)
  where
    postulate prf : (xs ++ bs) ++ cs ≡ xs ++ bs ++ cs →
                    ((x ∷ xs) ++ bs) ++ cs ≡ (x ∷ xs) ++ bs ++ cs
    {-# ATP prove prf #-}

reverse-List : {xs : D} → List xs → List (reverse xs)
reverse-List nilL = prf
  where
    postulate prf : List (reverse [])
    {-# ATP prove prf nilL #-}

reverse-List (consL x {xs} xsL) = prf (reverse-List xsL)
  where
    postulate prf : List (reverse xs) →
                    List (reverse (x ∷ xs))
    {-# ATP prove prf consL nilL ++-List #-}

postulate
  reverse-[x]≡[x] : (x : D) → reverse (x ∷ []) ≡ x ∷ []
{-# ATP prove reverse-[x]≡[x] #-}

reverse-++ : {xs ys : D} → List xs → List ys →
             reverse (xs ++ ys) ≡ reverse ys ++ reverse xs
reverse-++ {ys = ys} nilL ysL = prf
  where
    postulate prf : reverse ([] ++ ys) ≡ reverse ys ++ reverse []
    {-# ATP prove prf ++-rightIdentity reverse-List #-}

reverse-++ {ys = ys} (consL x {xs} xsL) ysL = prf (reverse-++ xsL ysL)
  where
    postulate prf : reverse (xs ++ ys) ≡ reverse ys ++ reverse xs →
                    reverse ((x ∷ xs) ++ ys) ≡ reverse ys ++ reverse (x ∷ xs)
    -- E 1.2 cannot prove this postulate with --time=180.
    {-# ATP prove prf ++-assoc nilL consL reverse-List ++-List #-}

reverse² : {xs : D} → List xs → reverse (reverse xs) ≡ xs
reverse² nilL = prf
  where
    postulate prf : reverse (reverse []) ≡ []
    {-# ATP prove prf #-}

reverse² (consL x {xs} xsL) = prf (reverse² xsL)
  where
    postulate prf : reverse (reverse xs) ≡ xs →
                    reverse (reverse (x ∷ xs)) ≡ x ∷ xs
    {-# ATP prove prf reverse-++ consL nilL reverse-List ++-List #-}

map-++ : (f : D){xs ys : D} → List xs → List ys →
         map f (xs ++ ys) ≡ map f xs ++ map f ys
map-++ f {ys = ys} nilL ysL = prf
  where
    postulate prf : map f ([] ++ ys) ≡ map f [] ++ map f ys
    {-# ATP prove prf #-}
map-++ f {ys = ys} (consL x {xs} xsL) ysL = prf (map-++ f xsL ysL)
  where
    postulate prf : map f (xs ++ ys) ≡ map f xs ++ map f ys →
                    map f ((x ∷ xs) ++ ys) ≡ map f (x ∷ xs) ++ map f ys
    -- E 1.2 cannot prove this postulate with --time=180.
    {-# ATP prove prf #-}

length-replicate : {n : D} → N n → (d : D) → length (replicate n d) ≡ n
length-replicate zN d = prf
  where
    postulate prf : length (replicate zero d) ≡ zero
    {-# ATP prove prf #-}
length-replicate (sN {n} Nn) d = prf (length-replicate Nn d)
  where
    postulate prf : length (replicate n d) ≡ n →
                    length (replicate (succ n) d) ≡ succ n
    {-# ATP prove prf #-}


Cosmetic changes.

Cosmetic changes.

Ignore-this: 4aa7b9214eebfe20641b79ed2a83c775

darcs-hash:20110810144352-3bd4e-90cdb5bbab3c2ec06f4164ad5483106f752402f3.gz

------------------------------------------------------------------------------
-- Bisimilarity relation on FOTC
------------------------------------------------------------------------------

module FOTC.Relation.Binary.Bisimilarity where

open import FOTC.Base

-- We add 3 to the fixities of the standard library.
infix 7 _≈_

------------------------------------------------------------------------------
-- The bisimilarity relation.
postulate
  _≈_ : D → D → Set

-- The bisimilarity relation is a post-fixed point of the functor
-- BisimilarityF (see below).
postulate
  ≈-gfp₁ : ∀ {xs ys} → xs ≈ ys →
           ∃ λ x' → ∃ λ xs' → ∃ λ ys' →
           xs' ≈ ys' ∧ xs ≡ x' ∷ xs' ∧ ys ≡ x' ∷ ys'
{-# ATP axiom ≈-gfp₁ #-}

-- The bisimilarity relation is the greatest post-fixed point of the
-- functor BisimilarityF (see below).

-- N.B. This is a second-order axiom. In the automatic proofs, we
-- *must* use an instance. Therefore, we do not add this postulate as
-- an ATP axiom.
postulate
  ≈-gfp₂ : (_R_ : D → D → Set) →
           -- R is a post-fixed point of BisimilarityF.
           (∀ {xs ys} → xs R ys →
            ∃ λ x' → ∃ λ xs' → ∃ λ ys' →
            xs' R ys' ∧ xs ≡ x' ∷ xs' ∧ ys ≡ x' ∷ ys') →
           -- _≈_ is greater than R.
           ∀ {xs ys} → xs R ys → xs ≈ ys

-- Because a greatest post-fixed point is a fixed point, the
-- bisimilarity relation is also a pre-fixed point of the functor
-- BisimilarityF (see below).
≈-gfp₃ : ∀ {xs ys} →
         (∃ λ x' → ∃ λ xs' → ∃ λ ys' →
          xs' ≈ ys' ∧ xs ≡ x' ∷ xs' ∧ ys ≡ x' ∷ ys') →
         xs ≈ ys
≈-gfp₃ h = ≈-gfp₂ R helper h
  where
  R : D → D → Set
  R xs ys = ∃ λ x' → ∃ λ xs' → ∃ λ ys' →
            xs' ≈ ys' ∧ xs ≡ x' ∷ xs' ∧ ys ≡ x' ∷ ys'

  helper : ∀ {xs ys} → R xs ys →
           ∃ λ x' → ∃ λ xs' → ∃ λ ys' →
           R xs' ys' ∧ xs ≡ x' ∷ xs' ∧ ys ≡ x' ∷ ys'
  helper (x' , xs' , ys' , xs'≈ys' , prf) =
    x' , xs' , ys' , (≈-gfp₁ xs'≈ys') , prf

module BisimilarityF where
  -- In FOTC we won't use the bisimilarity functor. This module is
  -- only for illustrative purposes.

  -- Adapted from [1]. In this paper the authors use the name
  -- 'as (R :: R') bs' (p. 310) for the functor BisimilarityF.

  -- [1] Peter Dybjer and Herbert Sander. A functional programming
  -- approach to the specification and verification of concurrent
  -- systems. Formal Aspects of Computing, 1:303–319, 1989.

  -- The bisimilarity functor.
  BisimilarityF : (D → D → Set) → D → D → Set
  BisimilarityF _R_ xs ys =
    ∃ λ x' → ∃ λ xs' → ∃ λ ys' →
      xs' R ys' ∧ xs ≡ x' ∷ xs' ∧ ys ≡ x' ∷ ys'

  -- The bisimilarity relation is a post-fixed point of BisimilarityF.
  pfp : ∀ {xs ys} → xs ≈ ys → BisimilarityF _≈_ xs ys
  pfp = ≈-gfp₁

  -- The bisimilarity relation is the greatest post-fixed point of
  -- BisimilarityF.
  gpfp : (_R_ : D → D → Set) →
         -- R is a post-fixed point of BisimilarityF.
         (∀ {xs ys} → xs R ys → BisimilarityF _R_ xs ys) →
         -- _≈_ is greater than R.
         ∀ {xs ys} → xs R ys → xs ≈ ys
  gpfp = ≈-gfp₂

------------------------------------------------------------------------------
-- Bisimilarity relation on FOTC
------------------------------------------------------------------------------

module FOTC.Relation.Binary.Bisimilarity where

open import FOTC.Base

-- We add 3 to the fixities of the standard library.
infix 7 _≈_

------------------------------------------------------------------------------
-- The bisimilarity relation.
postulate
  _≈_ : D → D → Set

-- The bisimilarity relation is a post-fixed point of the functor
-- BisimilarityF (see below).
postulate
  ≈-gfp₁ : ∀ {xs ys} → xs ≈ ys →
           ∃ λ x' → ∃ λ xs' → ∃ λ ys' → xs' ≈ ys' ∧
                                        xs ≡ x' ∷ xs' ∧
                                        ys ≡ x' ∷ ys'
{-# ATP axiom ≈-gfp₁ #-}

-- The bisimilarity relation is the greatest post-fixed point of the
-- functor BisimilarityF (see below).

-- N.B. This is a second-order axiom. In the automatic proofs, we
-- *must* use an instance. Therefore, we do not add this postulate as
-- an ATP axiom.
postulate
  ≈-gfp₂ : (_R_ : D → D → Set) →
           -- R is a post-fixed point of BisimilarityF.
           (∀ {xs ys} → xs R ys →
            ∃ λ x' → ∃ λ xs' → ∃ λ ys' → xs' R ys' ∧
                                         xs ≡ x' ∷ xs' ∧
                                         ys ≡ x' ∷ ys') →
           -- _≈_ is greater than R.
           ∀ {xs ys} → xs R ys → xs ≈ ys

-- Because a greatest post-fixed point is a fixed point, the
-- bisimilarity relation is also a pre-fixed point of the functor
-- BisimilarityF (see below).
≈-gfp₃ : ∀ {xs ys} →
         (∃ λ x' → ∃ λ xs' → ∃ λ ys' → xs' ≈ ys' ∧
                                       xs ≡ x' ∷ xs' ∧
                                       ys ≡ x' ∷ ys') →
         xs ≈ ys
≈-gfp₃ h = ≈-gfp₂ R helper h
  where
  R : D → D → Set
  R xs ys = ∃ λ x' → ∃ λ xs' → ∃ λ ys' → xs' ≈ ys' ∧
                                         xs ≡ x' ∷ xs' ∧
                                         ys ≡ x' ∷ ys'

  helper : {xs ys : D} → R xs ys →
           ∃ λ x' → ∃ λ xs' → ∃ λ ys' →
             R xs' ys' ∧ xs ≡ x' ∷ xs' ∧ ys ≡ x' ∷ ys'
  helper (x' , xs' , ys' , xs'≈ys' , prf) =
    x' , xs' , ys' , (≈-gfp₁ xs'≈ys') , prf

module BisimilarityF where
  -- In FOTC we won't use the bisimilarity functor. This module is
  -- only for illustrative purposes.

  -- Adapted from [1]. In this paper the authors use the name
  -- 'as (R :: R') bs' (p. 310) for the functor BisimilarityF.

  -- [1] Peter Dybjer and Herbert Sander. A functional programming
  -- approach to the specification and verification of concurrent
  -- systems. Formal Aspects of Computing, 1:303–319, 1989.

  -- The bisimilarity functor.
  BisimilarityF : (D → D → Set) → D → D → Set
  BisimilarityF _R_ xs ys =
    ∃ λ x' → ∃ λ xs' → ∃ λ ys' → xs' R ys' ∧
                                 xs ≡ x' ∷ xs' ∧
                                 ys ≡ x' ∷ ys'

  -- The bisimilarity relation is a post-fixed point of BisimilarityF.
  pfp : ∀ {xs ys} → xs ≈ ys → BisimilarityF _≈_ xs ys
  pfp = ≈-gfp₁

  -- The bisimilarity relation is the greatest post-fixed point of
  -- BisimilarityF.
  gpfp : (_R_ : D → D → Set) →
         -- R is a post-fixed point of BisimilarityF.
         (∀ {xs ys} → xs R ys → BisimilarityF _R_ xs ys) →
         -- _≈_ is greater than R.
         ∀ {xs ys} → xs R ys → xs ≈ ys
  gpfp = ≈-gfp₂


Added draft version of Stream-gfp₂ using the Agda coinductive stuff.

Ignore-this: 6c2676f3926657febcc44f83992f3352

darcs-hash:20110926155004-3bd4e-b325b914bf8d3d38ab3084ce1c2bc672b442c586.gz


Update PLDI14-List-of-Theorems.agda (for #275).

The list included plugin requirements, but we left them out of the
paper, so the theorem numbers were off.

Old-commit-hash: d4ea643c7474f10c798fcb0d494db9f941e3deb5

module PLDI14-List-of-Theorems where

-- List of theorems in PLDI submission
--
-- For hints about installation and execution, please refer
-- to README.agda.
--
-- Agda modules corresponding to definitions, lemmas and theorems
-- are listed here with the most important names. For example,
-- after this file type checks (C-C C-L), placing the cursor
-- on the purple "Base.Change.Algebra" and pressing M-. will
-- bring you to the file where change structures are defined.
-- The name for change structures in that file is
-- "ChangeAlgebra", given in the using-clause.

-- Definition 2.1 (Change structures)
open import Base.Change.Algebra using (ChangeAlgebra)
---- Carrier in record ChangeAlgebra                        --(a)
open Base.Change.Algebra.ChangeAlgebra   using (Change)     --(b)
open Base.Change.Algebra.ChangeAlgebra   using (update)     --(c)
open Base.Change.Algebra.ChangeAlgebra   using (diff)       --(d)
open Base.Change.Algebra.IsChangeAlgebra using (update-diff)--(e)

-- Definition 2.2 (Nil change)
-- IsChangeAlgebra.nil
open Base.Change.Algebra using (IsChangeAlgebra)

-- Lemma 2.3 (Behavior of nil)
-- IsChangeAlgebra.update-nil
open Base.Change.Algebra using (IsChangeAlgebra)

-- Definition 2.4 (Derivatives)
open Base.Change.Algebra using (Derivative)

-- Definition 2.5 (Carrier set of function changes)
open Base.Change.Algebra.FunctionChanges

-- Definition 2.6 (Operations on function changes)
-- ChangeAlgebra.update FunctionChanges.changeAlgebra
-- ChangeAlgebra.diff   FunctionChanges.changeAlgebra
open Base.Change.Algebra.FunctionChanges using (changeAlgebra)

-- Theorem 2.7 (Function changes form a change structure)
-- (In Agda, the proof of Theorem 2.7 has to be included in the
-- definition of function changes, here
-- FunctionChanges.changeAlgebra.)
open Base.Change.Algebra.FunctionChanges using (changeAlgebra)

-- Lemma 2.8 (Incrementalization)
open Base.Change.Algebra.FunctionChanges using (incrementalization)

-- Theorem 2.9 (Nil changes are derivatives)
open Base.Change.Algebra.FunctionChanges using (nil-is-derivative)

-- Definition 3.1 (Domains)
import Parametric.Denotation.Value
open Parametric.Denotation.Value.Structure using (⟦_⟧Type)

-- Definition 3.2 (Environments)
open import Base.Denotation.Environment using (⟦_⟧Context)

-- Definition 3.3 (Evaluation)
import Parametric.Denotation.Evaluation
open Parametric.Denotation.Evaluation.Structure using (⟦_⟧Term)

-- Definition 3.4 (Changes)
-- Definition 3.5 (Change environments)
import Parametric.Change.Validity
open Parametric.Change.Validity.Structure using (change-algebra)
open Parametric.Change.Validity.Structure using (environment-changes)

-- Definition 3.6 (Change semantics)
-- Lemma 3.7 (Change semantics is the derivative of semantics)
import Parametric.Change.Specification
open Parametric.Change.Specification.Structure using (⟦_⟧Δ)
open Parametric.Change.Specification.Structure using (correctness)

-- Definition 3.8 (Erasure)
-- Lemma 3.9 (The erased version of a change is almost the same)
import Parametric.Change.Implementation
open Parametric.Change.Implementation.Structure using (_≈_)
open Parametric.Change.Implementation.Structure using (carry-over)

-- Lemma 3.10 (⟦ t ⟧Δ erases to Derive(t))
-- Theorem 3.11 (Correctness of differentiation)
import Parametric.Change.Correctness
open Parametric.Change.Correctness.Structure using (derive-correct-closed)
open Parametric.Change.Correctness.Structure using (main-theorem)

module PLDI14-List-of-Theorems where

open import Function

-- List of theorems in PLDI submission
--
-- For hints about installation and execution, please refer
-- to README.agda.
--
-- Agda modules corresponding to definitions, lemmas and theorems
-- are listed here with the most important names. For example,
-- after this file type checks (C-C C-L), placing the cursor
-- on the purple "Base.Change.Algebra" and pressing M-. will
-- bring you to the file where change structures are defined.
-- The name for change structures in that file is
-- "ChangeAlgebra", given in the using-clause.

-- Definition 2.1 (Change structures)
open import Base.Change.Algebra using (ChangeAlgebra)
---- Carrier in record ChangeAlgebra                        --(a)
open Base.Change.Algebra.ChangeAlgebra   using (Change)     --(b)
open Base.Change.Algebra.ChangeAlgebra   using (update)     --(c)
open Base.Change.Algebra.ChangeAlgebra   using (diff)       --(d)
open Base.Change.Algebra.IsChangeAlgebra using (update-diff)--(e)

-- Definition 2.2 (Nil change)
-- IsChangeAlgebra.nil
open Base.Change.Algebra using (IsChangeAlgebra)

-- Lemma 2.3 (Behavior of nil)
-- IsChangeAlgebra.update-nil
open Base.Change.Algebra using (IsChangeAlgebra)

-- Definition 2.4 (Derivatives)
open Base.Change.Algebra using (Derivative)

-- Definition 2.5 (Carrier set of function changes)
open Base.Change.Algebra.FunctionChanges

-- Definition 2.6 (Operations on function changes)
-- ChangeAlgebra.update FunctionChanges.changeAlgebra
-- ChangeAlgebra.diff   FunctionChanges.changeAlgebra
open Base.Change.Algebra.FunctionChanges using (changeAlgebra)

-- Theorem 2.7 (Function changes form a change structure)
-- (In Agda, the proof of Theorem 2.7 has to be included in the
-- definition of function changes, here
-- FunctionChanges.changeAlgebra.)
open Base.Change.Algebra.FunctionChanges using (changeAlgebra)

-- Lemma 2.8 (Incrementalization)
open Base.Change.Algebra.FunctionChanges using (incrementalization)

-- Theorem 2.9 (Nil changes are derivatives)
open Base.Change.Algebra.FunctionChanges using (nil-is-derivative)

-- For each plugin requirement, we include its definition and
-- a concrete instantiation called "Nehemiah" with integers and
-- bags of integers as base types.

-- Plugin Requirement 3.1 (Domains of base types)
open import Parametric.Denotation.Value using (Structure)
open import     Nehemiah.Denotation.Value using (⟦_⟧Base)

-- Definition 3.2 (Domains)
open Parametric.Denotation.Value.Structure using (⟦_⟧Type)

-- Plugin Requirement 3.3 (Evaluation of constants)
open import Parametric.Denotation.Evaluation using (Structure)
open import     Nehemiah.Denotation.Evaluation using (⟦_⟧Const)

-- Definition 3.4 (Environments)
open import Base.Denotation.Environment using (⟦_⟧Context)

-- Definition 3.5 (Evaluation)
open Parametric.Denotation.Evaluation.Structure using (⟦_⟧Term)

-- Plugin Requirement 3.6 (Changes on base types)
open import Parametric.Change.Validity using (Structure)
open import     Nehemiah.Change.Validity using (change-algebra-base-family)

-- Definition 3.7 (Changes)
open Parametric.Change.Validity.Structure using (change-algebra)

-- Definition 3.8 (Change environments)
open Parametric.Change.Validity.Structure using (environment-changes)

-- Plugin Requirement 3.9 (Change semantics for constants)
open import Parametric.Change.Specification using (Structure)
open import     Nehemiah.Change.Specification using (specification-structure)

-- Definition 3.10 (Change semantics)
open Parametric.Change.Specification.Structure using (⟦_⟧Δ)

-- Lemma 3.11 (Change semantics is the derivative of semantics)
open Parametric.Change.Specification.Structure using (correctness)

-- Definition 3.12 (Erasure)
import Parametric.Change.Implementation
open Parametric.Change.Implementation.Structure using (_≈_)
open import Nehemiah.Change.Implementation using (implements-base)

-- Lemma 3.13 (The erased version of a change is almost the same)
open Parametric.Change.Implementation.Structure using (carry-over)

-- Lemma 3.14 (⟦ t ⟧Δ erases to Derive(t))
import Parametric.Change.Correctness
open Parametric.Change.Correctness.Structure using (derive-correct-closed)

-- Theorem 3.15 (Correctness of differentiation)
open Parametric.Change.Correctness.Structure using (main-theorem)