quox/src/Quox/Syntax/Var.idr

143 lines
4.1 KiB
Idris
Raw Normal View History

2021-07-20 16:05:19 -04:00
module Quox.Syntax.Var
import Quox.Name
import Data.Nat
import Data.Maybe
import Data.List
import Quox.Pretty
%default total
public export
data Var : Nat -> Type where
VZ : Var (S n)
VS : Var n -> Var (S n)
%name Var i, j
%builtin Natural Var
public export
(.nat) : Var n -> Nat
(VZ).nat = 0
(VS i).nat = S i.nat
%transform "Var.(.nat)" Var.(.nat) i = believe_me i
public export Cast (Var n) Nat where cast n = n.nat
export Eq (Var n) where i == j = i.nat == j.nat
export Ord (Var n) where compare i j = compare i.nat j.nat
export Show (Var n) where showPrec d i = showCon d "V" $ showArg i.nat
private
prettyIndex : Nat -> Pretty.M (Doc a)
prettyIndex i =
ifUnicode (pretty $ pack $ map sup $ unpack $ show i) (":" <+> pretty i)
where
sup : Char -> Char
sup c = case c of
'0' => ''; '1' => '¹'; '2' => '²'; '3' => '³'; '4' => ''
'5' => ''; '6' => ''; '7' => ''; '8' => ''; '9' => ''; _ => c
||| `prettyVar hlok hlerr names i` pretty prints the de Bruijn index `i`.
|||
||| If it is within the bounds of `names`, then it uses the name at that index,
||| highlighted as `hlok`. Otherwise it is just printed as a number highlighted
||| as `hlerr`.
export
prettyVar' : HL -> HL -> List Name -> Nat -> Pretty.M (Doc HL)
prettyVar' hlok hlerr names i =
case inBounds i names of
Yes _ => hlF' hlok [|prettyM (index i names) <+> prettyIndex i|]
No _ => pure $ hl hlerr $ pretty i
export %inline
prettyVar : HL -> HL -> List Name -> Var n -> Pretty.M (Doc HL)
prettyVar hlok hlerr names i = prettyVar' hlok hlerr names i.nat
public export
fromNatWith : (i : Nat) -> (0 p : i `LT` n) -> Var n
fromNatWith Z (LTESucc _) = VZ
fromNatWith (S i) (LTESucc p) = VS $ fromNatWith i p
%transform "Var.fromNatWith" fromNatWith i p = believe_me i
public export %inline
V : (i : Nat) -> {auto 0 p : i `LT` n} -> Var n
V i {p} = fromNatWith i p
public export %inline
tryFromNat : Alternative f => (n : Nat) -> Nat -> f (Var n)
tryFromNat n i =
case i `isLT` n of
Yes p => pure $ fromNatWith i p
No _ => empty
export
0 toNatLT : (i : Var n) -> i.nat `LT` n
toNatLT VZ = LTESucc LTEZero
toNatLT (VS i) = LTESucc $ toNatLT i
export
0 toNatInj : {i, j : Var n} -> i.nat = j.nat -> i = j
toNatInj {i = VZ} {j = VZ} Refl = Refl
toNatInj {i = VZ} {j = (VS i)} Refl impossible
toNatInj {i = (VS i)} {j = VZ} Refl impossible
toNatInj {i = (VS i)} {j = (VS j)} prf =
cong VS $ toNatInj $ succInjective _ _ prf
export
0 fromToNat : (i : Var n) -> (p : i.nat `LT` n) -> fromNatWith i.nat p = i
fromToNat VZ (LTESucc p) = Refl
fromToNat (VS i) (LTESucc p) = rewrite fromToNat i p in Refl
export
0 toFromNat : (i : Nat) -> (p : i `LT` n) -> (fromNatWith i p).nat = i
toFromNat 0 (LTESucc x) = Refl
toFromNat (S k) (LTESucc x) = cong S $ toFromNat k x
public export
(.int) : Var n -> Integer
i.int = natToInteger i.nat
%builtin NaturalToInteger Var.(.int)
public export Cast (Var n) Integer where cast i = i.int
-- not using %transform like other things because weakSpec requires the proof
-- to be relevant. but since only `LTESucc` is ever possible that seems
-- to be a bug?
export
weak : (0 p : m `LTE` n) -> Var m -> Var n
weak p i = fromNatWith i.nat $ transitive (toNatLT i) p {rel=LTE}
public export
0 weakSpec : m `LTE` n -> Var m -> Var n
weakSpec LTEZero _ impossible
weakSpec (LTESucc p) VZ = VZ
weakSpec (LTESucc p) (VS i) = VS $ weakSpec p i
export
0 weakSpecCorrect : (p : m `LTE` n) -> (i : Var m) -> (weakSpec p i).nat = i.nat
weakSpecCorrect LTEZero _ impossible
weakSpecCorrect (LTESucc x) VZ = Refl
weakSpecCorrect (LTESucc x) (VS i) = cong S $ weakSpecCorrect x i
export
0 weakCorrect : (p : m `LTE` n) -> (i : Var m) -> (weak p i).nat = i.nat
weakCorrect LTEZero _ impossible
weakCorrect (LTESucc p) VZ = Refl
weakCorrect (LTESucc p) (VS i) = cong S $ weakCorrect p i
export
0 weakIsSpec : (p : m `LTE` n) -> (i : Var m) -> weak p i = weakSpec p i
weakIsSpec p i = toNatInj $ trans (weakCorrect p i) (sym $ weakSpecCorrect p i)
public export
interface FromVar f where %inline fromVar : Var n -> f n
public export FromVar Var where fromVar = id