~ubuntu-branches/ubuntu/raring/agda-stdlib/raring

« back to all changes in this revision

Viewing changes to src/Category/Monad/Partiality.agda

  • Committer: Package Import Robot
  • Author(s): Iain Lane
  • Date: 2013-04-10 10:30:20 UTC
  • mfrom: (2.1.7 experimental)
  • Revision ID: package-import@ubuntu.com-20130410103020-bcspfz3whyy5iafu
Tags: 0.7-1
* [6d52289] Imported Upstream version 0.7
* [54104d0] Update Depends and Build-Depends for this version, compatible
  with Agda 2.3.2
* [b3ddce4] No need for the .install file to be executable (thanks lintian)
* [a9a6cb7] Standards-Version → 3.9.4, no changes required

Show diffs side-by-side

added added

removed removed

Lines of Context:
130
130
  _⇓_ : A ⊥ → A → Set _
131
131
  x ⇓ y = x ⇓[ other weak ] y
132
132
 
 
133
  -- x ⇓ means that x terminates.
 
134
 
 
135
  infix 4 _⇓
 
136
 
 
137
  _⇓ : A ⊥ → Set _
 
138
  x ⇓ = ∃ λ v → x ⇓ v
 
139
 
133
140
  -- x ⇑ means that x does not terminate.
134
141
 
135
142
  infix 4 _⇑[_] _⇑
143
150
------------------------------------------------------------------------
144
151
-- Lemmas relating the three relations
145
152
 
146
 
private
147
 
 module Dummy {a ℓ} {A : Set a} {_∼_ : A → A → Set ℓ} where
 
153
module _ {a ℓ} {A : Set a} {_∼_ : A → A → Set ℓ} where
148
154
 
149
155
  open Equality _∼_ using (Rel; _≅_; _≳_; _≲_; _≈_; _⇓[_]_; _⇑[_])
150
156
  open Equality.Rel
324
330
      module S {k eq} = Setoid (setoid isEquivalence k {eq})
325
331
 
326
332
    infix  2 _∎
327
 
    infixr 2 _≅⟨_⟩_ _≳⟨_⟩_ _≈⟨_⟩_
 
333
    infixr 2 _≡⟨_⟩_ _≅⟨_⟩_ _≳⟨_⟩_ _≈⟨_⟩_
 
334
 
 
335
    _≡⟨_⟩_ : ∀ {k} x {y z : A ⊥} → x ≡ y → Rel k y z → Rel k x z
 
336
    _ ≡⟨ P.refl ⟩ y∼z = y∼z
328
337
 
329
338
    _≅⟨_⟩_ : ∀ {k} x {y z : A ⊥} → x ≅ y → Rel k y z → Rel k x z
330
339
    _ ≅⟨ x≅y ⟩ y∼z = Pre.trans (≅⇒ x≅y) y∼z
432
441
               (x >>= λ _ → never) ≅ never
433
442
  right-zero (later x) = later (♯ right-zero (♭ x))
434
443
  right-zero (now   x) = never≅never
435
 
    where never≅never = later (♯ never≅never)
 
444
    where never≅never : never ≅ never
 
445
          never≅never = later (♯ never≅never)
436
446
 
437
447
  -- Now is a left and right identity of bind (for a reflexive
438
448
  -- underlying relation).
458
468
  associative refl-∼ (later x) f g =
459
469
    later (♯ associative refl-∼ (♭ x) f g)
460
470
 
461
 
open Dummy public
462
 
 
463
 
private
464
 
 module Dummy₂ {s ℓ} {A B : Set s}
465
 
               {_∼A_ : A → A → Set ℓ}
466
 
               {_∼B_ : B → B → Set ℓ} where
 
471
module _ {s ℓ} {A B : Set s}
 
472
         {_∼A_ : A → A → Set ℓ}
 
473
         {_∼B_ : B → B → Set ℓ} where
467
474
 
468
475
  open Equality
469
476
  private
527
534
                                          now z ∎)
