max/lean4-htt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 2

feat: make infix non-associative

Browse source
This commit is contained in:
Sebastian Ullrich 2021-03-22 16:06:39 +01:00
parent 2180898192
commit cd4cd581be
2 changed files with 10 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
src/Lean/Elab/Syntax.lean
View file

@ -380,15 +380,17 @@ def elabNoKindMacroRulesAux (alts : Array Syntax) : CommandElabM Syntax := do
@[builtinMacro Lean.Parser.Command.mixfix] def expandMixfix : Macro := fun stx =>
withAttrKindGlobal stx fun stx => do
match stx with
| `(infix $[: $prec]? $[(name := $name)]? $[(priority := $prio)]? $op => $f) =>
`(infixl $[: $prec]? $[(name := $name)]? $[(priority := $prio)]? $op => $f)
| `(infixr $[: $prec]? $[(name := $name)]? $[(priority := $prio)]? $op => $f) =>
`(notation $[: $prec]? $[(name := $name)]? $[(priority := $prio)]? lhs $op:strLit rhs $[: $prec]? => $f lhs rhs)
| `(infixl $[: $prec]? $[(name := $name)]? $[(priority := $prio)]? $op => $f) =>
let prec1 := quote <| (← evalOptPrec prec) + 1
`(notation $[: $prec]? $[(name := $name)]? $[(priority := $prio)]? lhs $op:strLit rhs:$prec1 => $f lhs rhs)
let prec1 := quote <| (← evalOptPrec prec) + 1
`(notation $[: $prec]? $[(name := $name)]? $[(priority := $prio)]? lhs$[:$prec]? $op:strLit rhs:$prec1 => $f lhs rhs)
| `(infix $[: $prec]? $[(name := $name)]? $[(priority := $prio)]? $op => $f) =>
let prec1 := quote <| (← evalOptPrec prec) + 1
`(notation $[: $prec]? $[(name := $name)]? $[(priority := $prio)]? lhs:$prec1 $op:strLit rhs:$prec1 => $f lhs rhs)
| `(infixr $[: $prec]? $[(name := $name)]? $[(priority := $prio)]? $op => $f) =>
let prec1 := quote <| (← evalOptPrec prec) + 1
`(notation $[: $prec]? $[(name := $name)]? $[(priority := $prio)]? lhs:$prec1 $op:strLit rhs $[: $prec]? => $f lhs rhs)
| `(prefix $[: $prec]? $[(name := $name)]? $[(priority := $prio)]? $op => $f) =>
`(notation $[: $prec]? $[(name := $name)]? $[(priority := $prio)]? $op:strLit arg $[: $prec]? => $f arg)
`(notation $[: $prec]? $[(name := $name)]? $[(priority := $prio)]? $op:strLit arg $[: $prec]? => $f arg)
| `(postfix $[: $prec]? $[(name := $name)]? $[(priority := $prio)]? $op => $f) =>
`(notation $[: $prec]? $[(name := $name)]? $[(priority := $prio)]? arg $op:strLit => $f arg)
| _ => Macro.throwUnsupported

2
tests/lean/run/balg.lean
View file

@ -14,7 +14,7 @@ abbrev mul {M : Magma} (a b : M) : M :=
set_option pp.all true
infix:70 (priority := high) "*" => mul
infixl:70 (priority := high) "*" => mul
structure Semigroup extends Magma where
mul_assoc (a b c : α) : a * b * c = a * (b * c)