feat: compute ReducibilityHints

This commit is contained in:
Leonardo de Moura 2020-03-16 14:16:20 -07:00
parent 2f3745c594
commit adf40096fc
3 changed files with 26 additions and 7 deletions

View file

@ -33,7 +33,7 @@ let (binders, type) := expandOptDeclSig (stx.getArg 2);
let modifiers := modifiers.addAttribute { name := `inline };
let modifiers := modifiers.addAttribute { name := `reducible };
elabDefLike {
ref := stx, kind := DefKind.def, modifiers := modifiers,
ref := stx, kind := DefKind.abbrev, modifiers := modifiers,
declId := stx.getArg 1, binders := binders, type? := type, val := stx.getArg 3
}

View file

@ -4,26 +4,28 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Sebastian Ullrich
-/
prelude
import Init.ShareCommon
import Init.Lean.Util.CollectLevelParams
import Init.Lean.Util.FoldConsts
import Init.Lean.Util.CollectFVars
import Init.Lean.Elab.DeclModifiers
import Init.Lean.Elab.Binders
import Init.ShareCommon
namespace Lean
namespace Elab
namespace Command
inductive DefKind
| «def» | «theorem» | «example» | «opaque»
| «def» | «theorem» | «example» | «opaque» | «abbrev»
def DefKind.isTheorem : DefKind → Bool
| DefKind.theorem => true
| _ => false
def DefKind.isDefOrOpaque : DefKind → Bool
def DefKind.isDefOrAbbrevOrOpaque : DefKind → Bool
| DefKind.def => true
| DefKind.opaque => true
| DefKind.abbrev => true
| _ => false
def DefKind.isExample : DefKind → Bool
@ -90,7 +92,7 @@ Term.synthesizeSyntheticMVars false;
type ← Term.instantiateMVars ref type;
val ← Term.instantiateMVars view.val val;
if view.kind.isExample then pure none
else withUsedWhen ref vars xs val type view.kind.isDefOrOpaque $ fun vars => do
else withUsedWhen ref vars xs val type view.kind.isDefOrAbbrevOrOpaque $ fun vars => do
type ← Term.mkForall ref xs type;
type ← Term.mkForall ref vars type;
val ← Term.mkLambda ref xs val;
@ -116,10 +118,16 @@ else withUsedWhen ref vars xs val type view.kind.isDefOrOpaque $ fun vars => do
pure $ some $ Declaration.thmDecl { name := declName, lparams := levelParams, type := type, value := Task.pure val }
| DefKind.opaque =>
pure $ some $ Declaration.opaqueDecl { name := declName, lparams := levelParams, type := type, value := val, isUnsafe := view.modifiers.isUnsafe }
| DefKind.def =>
| DefKind.abbrev =>
pure $ some $ Declaration.defnDecl {
name := declName, lparams := levelParams, type := type, value := val,
hints := ReducibilityHints.regular 0, -- TODO
hints := ReducibilityHints.abbrev,
isUnsafe := view.modifiers.isUnsafe }
| DefKind.def => do
env ← Term.getEnv;
pure $ some $ Declaration.defnDecl {
name := declName, lparams := levelParams, type := type, value := val,
hints := ReducibilityHints.regular (getMaxHeight env val + 1),
isUnsafe := view.modifiers.isUnsafe }
| _ => unreachable!

View file

@ -6,6 +6,7 @@ Authors: Leonardo de Moura
prelude
import Init.Control.Option
import Init.Lean.Expr
import Init.Lean.Environment
namespace Lean
namespace Expr
@ -60,4 +61,14 @@ end FoldConstsImpl
constant foldConsts {α : Type} (e : Expr) (init : α) (f : Name → αα) : α := init
end Expr
def getMaxHeight (env : Environment) (e : Expr) : UInt32 :=
e.foldConsts 0 $ fun constName max =>
match env.find? constName with
| ConstantInfo.defnInfo val =>
match val.hints with
| ReducibilityHints.regular h => if h > max then h else max
| _ => max
| _ => max
end Lean