add separate type for dimension endpoints

This commit is contained in:
rhiannon morris 2021-12-23 15:52:56 +01:00
parent 40fde92823
commit e833322ebe
2 changed files with 29 additions and 12 deletions

View file

@ -11,11 +11,11 @@ export
tm : Term 1 2 tm : Term 1 2
tm = tm =
(Pi Zero One "a" (BVT 0) (E (F "F" :@@ [BVT 0, FT "w"])) (Pi Zero One "a" (BVT 0) (E (F "F" :@@ [BVT 0, FT "w"]))
`DCloT` (DOne ::: id)) `DCloT` (K One ::: id))
`CloT` (F "y" ::: TYPE (U 1) :# TYPE (U 2) ::: id) `CloT` (F "y" ::: TYPE (U 1) :# TYPE (U 2) ::: id)
main : IO Unit main : IO Unit
main = do main = do
prettyTerm tm prettyTerm tm
prettyTerm $ pushSubstsT tm prettyTerm $ pushSubstsT tm
putStrLn ":qtuwu:" putStrLn "\n:qtuwu:"

View file

@ -7,26 +7,44 @@ import Quox.Pretty
%default total %default total
public export
data DimConst = Zero | One
%name DimConst e
private DCRepr : Type
DCRepr = Nat
private %inline dcrepr : DimConst -> DCRepr
dcrepr e = case e of Zero => 0; One => 1
export Eq DimConst where (==) = (==) `on` dcrepr
export Ord DimConst where compare = compare `on` dcrepr
public export public export
data Dim : Nat -> Type where data Dim : Nat -> Type where
DZero, DOne : Dim d K : DimConst -> Dim d
DBound : Var d -> Dim d B : Var d -> Dim d
%name Dim.Dim p, q %name Dim.Dim p, q
private DRepr : Type private DRepr : Type
DRepr = Nat DRepr = Nat
private %inline drepr : Dim n -> DRepr private %inline drepr : Dim n -> DRepr
drepr d = case d of DZero => 0; DOne => 1; DBound i => 2 + i.nat drepr p = case p of K i => dcrepr i; B i => 2 + i.nat
export Eq (Dim n) where (==) = (==) `on` drepr export Eq (Dim n) where (==) = (==) `on` drepr
export Ord (Dim n) where compare = compare `on` drepr export Ord (Dim n) where compare = compare `on` drepr
export
PrettyHL DimConst where
prettyM Zero = hl Dim <$> ifUnicode "𝟬" "0"
prettyM One = hl Dim <$> ifUnicode "𝟭" "1"
export export
PrettyHL (Dim n) where PrettyHL (Dim n) where
prettyM DZero = hl Dim <$> ifUnicode "𝟬" "0" prettyM (K e) = prettyM e
prettyM DOne = hl Dim <$> ifUnicode "𝟭" "1" prettyM (B i) = prettyVar DVar DVarErr (!ask).dnames i
prettyM (DBound i) = prettyVar DVar DVarErr (!ask).dnames i
public export public export
@ -41,10 +59,9 @@ prettyDSubst th =
!(ifUnicode "" "<") !(ifUnicode "" ">") th !(ifUnicode "" "<") !(ifUnicode "" ">") th
export FromVar Dim where fromVar = DBound export FromVar Dim where fromVar = B
export export
CanSubst Dim Dim where CanSubst Dim Dim where
DZero // _ = DZero K e // _ = K e
DOne // _ = DOne B i // th = th !! i
DBound i // th = th !! i