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:
Leonardo de Moura 2021-02-25 13:21:53 -08:00
parent d9d948087f
commit d770c55326
2 changed files with 32 additions and 9 deletions

View file

@ -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
View 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)