528
535
                                    , ≳⇒ fz⇑)
529
536
 
530
 
open Dummy₂ public
531
 
 
532
 
private
533
 
 module Dummy₃ {ℓ} {A B : Set ℓ} {_∼_ : B → B → Set ℓ} where
 
537
module _ {ℓ} {A B : Set ℓ} {_∼_ : B → B → Set ℓ} where
534
538
 
535
539
  open Equality
536
540
 
545
549
    x₁≈x₂ >>=-cong λ {x} x≡x′ →
546
550
    P.subst (λ y → Rel _∼_ k (f₁ x) (f₂ y)) x≡x′ (f₁≈f₂ x)
547
551
 
548
 
open Dummy₃ public
549
 
 
550
552
------------------------------------------------------------------------
551
553
-- Productivity checker workaround
552
554
 
637
639
 
638
640
  infix  4 _∣_≅P_ _∣_≳P_ _∣_≈P_
639
641
  infix  2 _∎
640
 
  infixr 2 _≅⟨_⟩_ _≳⟨_⟩_ _≳⟨_⟩≅_ _≳⟨_⟩≈_ _≈⟨_⟩≅_ _≈⟨_⟩≲_
 
642
  infixr 2 _≡⟨_⟩_ _≅⟨_⟩_ _≳⟨_⟩_ _≳⟨_⟩≅_ _≳⟨_⟩≈_ _≈⟨_⟩≅_ _≈⟨_⟩≲_
641
643
  infixl 1 _>>=_
642
644
 
643
645
  mutual
682
684
 
683
685
      _∎      : ∀ {k} x → RelP S k x x
684
686
      sym     : ∀ {k x y} {eq : Equality k} (x∼y : RelP S k x y) → RelP S k y x
 
687
      _≡⟨_⟩_  : ∀ {k} x {y z} (x≡y : x ≡ y) (y∼z : RelP S k y z) → RelP S k x z
685
688
      _≅⟨_⟩_  : ∀ {k} x {y z} (x≅y : S ∣ x ≅P y) (y∼z : RelP S k y z) → RelP S k x z
686
689
      _≳⟨_⟩_  : let open Equality (Eq S) in
687
690
                ∀     x {y z} (x≳y :     x ≳  y) (y≳z : S ∣ y ≳P z) → S ∣ x ≳P z
772
775
    -- Strong equality programs can be turned into WHNFs.
773
776
 
774
777
    whnf≅ : ∀ {S x y} → S ∣ x ≅P y → RelW S strong x y
775
 
    whnf≅ (now xRy)         = now xRy
776
 
    whnf≅ (later x≅y)       = later (♭ x≅y)
777
 
    whnf≅ (x₁≅x₂ >>= f₁≅f₂) = whnf≅ x₁≅x₂ >>=W λ xRy → whnf≅ (f₁≅f₂ xRy)
778
 
    whnf≅ (x ∎)             = reflW x
779
 
    whnf≅ (sym x≅y)         = symW _ (whnf≅ x≅y)
780
 
    whnf≅ (x ≅⟨ x≅y ⟩ y≅z)  = trans≅W (whnf≅ x≅y) (whnf≅ y≅z)
 
778
    whnf≅ (now xRy)           = now xRy
 
779
    whnf≅ (later x≅y)         = later (♭ x≅y)
 
780
    whnf≅ (x₁≅x₂ >>= f₁≅f₂)   = whnf≅ x₁≅x₂ >>=W λ xRy → whnf≅ (f₁≅f₂ xRy)
 
781
    whnf≅ (x ∎)               = reflW x
 
782
    whnf≅ (sym x≅y)           = symW _ (whnf≅ x≅y)
 
783
    whnf≅ (x ≡⟨ P.refl ⟩ y≅z) = whnf≅ y≅z
 
784
    whnf≅ (x ≅⟨ x≅y    ⟩ y≅z) = trans≅W (whnf≅ x≅y) (whnf≅ y≅z)
