53 lines
1.3 KiB
Lean4
53 lines
1.3 KiB
Lean4
|
namespace BidirTT
|
|||
|
|
|
|||
|
|
inductive Level where
|
|||
|
|
| zero : Level
|
|||
|
|
| succ : Level → Level
|
|||
|
|
| max : Level → Level → Level
|
|||
|
|
deriving Repr, Inhabited, BEq, DecidableEq
|
|||
|
|
|
|||
|
|
def Level.ofNat : Nat → Level
|
|||
|
|
| 0 => .zero
|
|||
|
|
| n + 1 => .succ (Level.ofNat n)
|
|||
|
|
|
|||
|
|
instance (n : Nat) : OfNat Level n where
|
|||
|
|
ofNat := Level.ofNat n
|
|||
|
|
|
|||
|
|
partial def Level.eval : Level → Nat
|
|||
|
|
| .zero => 0
|
|||
|
|
| .succ l => l.eval + 1
|
|||
|
|
| .max l r => Nat.max l.eval r.eval
|
|||
|
|
|
|||
|
|
def Level.normalise (l : Level) : Level :=
|
|||
|
|
.ofNat l.eval
|
|||
|
|
|
|||
|
|
def Level.succ' (l : Level) : Level :=
|
|||
|
|
.normalise (.succ l)
|
|||
|
|
|
|||
|
|
def Level.max' (l r : Level) : Level :=
|
|||
|
|
.normalise (.max l r)
|
|||
|
|
|
|||
|
|
def Level.pretty (l : Level) : String :=
|
|||
|
|
s!"{l.eval}"
|
|||
|
|
|
|||
|
|
abbrev LevelConstraint := Level × Level
|
|||
|
|
|
|||
|
|
def solveLevelConstraints (constraints : List LevelConstraint) : Except String Unit := do
|
|||
|
|
match constraints.find? fun (lhs, rhs) => lhs.eval > rhs.eval with
|
|||
|
|
| some (lhs, rhs) =>
|
|||
|
|
throw s!"unsatisfiable level constraint {lhs.pretty} <= {rhs.pretty}"
|
|||
|
|
| none =>
|
|||
|
|
pure ()
|
|||
|
|
|
|||
|
|
def Level.leq (lhs rhs : Level) : Except String Bool := do
|
|||
|
|
match solveLevelConstraints [(lhs, rhs)] with
|
|||
|
|
| Except.ok _ => pure true
|
|||
|
|
| Except.error _ => pure false
|
|||
|
|
|
|||
|
|
def Level.eqv (lhs rhs : Level) : Except String Bool := do
|
|||
|
|
match solveLevelConstraints [(lhs, rhs), (rhs, lhs)] with
|
|||
|
|
| Except.ok _ => pure true
|
|||
|
|
| Except.error _ => pure false
|
|||
|
|
|
|||
|
|
end BidirTT
|