feat: goodies for writing notation with binders
This commit is contained in:
parent
bf242f434d
commit
99fad9fc4d
3 changed files with 84 additions and 0 deletions
|
|
@ -16,3 +16,4 @@ import Init.Util
|
|||
import Init.Fix
|
||||
import Init.Meta
|
||||
import Init.Tactics
|
||||
import Init.NotationExtra
|
||||
|
|
|
|||
67
src/Init/NotationExtra.lean
Normal file
67
src/Init/NotationExtra.lean
Normal file
|
|
@ -0,0 +1,67 @@
|
|||
/-
|
||||
Copyright (c) 2020 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
|
||||
Extra notation that depends on Init/Meta
|
||||
-/
|
||||
prelude
|
||||
import Init.Meta
|
||||
|
||||
namespace Lean
|
||||
-- Auxiliary parsers and functions for declaring notation with binders
|
||||
|
||||
syntax binderIdent := ident <|> "_"
|
||||
syntax unbracktedExplicitBinders := binderIdent+ (" : " term)?
|
||||
syntax bracketedExplicitBinders := "(" binderIdent+ " : " term ")"
|
||||
syntax explicitBinders := bracketedExplicitBinders+ <|> unbracktedExplicitBinders
|
||||
|
||||
def expandExplicitBindersAux (combinator : Syntax) (idents : Array Syntax) (type? : Option Syntax) (body : Syntax) : MacroM Syntax :=
|
||||
let rec loop (i : Nat) (acc : Syntax) := do
|
||||
match i with
|
||||
| 0 => pure acc
|
||||
| i+1 =>
|
||||
let ident := idents[i][0]
|
||||
let acc ← match ident.isIdent, type? with
|
||||
| true, none => `($combinator fun $ident => $acc)
|
||||
| true, some type => `($combinator fun $ident:ident : $type => $acc)
|
||||
| false, none => `($combinator fun _ => $acc)
|
||||
| false, some type => `($combinator fun _ : $type => $acc)
|
||||
loop i (acc.copyInfo (← getRef))
|
||||
loop idents.size body
|
||||
|
||||
def expandBrackedBindersAux (combinator : Syntax) (binders : Array Syntax) (body : Syntax) : MacroM Syntax :=
|
||||
let rec loop (i : Nat) (acc : Syntax) := do
|
||||
match i with
|
||||
| 0 => pure acc
|
||||
| i+1 =>
|
||||
let idents := binders[i][1].getArgs
|
||||
let type := binders[i][3]
|
||||
loop i (← expandExplicitBindersAux combinator idents (some type) acc)
|
||||
loop binders.size body
|
||||
|
||||
def expandExplicitBinders (combinatorDeclName : Name) (explicitBinders : Syntax) (body : Syntax) : MacroM Syntax := do
|
||||
let combinator := mkIdentFrom (← getRef) combinatorDeclName
|
||||
let explicitBinders := explicitBinders[0]
|
||||
if explicitBinders.getKind == `Lean.unbracktedExplicitBinders then
|
||||
let idents := explicitBinders[0].getArgs
|
||||
let type? := if explicitBinders[1].isNone then none else some explicitBinders[1][1]
|
||||
expandExplicitBindersAux combinator idents type? body
|
||||
else if explicitBinders.getArgs.all (·.getKind == `Lean.bracketedExplicitBinders) then
|
||||
expandBrackedBindersAux combinator explicitBinders.getArgs body
|
||||
else
|
||||
Macro.throwError "unexpected explicit binder"
|
||||
|
||||
def expandBrackedBinders (combinatorDeclName : Name) (bracketedExplicitBinders : Syntax) (body : Syntax) : MacroM Syntax := do
|
||||
let combinator := mkIdentFrom (← getRef) combinatorDeclName
|
||||
expandBrackedBindersAux combinator #[bracketedExplicitBinders] body
|
||||
|
||||
end Lean
|
||||
|
||||
open Lean
|
||||
|
||||
macro "∃" xs:explicitBinders ", " b:term : term => expandExplicitBinders `Exists xs b
|
||||
macro "Σ" xs:explicitBinders ", " b:term : term => expandExplicitBinders `Sigma xs b
|
||||
macro "Σ'" xs:explicitBinders ", " b:term : term => expandExplicitBinders `PSigma xs b
|
||||
macro:25 xs:bracketedExplicitBinders "×" b:term : term => expandBrackedBinders `Sigma xs b
|
||||
macro:25 xs:bracketedExplicitBinders "×'" b:term : term => expandBrackedBinders `PSigma xs b
|
||||
16
tests/lean/run/binderNotation.lean
Normal file
16
tests/lean/run/binderNotation.lean
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
#check ∃ x, x > 1
|
||||
#check ∃ (x y : Nat), x > y
|
||||
#check ∃ x y : Nat, x > y
|
||||
#check ∃ (x : Nat) (y : Nat), x > y
|
||||
|
||||
theorem ex1 : (∃ x y : Nat, x > y) = (∃ (x : Nat) (y : Nat), x > y) := rfl
|
||||
|
||||
abbrev Vector α n := { a : Array α // a.size = n }
|
||||
|
||||
#check Σ α n, Vector α n
|
||||
#check Σ (α : Type) (n : Nat), Vector α n
|
||||
#check (α : Type) × (n : Nat) × Vector α n
|
||||
|
||||
#check Σ' α n, Vector α n
|
||||
#check Σ' (α : Type) (n : Nat), Vector α n
|
||||
#check (α : Type) ×' (n : Nat) ×' Vector α n
|
||||
Loading…
Add table
Reference in a new issue