781
785
 
782
786
    -- More transitivity lemmas.
783
787
 
804
808
    -- Order programs can be turned into WHNFs.
805
809
 
806
810
    whnf≳ : ∀ {S x y} → S ∣ x ≳P y → RelW S (other geq) x y
807
 
    whnf≳ (now xRy)           = now xRy
808
 
    whnf≳ (later  x∼y)        = later (♭ x∼y)
809
 
    whnf≳ (laterˡ x≲y)        = laterˡ (whnf≳ x≲y)
810
 
    whnf≳ (x₁∼x₂ >>= f₁∼f₂)   = whnf≳ x₁∼x₂ >>=W λ xRy → whnf≳ (f₁∼f₂ xRy)
811
 
    whnf≳ (x ∎)               = reflW x
 
811
    whnf≳ (now xRy)            = now xRy
 
812
    whnf≳ (later  x∼y)         = later (♭ x∼y)
 
813
    whnf≳ (laterˡ x≲y)         = laterˡ (whnf≳ x≲y)
 
814
    whnf≳ (x₁∼x₂ >>= f₁∼f₂)    = whnf≳ x₁∼x₂ >>=W λ xRy → whnf≳ (f₁∼f₂ xRy)
 
815
    whnf≳ (x ∎)                = reflW x
812
816
    whnf≳ (sym {eq = ()} x≅y)
813
 
    whnf≳ (x ≅⟨ x≅y ⟩  y≳z)   = trans≅∼W (whnf≅ x≅y) (whnf≳ y≳z)
814
 
    whnf≳ (x ≳⟨ x≳y ⟩  y≳z)   = trans≳-W        x≳y  (whnf≳ y≳z)
815
 
    whnf≳ (x ≳⟨ x≳y ⟩≅ y≅z)   = trans∼≅W (whnf≳ x≳y) (whnf≅ y≅z)
 
817
    whnf≳ (x ≡⟨ P.refl ⟩  y≳z) = whnf≳ y≳z
 
818
    whnf≳ (x ≅⟨ x≅y    ⟩  y≳z) = trans≅∼W (whnf≅ x≅y) (whnf≳ y≳z)
 
819
    whnf≳ (x ≳⟨ x≳y    ⟩  y≳z) = trans≳-W        x≳y  (whnf≳ y≳z)
 
820
    whnf≳ (x ≳⟨ x≳y    ⟩≅ y≅z) = trans∼≅W (whnf≳ x≳y) (whnf≅ y≅z)
816
821
 
817
822
    -- Another transitivity lemma.
818
823
 
828
833
    -- All programs can be turned into WHNFs.
829
834
 
830
835
    whnf : ∀ {S k x y} → RelP S k x y → RelW S k x y
831
 
    whnf (now xRy)           = now xRy
832
 
    whnf (later  x∼y)        = later     (♭ x∼y)
833
 
    whnf (laterʳ x≈y)        = laterʳ (whnf x≈y)
834
 
    whnf (laterˡ x∼y)        = laterˡ (whnf x∼y)
835
 
    whnf (x₁∼x₂ >>= f₁∼f₂)   = whnf x₁∼x₂ >>=W λ xRy → whnf (f₁∼f₂ xRy)
836
 
    whnf (x ∎)               = reflW x
837
 
    whnf (sym {eq = eq} x≈y) = symW eq (whnf x≈y)
838
 
    whnf (x ≅⟨ x≅y ⟩  y∼z)   = trans≅∼W (whnf x≅y) (whnf y∼z)
839
 
    whnf (x ≳⟨ x≳y ⟩  y≳z)   = trans≳-W       x≳y  (whnf y≳z)
840
 
    whnf (x ≳⟨ x≳y ⟩≅ y≅z)   = trans∼≅W (whnf x≳y) (whnf y≅z)
841
 
    whnf (x ≳⟨ x≳y ⟩≈ y≈z)   = trans≳≈W (whnf x≳y) (whnf y≈z)
