quox/lib/Quox/Syntax/Dim.idr

157 lines
3.4 KiB
Idris
Raw Normal View History

2021-07-20 16:05:19 -04:00
module Quox.Syntax.Dim
2023-05-01 21:06:25 -04:00
import Quox.Loc
2023-03-15 10:54:51 -04:00
import Quox.Name
2021-07-20 16:05:19 -04:00
import Quox.Syntax.Var
import Quox.Syntax.Subst
import Quox.Pretty
2023-03-15 10:54:51 -04:00
import Quox.Context
2021-07-20 16:05:19 -04:00
2022-02-26 20:17:42 -05:00
import Decidable.Equality
import Control.Function
2023-03-02 13:52:32 -05:00
import Derive.Prelude
2022-02-26 20:17:42 -05:00
2021-07-20 16:05:19 -04:00
%default total
2022-05-02 16:40:28 -04:00
%language ElabReflection
2021-07-20 16:05:19 -04:00
public export
data DimConst = Zero | One
%name DimConst e
2023-03-02 13:52:32 -05:00
%runElab derive "DimConst" [Eq, Ord, Show]
2023-01-26 13:54:46 -05:00
||| `ends l r e` returns `l` if `e` is `Zero`, or `r` if it is `One`.
public export
2023-04-15 09:13:01 -04:00
ends : Lazy a -> Lazy a -> DimConst -> a
2023-01-26 13:54:46 -05:00
ends l r Zero = l
ends l r One = r
2023-05-01 21:06:25 -04:00
export Uninhabited (Zero = One) where uninhabited _ impossible
export Uninhabited (One = Zero) where uninhabited _ impossible
public export
DecEq DimConst where
decEq Zero Zero = Yes Refl
decEq Zero One = No absurd
decEq One Zero = No absurd
decEq One One = Yes Refl
2021-07-20 16:05:19 -04:00
public export
data Dim : Nat -> Type where
2023-05-01 21:06:25 -04:00
K : DimConst -> Loc -> Dim d
B : Var d -> Loc -> Dim d
2021-07-20 16:05:19 -04:00
%name Dim.Dim p, q
2023-03-15 10:54:51 -04:00
%runElab deriveIndexed "Dim" [Eq, Ord, Show]
2022-05-06 18:57:23 -04:00
2023-05-01 21:06:25 -04:00
export
Located (Dim d) where
(K _ loc).loc = loc
(B _ loc).loc = loc
export
Relocatable (Dim d) where
setLoc loc (K e _) = K e loc
setLoc loc (B i _) = B i loc
export
PrettyHL DimConst where
2023-03-15 10:54:51 -04:00
prettyM = pure . hl Dim . ends "0" "1"
2021-07-20 16:05:19 -04:00
export
PrettyHL (Dim n) where
2023-05-01 21:06:25 -04:00
prettyM (K e _) = prettyM e
prettyM (B i _) = prettyVar DVar DVarErr (!ask).dnames i
2021-07-20 16:05:19 -04:00
2023-03-15 10:54:51 -04:00
export
prettyDim : (dnames : NContext d) -> Dim d -> Doc HL
prettyDim dnames p =
let env = MakePrettyEnv {
dnames = toSnocList' dnames, tnames = [<],
unicode = True, prec = Outer
} in
runReader env $ prettyM p
2021-07-20 16:05:19 -04:00
2023-01-26 13:54:46 -05:00
||| `endsOr l r x e` returns:
||| - `l` if `p` is `K Zero`;
||| - `r` if `p` is `K One`;
||| - `x` otherwise.
public export
endsOr : Lazy a -> Lazy a -> Lazy a -> Dim n -> a
2023-05-01 21:06:25 -04:00
endsOr l r x (K e _) = ends l r e
endsOr l r x (B _ _) = x
2023-01-26 13:54:46 -05:00
2022-04-06 14:32:56 -04:00
public export %inline
toConst : Dim 0 -> DimConst
2023-05-01 21:06:25 -04:00
toConst (K e _) = e
2022-04-06 14:32:56 -04:00
2021-07-20 16:05:19 -04:00
public export
2021-09-03 10:34:57 -04:00
DSubst : Nat -> Nat -> Type
2021-07-20 16:05:19 -04:00
DSubst = Subst Dim
export %inline
prettyDSubst : Pretty.HasEnv m => DSubst from to -> m (Doc HL)
2021-07-20 16:05:19 -04:00
prettyDSubst th =
2021-09-03 10:31:53 -04:00
prettySubstM prettyM (!ask).dnames DVar
2021-07-20 16:05:19 -04:00
!(ifUnicode "" "<") !(ifUnicode "" ">") th
2023-05-01 21:06:25 -04:00
public export FromVar Dim where fromVarLoc = B
2021-07-20 16:05:19 -04:00
2023-03-10 15:52:29 -05:00
2021-12-23 13:01:39 -05:00
export
CanShift Dim where
2023-05-01 21:06:25 -04:00
K e loc // _ = K e loc
B i loc // by = B (i // by) loc
2021-12-23 13:01:39 -05:00
2021-07-20 16:05:19 -04:00
export
CanSubstSelf Dim where
2023-05-01 21:06:25 -04:00
K e loc // _ = K e loc
B i loc // th = getLoc th i loc
2022-02-26 20:17:42 -05:00
2023-05-01 21:06:25 -04:00
export Uninhabited (B i loc1 = K e loc2) where uninhabited _ impossible
export Uninhabited (K e loc1 = B i loc2) where uninhabited _ impossible
2022-02-26 20:17:42 -05:00
2023-05-01 21:06:25 -04:00
public export
data Eqv : Dim d1 -> Dim d2 -> Type where
EK : K e _ `Eqv` K e _
EB : i `Eqv` j -> B i _ `Eqv` B j _
2022-02-26 20:17:42 -05:00
2023-05-01 21:06:25 -04:00
export Uninhabited (K e l1 `Eqv` B i l2) where uninhabited _ impossible
export Uninhabited (B i l1 `Eqv` K e l2) where uninhabited _ impossible
2022-02-26 20:17:42 -05:00
2023-05-01 21:06:25 -04:00
export
injectiveB : B i loc1 `Eqv` B j loc2 -> i `Eqv` j
injectiveB (EB e) = e
export
injectiveK : K e loc1 `Eqv` K f loc2 -> e = f
injectiveK EK = Refl
2022-02-26 20:17:42 -05:00
public export
2023-05-01 21:06:25 -04:00
decEqv : Dec2 Dim.Eqv
decEqv (K e _) (K f _) = case decEq e f of
Yes Refl => Yes EK
No n => No $ n . injectiveK
decEqv (B i _) (B j _) = case decEqv i j of
Yes y => Yes $ EB y
No n => No $ \(EB y) => n y
decEqv (B _ _) (K _ _) = No absurd
decEqv (K _ _) (B _ _) = No absurd
2023-01-20 20:34:28 -05:00
||| abbreviation for a bound variable like `BV 4` instead of
||| `B (VS (VS (VS (VS VZ))))`
public export %inline
2023-05-01 21:06:25 -04:00
BV : (i : Nat) -> (0 _ : LT i d) => (loc : Loc) -> Dim d
BV i loc = B (V i) loc
2023-03-25 15:48:49 -04:00
export
2023-04-15 09:13:01 -04:00
weakD : (by : Nat) -> Dim d -> Dim (by + d)
weakD by p = p // shift by