summaryrefslogtreecommitdiff
path: root/src/Core/Generic.idr
blob: bd11fada79d5304f53f670cddc7b991987b8ce19 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
module Core.Generic

import Core.Context
import Core.Declarative
import Core.Environment
import Core.Reduction
import Core.Term
import Core.Term.NormalForm
import Core.Term.Substitution
import Core.Thinning
import Core.Var

%prefix_record_projections off

-- Definition ------------------------------------------------------------------

record GenericEquality where
  constructor MkEquality
  TypeEq : forall sx. Env sx -> Term sx -> Term sx -> Type
  TermEq : forall sx. Env sx -> Term sx -> Term sx -> Term sx -> Type
  NtrlEq : forall sx. Env sx -> Term sx -> Term sx -> Term sx -> Type

interface IsGenericEquality (eq : GenericEquality) where
  -- Subsumption
  ntrlImpliesTermEq : eq.NtrlEq {sx} env t u a -> eq.TermEq env t u a
  termImpliesTypeEq : eq.TermEq {sx} env a b Set -> eq.TypeEq env a b
  eqImpliesTermConv : eq.TermEq {sx} env t u a -> TermConv env t u a
  eqImpliesTypeConv : eq.TypeEq {sx} env a b -> TypeConv env a b

  -- Partial Equivalence
  ntrlSym : eq.NtrlEq {sx} env t u a -> eq.NtrlEq env u t a
  ntrlTrans : eq.NtrlEq {sx} env t u a -> eq.NtrlEq env u v a -> eq.NtrlEq env t v a
  termSym : eq.TermEq {sx} env t u a -> eq.TermEq env u t a
  termTrans : eq.TermEq {sx} env t u a -> eq.TermEq env u v a -> eq.TermEq env t v a
  typeSym : eq.TypeEq {sx} env a b -> eq.TypeEq env b a
  typeTrans : eq.TypeEq {sx} env a b -> eq.TypeEq env b c -> eq.TypeEq env a c

  -- Conversion
  ntrlConv : eq.NtrlEq {sx} env t u a -> TypeConv env a b -> eq.NtrlEq env t u b
  termConv : eq.TermEq {sx} env t u a -> TypeConv env a b -> eq.TermEq env t u b

  -- Weakening
  wknPresNtrlEq :
    eq.NtrlEq {sx} env1 t u a ->
    EnvWf env2 ->
    IsExtension thin env2 env1 ->
    eq.NtrlEq {sx = sy} env2 (wkn t thin) (wkn u thin) (wkn a thin)
  wknPresTermEq :
    eq.TermEq {sx} env1 t u a ->
    EnvWf env2 ->
    IsExtension thin env2 env1 ->
    eq.TermEq {sx = sy} env2 (wkn t thin) (wkn u thin) (wkn a thin)
  wknPresTypeEq :
    eq.TypeEq {sx} env1 a b ->
    EnvWf env2 ->
    IsExtension thin env2 env1 ->
    eq.TypeEq {sx = sy} env2 (wkn a thin) (wkn b thin)

  -- Weak Head Expansion
  typeExpansion :
    TypeRed env a a' ->
    TypeRed env b b' ->
    Whnf a' ->
    Whnf b' ->
    eq.TypeEq {sx} env a' b' ->
    eq.TypeEq env a b
  termExpansion :
    TypeRed env a b ->
    TermRed env t t' b ->
    TermRed env u u' b ->
    Whnf b ->
    Whnf t' ->
    Whnf u' ->
    eq.TermEq {sx} env t' u' b ->
    eq.TermEq env t u a

  -- Type Constructor Congruence
  typeSet :
    EnvWf env ->
    ---
    eq.TypeEq {sx} env Set Set
  typePi :
    TypeWf env f ->
    eq.TypeEq env f h ->
    eq.TypeEq (env :< f) g e ->
    ---
    eq.TypeEq {sx} env (Pi n f g) (Pi n h e)

  -- Term Constructor Congruence and η
  termPi :
    TypeWf env f ->
    eq.TermEq env f h Set ->
    eq.TermEq (env :< f) g e Set ->
    ---
    eq.TermEq {sx} env (Pi n f g) (Pi n h e) Set
  termPiEta :
    TypeWf env f ->
    TermWf env t (Pi n f g) ->
    TermWf env u (Pi n f g) ->
    eq.TermEq (env :< f)
      (App (wkn t (wkn1 _ n)) (Var Var.here))
      (App (wkn u (wkn1 _ n)) (Var Var.here))
      g ->
    ---
    eq.TermEq {sx} env t u (Pi n f g)

  -- Neutral Congruence
  ntrlVar :
    TermWf env (Var i) a ->
    ---
    eq.NtrlEq {sx} env (Var i) (Var i) a
  ntrlApp :
    eq.NtrlEq env t u (Pi n f g) ->
    eq.TermEq env a b f ->
    ---
    eq.NtrlEq {sx} env (App t a) (App u b) (subst g (sub1 a))

-- Judgemental Equality --------------------------------------------------------

Judgemental : GenericEquality
Judgemental = MkEquality TypeConv TermConv TermConv

IsGenericEquality Judgemental where
  ntrlImpliesTermEq = id
  termImpliesTypeEq = LiftConv
  eqImpliesTermConv = id
  eqImpliesTypeConv = id

  ntrlSym = SymTerm
  ntrlTrans = TransTerm
  termSym = SymTerm
  termTrans = TransTerm
  typeSym = SymType
  typeTrans = TransType

  ntrlConv = ConvTermConv
  termConv = ConvTermConv

  wknPresNtrlEq = wknPresTermConv
  wknPresTermEq = wknPresTermConv
  wknPresTypeEq = wknPresTypeConv

  typeExpansion steps1 steps2 n m conv =
    TransType (typeRedImpliesTypeConv steps1) $
    TransType conv $
    SymType (typeRedImpliesTypeConv steps2)
  termExpansion steps1 steps2 steps3 n m k conv =
    ConvTermConv
      (TransTerm (termRedImpliesTermConv steps2) $
       TransTerm conv $
       SymTerm (termRedImpliesTermConv steps3))
      (SymType $ typeRedImpliesTypeConv steps1)

  typeSet = ReflType . SetType
  typePi = PiTypeConv

  termPi = PiTermConv
  termPiEta = PiEta

  ntrlVar = ReflTerm
  ntrlApp = AppConv