feat: universe level parameters in instances are outParam by default
This commit makes sure Lean 4 treats universe level parameters in instances as `outParam`s. This the behavior in Lean 3. fixes #319
This commit is contained in:
parent
d9d948087f
commit
d770c55326
2 changed files with 32 additions and 9 deletions
|
|
@ -510,15 +510,17 @@ private def preprocess (type : Expr) : MetaM Expr :=
|
|||
let type ← whnf type
|
||||
mkForallFVars xs type
|
||||
|
||||
private def preprocessLevels (us : List Level) : MetaM (List Level) := do
|
||||
let mut r := []
|
||||
private def preprocessLevels (us : List Level) : MetaM (List Level × Bool) := do
|
||||
let mut r := #[]
|
||||
let mut modified := false
|
||||
for u in us do
|
||||
let u ← instantiateLevelMVars u
|
||||
if u.hasMVar then
|
||||
r := (← mkFreshLevelMVar)::r
|
||||
r := r.push (← mkFreshLevelMVar)
|
||||
modified := true
|
||||
else
|
||||
r := u::r
|
||||
pure r.reverse
|
||||
r := r.push u
|
||||
return (r.toList, modified)
|
||||
|
||||
private partial def preprocessArgs (type : Expr) (i : Nat) (args : Array Expr) : MetaM (Array Expr) := do
|
||||
if h : i < args.size then
|
||||
|
|
@ -532,7 +534,7 @@ private partial def preprocessArgs (type : Expr) (i : Nat) (args : Array Expr) :
|
|||
| _ =>
|
||||
throwError "type class resolution failed, insufficient number of arguments" -- TODO improve error message
|
||||
else
|
||||
pure args
|
||||
return args
|
||||
|
||||
private def preprocessOutParam (type : Expr) : MetaM Expr :=
|
||||
forallTelescope type fun xs typeBody => do
|
||||
|
|
@ -540,15 +542,22 @@ private def preprocessOutParam (type : Expr) : MetaM Expr :=
|
|||
| c@(Expr.const constName us _) =>
|
||||
let env ← getEnv
|
||||
if !hasOutParams env constName then
|
||||
pure type
|
||||
/- We treat all universe level parameters as "outParam" -/
|
||||
let (us, modified) ← preprocessLevels us
|
||||
if modified then
|
||||
let c := mkConst constName us
|
||||
mkForallFVars xs (mkAppN c typeBody.getAppArgs)
|
||||
else
|
||||
return type
|
||||
else do
|
||||
let args := typeBody.getAppArgs
|
||||
let us ← preprocessLevels us
|
||||
let (us, _) ← preprocessLevels us
|
||||
let c := mkConst constName us
|
||||
let cType ← inferType c
|
||||
let args ← preprocessArgs cType 0 args
|
||||
mkForallFVars xs (mkAppN c args)
|
||||
| _ => pure type
|
||||
| _ =>
|
||||
return type
|
||||
|
||||
/-
|
||||
Remark: when `maxResultSize? == none`, the configuration option `synthInstance.maxResultSize` is used.
|
||||
|
|
|
|||
14
tests/lean/run/319.lean
Normal file
14
tests/lean/run/319.lean
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
class Class.{u} where
|
||||
dummy : PUnit.{u}
|
||||
|
||||
def notWork [Class.{u}] : PUnit := Class.dummy
|
||||
def alsoNotWork [Class.{1}] : PUnit := Class.dummy
|
||||
def work [Class.{u}] : PUnit.{u} := Class.dummy
|
||||
def alsoWork [Class.{u}] := Class.dummy.{u}
|
||||
|
||||
|
||||
class Category.{v, u} (Ob : Type u) where
|
||||
Hom : Ob → Ob → Type v
|
||||
|
||||
variable (C : Type u) [Category.{v} C] (X : C)
|
||||
#check (Category.Hom X X)
|
||||
Loading…
Add table
Reference in a new issue