merge duplicate Nat LTE'
This commit is contained in:
parent
2446655b08
commit
25f4923fac
3 changed files with 38 additions and 54 deletions
|
@ -2,6 +2,7 @@ module Quox.Context
|
||||||
|
|
||||||
import Quox.Syntax.Shift
|
import Quox.Syntax.Shift
|
||||||
import Quox.Pretty
|
import Quox.Pretty
|
||||||
|
import Quox.NatExtra
|
||||||
|
|
||||||
import Data.DPair
|
import Data.DPair
|
||||||
import Data.Nat
|
import Data.Nat
|
||||||
|
@ -151,34 +152,6 @@ export %inline
|
||||||
ftel <*> xtel = runIdentity $ (pure .) <$> ftel `app` xtel
|
ftel <*> xtel = runIdentity $ (pure .) <$> ftel `app` xtel
|
||||||
-- ...but can't write pure without `from,to` being ω, so no idiom brackets ☹
|
-- ...but can't write pure without `from,to` being ω, so no idiom brackets ☹
|
||||||
|
|
||||||
|
|
||||||
namespace Nat
|
|
||||||
public export
|
|
||||||
data LTE' : Nat -> Nat -> Type where
|
|
||||||
LTERefl : n `LTE'` n
|
|
||||||
LTESuccR : m `LTE'` n -> m `LTE'` S n
|
|
||||||
%builtin Natural LTE'
|
|
||||||
|
|
||||||
export %hint
|
|
||||||
lteZero' : {n : Nat} -> 0 `LTE'` n
|
|
||||||
lteZero' {n = 0} = LTERefl
|
|
||||||
lteZero' {n = S n} = LTESuccR lteZero'
|
|
||||||
|
|
||||||
export
|
|
||||||
lteSucc' : m `LTE'` n -> S m `LTE'` S n
|
|
||||||
lteSucc' LTERefl = LTERefl
|
|
||||||
lteSucc' (LTESuccR p) = LTESuccR (lteSucc' p)
|
|
||||||
|
|
||||||
export
|
|
||||||
lteToLte' : {n : Nat} -> m `LTE` n -> m `LTE'` n
|
|
||||||
lteToLte' LTEZero = lteZero'
|
|
||||||
lteToLte' (LTESucc p) = lteSucc' (lteToLte' p)
|
|
||||||
|
|
||||||
export
|
|
||||||
lte'ToLte : {n : Nat} -> m `LTE'` n -> m `LTE` n
|
|
||||||
lte'ToLte LTERefl = reflexive
|
|
||||||
lte'ToLte (LTESuccR p) = lteSuccRight (lte'ToLte p)
|
|
||||||
|
|
||||||
export
|
export
|
||||||
teleLte' : Telescope tm from to -> from `LTE'` to
|
teleLte' : Telescope tm from to -> from `LTE'` to
|
||||||
teleLte' [<] = LTERefl
|
teleLte' [<] = LTERefl
|
||||||
|
|
30
src/Quox/NatExtra.idr
Normal file
30
src/Quox/NatExtra.idr
Normal file
|
@ -0,0 +1,30 @@
|
||||||
|
module Quox.NatExtra
|
||||||
|
|
||||||
|
import public Data.Nat
|
||||||
|
|
||||||
|
|
||||||
|
public export
|
||||||
|
data LTE' : Nat -> Nat -> Type where
|
||||||
|
LTERefl : LTE' n n
|
||||||
|
LTESuccR : LTE' m n -> LTE' m (S n)
|
||||||
|
%builtin Natural LTE'
|
||||||
|
|
||||||
|
public export
|
||||||
|
lteZero' : {n : Nat} -> LTE' 0 n
|
||||||
|
lteZero' {n = 0} = LTERefl
|
||||||
|
lteZero' {n = S n} = LTESuccR lteZero'
|
||||||
|
|
||||||
|
public export
|
||||||
|
lteSucc' : LTE' m n -> LTE' (S m) (S n)
|
||||||
|
lteSucc' LTERefl = LTERefl
|
||||||
|
lteSucc' (LTESuccR p) = LTESuccR $ lteSucc' p
|
||||||
|
|
||||||
|
public export
|
||||||
|
fromLTE : {n : Nat} -> LTE m n -> LTE' m n
|
||||||
|
fromLTE LTEZero = lteZero'
|
||||||
|
fromLTE (LTESucc p) = lteSucc' $ fromLTE p
|
||||||
|
|
||||||
|
public export
|
||||||
|
toLte : {n : Nat} -> m `LTE'` n -> m `LTE` n
|
||||||
|
toLte LTERefl = reflexive
|
||||||
|
toLte (LTESuccR p) = lteSuccRight (toLte p)
|
|
@ -2,6 +2,8 @@
|
||||||
||| a smaller scope and part of a larger one.
|
||| a smaller scope and part of a larger one.
|
||||||
module Quox.OPE
|
module Quox.OPE
|
||||||
|
|
||||||
|
import Quox.NatExtra
|
||||||
|
|
||||||
import Data.Nat
|
import Data.Nat
|
||||||
|
|
||||||
|
|
||||||
|
@ -35,30 +37,9 @@ toLTE (Drop p) = lteSuccRight $ toLTE p
|
||||||
toLTE (Keep p) = LTESucc $ toLTE p
|
toLTE (Keep p) = LTESucc $ toLTE p
|
||||||
|
|
||||||
|
|
||||||
public export
|
|
||||||
data LTE' : Nat -> Nat -> Type where
|
|
||||||
LTERefl : (n : Nat) -> LTE' n n
|
|
||||||
LTESuccR : Lazy (LTE' m n) -> LTE' m (S n)
|
|
||||||
|
|
||||||
public export
|
|
||||||
lteZero' : {n : Nat} -> LTE' 0 n
|
|
||||||
lteZero' {n = 0} = LTERefl 0
|
|
||||||
lteZero' {n = S n} = LTESuccR $ delay lteZero'
|
|
||||||
|
|
||||||
public export
|
|
||||||
lteSucc' : LTE' m n -> LTE' (S m) (S n)
|
|
||||||
lteSucc' (LTERefl n) = LTERefl (S n)
|
|
||||||
lteSucc' (LTESuccR p) = LTESuccR $ delay $ lteSucc' p
|
|
||||||
|
|
||||||
public export
|
|
||||||
fromLTE : {n : Nat} -> LTE m n -> LTE' m n
|
|
||||||
fromLTE LTEZero = lteZero'
|
|
||||||
fromLTE (LTESucc p) = lteSucc' $ fromLTE p
|
|
||||||
|
|
||||||
|
|
||||||
public export
|
public export
|
||||||
dropInner' : LTE' m n -> OPE m n
|
dropInner' : LTE' m n -> OPE m n
|
||||||
dropInner' (LTERefl n) = Id
|
dropInner' LTERefl = Id
|
||||||
dropInner' (LTESuccR p) = Drop $ dropInner' $ force p
|
dropInner' (LTESuccR p) = Drop $ dropInner' $ force p
|
||||||
|
|
||||||
public export
|
public export
|
||||||
|
|
Loading…
Reference in a new issue