842
 
    whnf (x ≈⟨ x≈y ⟩≅ y≅z)   = trans∼≅W (whnf x≈y) (whnf y≅z)
843
 
    whnf (x ≈⟨ x≈y ⟩≲ y≲z)   = symW _ (trans≳≈W (whnf y≲z) (symW _ (whnf x≈y)))
 
836
    whnf (now xRy)            = now xRy
 
837
    whnf (later  x∼y)         = later     (♭ x∼y)
 
838
    whnf (laterʳ x≈y)         = laterʳ (whnf x≈y)
 
839
    whnf (laterˡ x∼y)         = laterˡ (whnf x∼y)
 
840
    whnf (x₁∼x₂ >>= f₁∼f₂)    = whnf x₁∼x₂ >>=W λ xRy → whnf (f₁∼f₂ xRy)
 
841
    whnf (x ∎)                = reflW x
 
842
    whnf (sym {eq = eq} x≈y)  = symW eq (whnf x≈y)
 
843
    whnf (x ≡⟨ P.refl ⟩  y∼z) = whnf y∼z
 
844
    whnf (x ≅⟨ x≅y    ⟩  y∼z) = trans≅∼W (whnf x≅y) (whnf y∼z)
 
845
    whnf (x ≳⟨ x≳y    ⟩  y≳z) = trans≳-W       x≳y  (whnf y≳z)
 
846
    whnf (x ≳⟨ x≳y    ⟩≅ y≅z) = trans∼≅W (whnf x≳y) (whnf y≅z)
 
847
    whnf (x ≳⟨ x≳y    ⟩≈ y≈z) = trans≳≈W (whnf x≳y) (whnf y≈z)
 
848
    whnf (x ≈⟨ x≈y    ⟩≅ y≅z) = trans∼≅W (whnf x≈y) (whnf y≅z)
 
849
    whnf (x ≈⟨ x≈y    ⟩≲ y≲z) = symW _ (trans≳≈W (whnf y≲z) (symW _ (whnf x≈y)))
844
850
 
845
851
  mutual
846
852
 
864
870
  correct = equivalence sound complete
865
871
 
866
872
------------------------------------------------------------------------
 
873
-- Another lemma
 
874
 
 
875
-- Bind is "idempotent".
 
876
 
 
877
idempotent :
 
878
  ∀ {ℓ} {A : Set ℓ} (B : Setoid ℓ ℓ) →
 
879
  let open M; open Setoid B using (_≈_; Carrier); open Equality _≈_ in
 
880
  (x : A ⊥) (f : A → A → Carrier ⊥) →
 
881
  (x >>= λ y′ → x >>= λ y″ → f y′ y″) ≳ (x >>= λ y′ → f y′ y′)
 
882
idempotent {A = A} B x f = sound (idem x)
 
883
  where
 
884
  open AlternativeEquality hiding (_>>=_)
 
885
  open M
 
886
  open Equality.Rel using (laterˡ)
 
887
  open Equivalence using (refl)
 
888
 
 
889
  idem : (x : A ⊥) →
 
890
         B ∣ (x >>= λ y′ → x >>= λ y″ → f y′ y″) ≳P
 
891
             (x >>= λ y′ → f y′ y′)
 
892
  idem (now   x) = f x x ∎
 
893
  idem (later x) = later (♯ (
 
894
    (♭ x >>= λ y′ → later x >>= λ y″ → f y′ y″)  ≳⟨ (refl P.refl {x = ♭ x} ≡->>=-cong λ _ →
 
895
                                                     laterˡ (refl (Setoid.refl B))) ⟩
 
896
    (♭ x >>= λ y′ →     ♭ x >>= λ y″ → f y′ y″)  ≳⟨ idem (♭ x) ⟩≅
 
897
    (♭ x >>= λ y′ → f y′ y′)                     ∎))
 
898
 
 
899
------------------------------------------------------------------------
867
900
-- Example
868
901
 
869
902
private