84 lines
2.4 KiB
Idris
84 lines
2.4 KiB
Idris
module Quox.OPE.Comp
|
|
|
|
import Quox.OPE.Basics
|
|
import Quox.OPE.Length
|
|
import Quox.OPE.Sub
|
|
import Data.DPair
|
|
|
|
%default total
|
|
|
|
|
|
public export
|
|
data Comp : ys `Sub` zs -> xs `Sub` ys -> xs `Sub` zs -> Type where
|
|
CEE : Comp End End End
|
|
CKK : Comp p q pq -> Comp (Keep p) (Keep q) (Keep pq)
|
|
CKD : Comp p q pq -> Comp (Keep p) (Drop q) (Drop pq)
|
|
CD0 : Comp p q pq -> Comp (Drop p) q (Drop pq)
|
|
|
|
export
|
|
comp : (p : ys `Sub` zs) -> (q : xs `Sub` ys) -> Comp p q (p . q)
|
|
comp End End = CEE
|
|
comp (Keep p) (Keep q) = CKK (comp p q)
|
|
comp (Keep p) (Drop q) = CKD (comp p q)
|
|
comp (Drop p) q = CD0 (comp p q)
|
|
|
|
export
|
|
0 compOk : Comp p q r -> r = (p . q)
|
|
compOk CEE = Refl
|
|
compOk (CKK z) = cong Keep $ compOk z
|
|
compOk (CKD z) = cong Drop $ compOk z
|
|
compOk (CD0 z) = cong Drop $ compOk z
|
|
|
|
export
|
|
compZero : (sx : Length xs) => (sy : Length ys) =>
|
|
(p : xs `Sub` ys) -> Comp p (Sub.zero @{sx}) (Sub.zero @{sy})
|
|
compZero {sx = Z, sy = Z} End = CEE
|
|
compZero {sx = S _, sy = S _} (Keep p) = CKD (compZero p)
|
|
compZero {sy = S _} (Drop p) = CD0 (compZero p)
|
|
|
|
export
|
|
compIdLeft : (sy : Length ys) =>
|
|
(p : xs `Sub` ys) -> Comp (Sub.id @{sy}) p p
|
|
compIdLeft {sy = Z} End = CEE
|
|
compIdLeft {sy = S _} (Keep p) = CKK (compIdLeft p)
|
|
compIdLeft {sy = S _} (Drop p) = CKD (compIdLeft p)
|
|
|
|
export
|
|
compIdRight : (sx : Length xs) =>
|
|
(p : xs `Sub` ys) -> Comp p (Sub.id @{sx}) p
|
|
compIdRight {sx = Z} End = CEE
|
|
compIdRight {sx = S _} (Keep p) = CKK (compIdRight p)
|
|
compIdRight (Drop p) = CD0 (compIdRight p)
|
|
|
|
|
|
export
|
|
0 compAssoc : (p : ys `Sub` zs) -> (q : xs `Sub` ys) -> (r : ws `Sub` xs) ->
|
|
p . (q . r) = (p . q) . r
|
|
compAssoc End End End = Refl
|
|
compAssoc (Keep p) (Keep q) (Keep r) = cong Keep $ compAssoc p q r
|
|
compAssoc (Keep p) (Keep q) (Drop r) = cong Drop $ compAssoc p q r
|
|
compAssoc (Keep p) (Drop q) r = cong Drop $ compAssoc p q r
|
|
compAssoc (Drop p) q r = cong Drop $ compAssoc p q r
|
|
compAssoc End (Drop _) _ impossible
|
|
|
|
|
|
public export
|
|
Subscope : Scope a -> Type
|
|
Subscope ys = Exists (`Sub` ys)
|
|
|
|
public export
|
|
record SubMap {a : Type} {xs, ys, zs : Scope a}
|
|
(p : xs `Sub` zs) (q : ys `Sub` zs) where
|
|
constructor SM
|
|
thin : xs `Sub` ys
|
|
0 comp : Comp q thin p
|
|
|
|
parameters (p : xs `Sub` ys)
|
|
export
|
|
subId : SubMap p p
|
|
subId = SM id (compIdRight p)
|
|
|
|
export
|
|
subZero : SubMap Sub.zero p
|
|
subZero = SM zero (compZero p)
|