Skip to content

Commit

Permalink
fix: [implemented_by] at functions defined by well-founded recursion
Browse files Browse the repository at this point in the history
closes #2899
  • Loading branch information
leodemoura committed Jun 19, 2024
1 parent 3e05b06 commit f7711c2
Show file tree
Hide file tree
Showing 7 changed files with 35 additions and 8 deletions.
8 changes: 6 additions & 2 deletions src/Lean/Elab/DeclModifiers.lean
Original file line number Diff line number Diff line change
Expand Up @@ -81,10 +81,14 @@ def Modifiers.isNonrec : Modifiers → Bool
| { recKind := .nonrec, .. } => true
| _ => false

/-- Store `attr` in `modifiers` -/
def Modifiers.addAttribute (modifiers : Modifiers) (attr : Attribute) : Modifiers :=
/-- Adds attribute `attr` in `modifiers` -/
def Modifiers.addAttr (modifiers : Modifiers) (attr : Attribute) : Modifiers :=
{ modifiers with attrs := modifiers.attrs.push attr }

/-- Filters attributes using `p` -/
def Modifiers.filterAttrs (modifiers : Modifiers) (p : Attribute → Bool) : Modifiers :=
{ modifiers with attrs := modifiers.attrs.filter p }

instance : ToFormat Modifiers := ⟨fun m =>
let components : List Format :=
(match m.docString? with
Expand Down
2 changes: 1 addition & 1 deletion src/Lean/Elab/Declaration.lean
Original file line number Diff line number Diff line change
Expand Up @@ -184,7 +184,7 @@ def elabInductive (modifiers : Modifiers) (stx : Syntax) : CommandElabM Unit :=
elabInductiveViews #[v]

def elabClassInductive (modifiers : Modifiers) (stx : Syntax) : CommandElabM Unit := do
let modifiers := modifiers.addAttribute { name := `class }
let modifiers := modifiers.addAttr { name := `class }
let v ← classInductiveSyntaxToView modifiers stx
elabInductiveViews #[v]

Expand Down
6 changes: 3 additions & 3 deletions src/Lean/Elab/DefView.lean
Original file line number Diff line number Diff line change
Expand Up @@ -135,8 +135,8 @@ open Meta
def mkDefViewOfAbbrev (modifiers : Modifiers) (stx : Syntax) : DefView :=
-- leading_parser "abbrev " >> declId >> optDeclSig >> declVal
let (binders, type) := expandOptDeclSig stx[2]
let modifiers := modifiers.addAttribute { name := `inline }
let modifiers := modifiers.addAttribute { name := `reducible }
let modifiers := modifiers.addAttr { name := `inline }
let modifiers := modifiers.addAttr { name := `reducible }
{ ref := stx, headerRef := mkNullNode stx.getArgs[:3], kind := DefKind.abbrev, modifiers,
declId := stx[1], binders, type? := type, value := stx[3] }

Expand All @@ -159,7 +159,7 @@ def mkDefViewOfInstance (modifiers : Modifiers) (stx : Syntax) : CommandElabM De
let prio ← liftMacroM <| expandOptNamedPrio stx[2]
let attrStx ← `(attr| instance $(quote prio):num)
let (binders, type) := expandDeclSig stx[4]
let modifiers := modifiers.addAttribute { kind := attrKind, name := `instance, stx := attrStx }
let modifiers := modifiers.addAttr { kind := attrKind, name := `instance, stx := attrStx }
let declId ← match stx[3].getOptional? with
| some declId =>
if ← isTracingEnabledFor `Elab.instance.mkInstanceName then
Expand Down
3 changes: 3 additions & 0 deletions src/Lean/Elab/PreDefinition/Basic.lean
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,9 @@ structure PreDefinition where
termination : WF.TerminationHints
deriving Inhabited

def PreDefinition.filterAttrs (preDef : PreDefinition) (p : Attribute → Bool) : PreDefinition :=
{ preDef with modifiers := preDef.modifiers.filterAttrs p }

def instantiateMVarsAtPreDecls (preDefs : Array PreDefinition) : TermElabM (Array PreDefinition) :=
preDefs.mapM fun preDef => do
pure { preDef with type := (← instantiateMVars preDef.type), value := (← instantiateMVars preDef.value) }
Expand Down
10 changes: 9 additions & 1 deletion src/Lean/Elab/PreDefinition/WF/Main.lean
Original file line number Diff line number Diff line change
Expand Up @@ -129,7 +129,15 @@ def wfRecursion (preDefs : Array PreDefinition) : TermElabM Unit := do
eraseRecAppSyntaxExpr value
/- `mkFix` invokes `decreasing_tactic` which may add auxiliary theorems to the environment. -/
let value ← unfoldDeclsFrom envNew value
return { unaryPreDef with value }
let unaryPreDef := { unaryPreDef with value }
/-
We must remove `implemented_by` attributes from the auxiliary application because
this attribute is only relevant for code that is compiled. Moreover, the `[implemented_by <decl>]`
attribute would check whether the `unaryPreDef` type matches with `<decl>`'s type, and produce
and error. See issue #2899
-/
let unaryPreDef := unaryPreDef.filterAttrs fun attr => attr.name != `implemented_by
return unaryPreDef
trace[Elab.definition.wf] ">> {preDefNonRec.declName} :=\n{preDefNonRec.value}"
let preDefs ← preDefs.mapM fun d => eraseRecAppSyntax d
-- Do not complain if the user sets @[semireducible], which usually is a noop,
Expand Down
2 changes: 1 addition & 1 deletion src/Lean/Elab/Structure.lean
Original file line number Diff line number Diff line change
Expand Up @@ -878,7 +878,7 @@ def structCtor := leading_parser try (declModifiers >> ident >> " :: "
def elabStructure (modifiers : Modifiers) (stx : Syntax) : CommandElabM Unit := do
checkValidInductiveModifier modifiers
let isClass := stx[0].getKind == ``Parser.Command.classTk
let modifiers := if isClass then modifiers.addAttribute { name := `class } else modifiers
let modifiers := if isClass then modifiers.addAttr { name := `class } else modifiers
let declId := stx[1]
let params := stx[2].getArgs
let exts := stx[3]
Expand Down
12 changes: 12 additions & 0 deletions tests/lean/run/2899.lean
Original file line number Diff line number Diff line change
@@ -0,0 +1,12 @@
def myfunUnsafe (x : Array α) (i : Fin x.size) : Array α :=
sorry

@[implemented_by myfunUnsafe]
def myfun (x : Array α) (i : Fin x.size) : Array α :=
let next := 2*i.1 + 1
if h : next < x.size then
have : x.size - next < x.size - i.1 := sorry
myfun (x.swap i ⟨next,h⟩) ⟨next, (x.size_swap _ _).symm ▸ h⟩
else
x
termination_by x.size - i.1

0 comments on commit f7711c2

Please sign in to comment.