Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

fix: handle reordered indices in structural recursion #6116

Merged
merged 4 commits into from
Nov 18, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion src/Lean/Elab/PreDefinition/Structural/FindRecArg.lean
Original file line number Diff line number Diff line change
Expand Up @@ -243,7 +243,7 @@ def tryAllArgs (fnNames : Array Name) (xs : Array Expr) (values : Array Expr)
recArgInfoss := recArgInfoss.push recArgInfos
-- Put non-indices first
recArgInfoss := recArgInfoss.map nonIndicesFirst
trace[Elab.definition.structural] "recArgInfoss: {recArgInfoss.map (·.map (·.recArgPos))}"
trace[Elab.definition.structural] "recArgInfos:{indentD (.joinSep (recArgInfoss.flatten.toList.map (repr ·)) Format.line)}"
-- Inductive groups to consider
let groups ← inductiveGroups recArgInfoss.flatten
trace[Elab.definition.structural] "inductive groups: {groups}"
Expand Down
4 changes: 2 additions & 2 deletions src/Lean/Elab/PreDefinition/Structural/IndGroupInfo.lean
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@ constituents.
structure IndGroupInfo where
all : Array Name
numNested : Nat
deriving BEq, Inhabited
deriving BEq, Inhabited, Repr

def IndGroupInfo.ofInductiveVal (indInfo : InductiveVal) : IndGroupInfo where
all := indInfo.all.toArray
Expand Down Expand Up @@ -56,7 +56,7 @@ mutual structural recursion on such incompatible types.
structure IndGroupInst extends IndGroupInfo where
levels : List Level
params : Array Expr
deriving Inhabited
deriving Inhabited, Repr

def IndGroupInst.toMessageData (igi : IndGroupInst) : MessageData :=
mkAppN (.const igi.all[0]! igi.levels) igi.params
Expand Down
17 changes: 10 additions & 7 deletions src/Lean/Elab/PreDefinition/Structural/RecArgInfo.lean
Original file line number Diff line number Diff line change
Expand Up @@ -23,9 +23,9 @@ structure RecArgInfo where
fnName : Name
/-- the fixed prefix of arguments of the function we are trying to justify termination using structural recursion. -/
numFixed : Nat
/-- position of the argument (counted including fixed prefix) we are recursing on -/
/-- position (counted including fixed prefix) of the argument we are recursing on -/
recArgPos : Nat
/-- position of the indices (counted including fixed prefix) of the inductive datatype indices we are recursing on -/
/-- position (counted including fixed prefix) of the indices of the inductive datatype we are recursing on -/
indicesPos : Array Nat
/-- The inductive group (with parameters) of the argument's type -/
indGroupInst : IndGroupInst
Expand All @@ -34,20 +34,23 @@ structure RecArgInfo where
If `< indAll.all`, a normal data type, else an auxiliary data type due to nested recursion
-/
indIdx : Nat
deriving Inhabited
deriving Inhabited, Repr

/--
If `xs` are the parameters of the functions (excluding fixed prefix), partitions them
into indices and major arguments, and other parameters.
-/
def RecArgInfo.pickIndicesMajor (info : RecArgInfo) (xs : Array Expr) : (Array Expr × Array Expr) := Id.run do
-- First indices and major arg, using the order they appear in `info.indicesPos`
let mut indexMajorArgs := #[]
let indexMajorPos := info.indicesPos.push info.recArgPos
for j in indexMajorPos do
assert! info.numFixed ≤ j && j - info.numFixed < xs.size
indexMajorArgs := indexMajorArgs.push xs[j - info.numFixed]!
-- Then the other arguments, in the order they appear in `xs`
let mut otherArgs := #[]
for h : i in [:xs.size] do
let j := i + info.numFixed
if j = info.recArgPos || info.indicesPos.contains j then
indexMajorArgs := indexMajorArgs.push xs[i]
else
unless indexMajorPos.contains (i + info.numFixed) do
otherArgs := otherArgs.push xs[i]
return (indexMajorArgs, otherArgs)

Expand Down
21 changes: 21 additions & 0 deletions tests/lean/run/issue6015.lean
Original file line number Diff line number Diff line change
@@ -0,0 +1,21 @@
private axiom test_sorry : ∀ {α}, α

inductive Tyₛ (l : List Unit): Type
| U : Tyₛ l
open Tyₛ

inductive Varₚ (d : Unit): List Unit → Type
| vz : Varₚ d [d']
| vs : Varₚ d l → Varₚ d (Bₛ :: l)

inductive Tmₛ {l : List Unit}: Tyₛ l → Unit → Type 1
| arr : (T : Type) → Tmₛ A d → Tmₛ A d
| param : Varₚ d l → Tmₛ A d → Tmₛ (@U l) d

def TmₛA {l : List Unit} {d : Unit} (nonIndex : Bool) {Aₛ : Tyₛ l} (t : Tmₛ Aₛ d): Type :=
match t with
| .arr dom cd =>
let cd := TmₛA nonIndex cd
dom → cd
| _ => test_sorry
termination_by structural t
Loading