Compare commits

...

5 Commits

Author SHA1 Message Date
Leonardo de Moura
bc07b996fb feat: allow set_option to set grind config options 2025-10-27 00:30:08 -04:00
Leonardo de Moura
82f1c7efcb feat: configuration setter 2025-10-26 20:31:23 -07:00
Leonardo de Moura
1bac452ff0 fix: markPreInstance 2025-10-26 18:34:04 -07:00
Leonardo de Moura
1c1f9c575e feat: use grind tactic macro 2025-10-26 17:53:04 -07:00
Leonardo de Moura
eee7f380fa refactor: move Filter 2025-10-26 16:12:34 -07:00
11 changed files with 194 additions and 38 deletions

View File

@@ -83,6 +83,10 @@ that may have redundant arguments.
-/
syntax (name := instantiate) "instantiate" (&" only")? (&" approx")? (" [" withoutPosition(thm,*,?) "]")? : grind
/-- Shorthand for `instantiate only` -/
syntax (name := use) "use" " [" withoutPosition(thm,*,?) "]" : grind
macro_rules | `(grind| use%$u [$ts:thm,*]) => `(grind| instantiate%$u only [$ts,*])
-- **Note**: Should we rename the following tactics to `trace_`?
/-- Shows asserted facts. -/
syntax (name := showAsserted) "show_asserted" ppSpace grindFilter : grind

View File

@@ -0,0 +1,65 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
module
prelude
public import Lean.Elab.Command
meta import Lean.Elab.Command
public import Lean.Data.KVMap
public section
namespace Lean.Elab
open Command Meta
/--
Generates a function `setterName` for updating the `Bool` and `Nat` fields
of the structure `struct`.
This is a very simple implementation. There is no support for subobjects.
-/
meta def mkConfigSetter (doc? : Option (TSyntax ``Parser.Command.docComment))
(setterName struct : Ident) : CommandElabM Unit := do
let structName resolveGlobalConstNoOverload struct
let .inductInfo val getConstInfo structName
| throwErrorAt struct "`{structName}` is not s structure"
unless val.levelParams.isEmpty do
throwErrorAt struct "`{structName}` is universe polymorphic"
unless val.numIndices == 0 && val.numParams == 0 do
throwErrorAt struct "`{structName}` must not be parametric"
let env getEnv
let some structInfo := getStructureInfo? env structName
| throwErrorAt struct "`{structName}` is not a structure"
let code : Term liftTermElabM do
let mut code : Term `(throwError "invalid configuration option `{fieldName}`")
for fieldInfo in structInfo.fieldInfo do
if fieldInfo.subobject?.isSome then continue -- ignore subobject's
let projInfo getConstInfo fieldInfo.projFn
let fieldType forallTelescope projInfo.type fun _ body => pure body
-- **Note**: We only support `Nat` and `Bool` fields
let fieldIdent : Ident := mkCIdent fieldInfo.fieldName
if fieldType.isConstOf ``Nat then
code `(if fieldName == $(quote fieldInfo.fieldName) then
return { s with $fieldIdent:ident := ( getNatField) }
else $code)
else if fieldType.isConstOf ``Bool then
code `(if fieldName == $(quote fieldInfo.fieldName) then
return { s with $fieldIdent:ident := ( getBoolField) }
else $code)
return code
let cmd `(command|
$[$doc?:docComment]?
def $setterName (s : $struct) (fieldName : Name) (val : DataValue) : CoreM $struct :=
let getBoolField : CoreM Bool := do
let .ofBool b := val | throwError "`{fieldName}` is a Boolean"
return b
let getNatField : CoreM Nat := do
let .ofNat n := val | throwError "`{fieldName}` is a natural number"
return n
$code
)
elabCommand cmd
elab (name := elabConfigGetter) doc?:(docComment)? "declare_config_getter" setterName:ident type:ident : command => do
mkConfigSetter doc? setterName type
end Lean.Elab

View File

@@ -11,3 +11,4 @@ public import Lean.Elab.Tactic.Grind.BuiltinTactic
public import Lean.Elab.Tactic.Grind.ShowState
public import Lean.Elab.Tactic.Grind.Have
public import Lean.Elab.Tactic.Grind.Trace
public import Lean.Elab.Tactic.Grind.Config

View File

@@ -25,6 +25,7 @@ import Lean.Elab.Tactic.Basic
import Lean.Elab.Tactic.RenameInaccessibles
import Lean.Elab.Tactic.Grind.Filter
import Lean.Elab.Tactic.Grind.ShowState
import Lean.Elab.Tactic.Grind.Config
import Lean.Elab.SetOption
namespace Lean.Elab.Tactic.Grind
@@ -425,9 +426,30 @@ where
liftGrindM <| resetAnchors
replaceMainGoal [{ goal with mvarId }]
def isGrindConfigField? (stx : Syntax) : CoreM (Option Name) := do
unless stx.isIdent do return none
let id := stx.getId
let env getEnv
let info := getStructureInfo env ``Grind.Config
unless info.fieldNames.contains id do return none
return some id
@[builtin_grind_tactic setOption] def elabSetOption : GrindTactic := fun stx => do
let options Elab.elabSetOption stx[1] stx[3]
withOptions (fun _ => options) do evalGrindTactic stx[5]
if let some fieldName isGrindConfigField? stx[1] then
let val := stx[3]
let val match val.isNatLit? with
| some num => pure <| DataValue.ofNat num
| none => match val with
| Syntax.atom _ "true" => pure <| DataValue.ofBool true
| Syntax.atom _ "false" => pure <| DataValue.ofBool false
| _ => throwErrorAt val "`grind` configuration option must be a Boolean or a numeral"
let config := ( read).ctx.config
let config setConfigField config fieldName val
withReader (fun c => { c with ctx.config := config }) do
evalGrindTactic stx[5]
else
let options Elab.elabSetOption stx[1] stx[3]
withOptions (fun _ => options) do evalGrindTactic stx[5]
@[builtin_grind_tactic mbtc] def elabMBTC : GrindTactic := fun _ => do
liftGoalM do

View File

@@ -0,0 +1,16 @@
/-
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
module
prelude
public import Lean.CoreM
meta import Lean.Elab.Tactic.ConfigSetter
public section
namespace Lean.Elab.Tactic.Grind
/-- Sets a field of the `grind` configuration object. -/
declare_config_getter setConfigField Grind.Config
end Lean.Elab.Tactic.Grind

View File

@@ -6,18 +6,10 @@ Authors: Leonardo de Moura
module
prelude
public import Lean.Elab.Tactic.Grind.Basic
public import Lean.Meta.Tactic.Grind.Filter
import Init.Grind.Interactive
namespace Lean.Elab.Tactic.Grind
open Meta
public inductive Filter where
| true
| const (declName : Name)
| fvar (fvarId : FVarId)
| gen (pred : Nat Bool)
| or (a b : Filter)
| and (a b : Filter)
| not (a : Filter)
open Meta Grind
public partial def elabFilter (filter? : Option (TSyntax `grind_filter)) : GrindTacticM Filter := do
let some filter := filter? | return .true
@@ -44,27 +36,4 @@ where
| `(grind_filter| gen != $n:num) => let n := n.getNat; return .gen fun x => x != n
| _ => throwUnsupportedSyntax
open Meta.Grind
-- **Note**: facts may not have been internalized if they are equalities.
def getGen (e : Expr) : GoalM Nat := do
if ( alreadyInternalized e) then
getGeneration e
else match_expr e with
| Eq _ lhs rhs => return max ( getGeneration lhs) ( getGeneration rhs)
| _ => return 0
public def Filter.eval (filter : Filter) (e : Expr) : GoalM Bool := do
go filter
where
go (filter : Filter) : GoalM Bool := do
match filter with
| .true => return .true
| .and a b => go a <&&> go b
| .or a b => go a <||> go b
| .not a => return !( go a)
| .const declName => return Option.isSome <| e.find? fun e => e.isConstOf declName
| .fvar fvarId => return Option.isSome <| e.find? fun e => e.isFVar && e.fvarId! == fvarId
| .gen pred => let gen getGen e; return pred gen
end Lean.Elab.Tactic.Grind

View File

@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
module
prelude
public import Lean.Meta.Tactic.Grind.Attr
public import Lean.Meta.Tactic.Grind.RevertAll
@@ -45,6 +44,7 @@ public import Lean.Meta.Tactic.Grind.Anchor
public import Lean.Meta.Tactic.Grind.Action
public import Lean.Meta.Tactic.Grind.EMatchTheoremParam
public import Lean.Meta.Tactic.Grind.EMatchAction
public import Lean.Meta.Tactic.Grind.Filter
public section
namespace Lean

View File

@@ -0,0 +1,41 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
module
prelude
public import Lean.Meta.Tactic.Grind.Types
namespace Lean.Meta.Grind
public inductive Filter where
| true
| const (declName : Name)
| fvar (fvarId : FVarId)
| gen (pred : Nat Bool)
| or (a b : Filter)
| and (a b : Filter)
| not (a : Filter)
-- **Note**: facts may not have been internalized if they are equalities.
def getGen (e : Expr) : GoalM Nat := do
if ( alreadyInternalized e) then
getGeneration e
else match_expr e with
| Eq _ lhs rhs => return max ( getGeneration lhs) ( getGeneration rhs)
| _ => return 0
public def Filter.eval (filter : Filter) (e : Expr) : GoalM Bool := do
go filter
where
go (filter : Filter) : GoalM Bool := do
match filter with
| .true => return .true
| .and a b => go a <&&> go b
| .or a b => go a <||> go b
| .not a => return !( go a)
| .const declName => return Option.isSome <| e.find? fun e => e.isConstOf declName
| .fvar fvarId => return Option.isSome <| e.find? fun e => e.isFVar && e.fvarId! == fvarId
| .gen pred => let gen getGen e; return pred gen
end Lean.Meta.Grind

View File

@@ -640,6 +640,17 @@ We want to avoid instantiating the same theorem with the same assignment more th
Therefore, we store the (pre-)instance information in set.
Recall that the proofs of activated theorems have been hash-consed.
The assignment contains internalized expressions, which have also been hash-consed.
**Note**: We used to use pointer equality to implement `PreInstanceSet`. However,
this low-level trick was incorrect in interactive mode because we add new
`EMatchTheorem` objects using `instantiate [...]`. For example, suppose we write
```
instantiate [thm_1]; instantiate [thm_1]
```
The `EMatchTheorem` object `thm_1` is created twice. Using pointer equality will
miss instances created using the two different objects. Recall we do not use
hash-consing on proof objects. If we hash-cons the proof objects, it would be ok
to use pointer equality.
-/
structure PreInstance where
proof : Expr
@@ -647,14 +658,14 @@ structure PreInstance where
instance : Hashable PreInstance where
hash i := Id.run do
let mut r := hashPtrExpr i.proof
let mut r := hash i.proof -- **Note**: See note at `PreInstance`.
for v in i.assignment do
r := mixHash r (hashPtrExpr v)
return r
instance : BEq PreInstance where
beq i₁ i₂ := Id.run do
unless isSameExpr i₁.proof i₂.proof do return false
unless i₁.proof == i₂.proof do return false -- **Note**: See note at `PreInstance`.
unless i₁.assignment.size == i₂.assignment.size do return false
for v₁ in i₁.assignment, v₂ in i₂.assignment do
unless isSameExpr v₁ v₂ do return false

View File

@@ -0,0 +1,12 @@
opaque f : Nat Nat
opaque g : Nat Nat
theorem fax : f (x + 1) = g (f x) := sorry
/--
error: `instantiate` tactic failed to instantiate new facts, use `show_patterns` to see active theorems and their patterns.
-/
#guard_msgs in
example : f (x + 5) = a := by
grind =>
use [fax]; use [fax]; use [fax]; use [fax]; use [fax];
use [fax] -- Should fail - no new facts

View File

@@ -0,0 +1,15 @@
set_option warn.sorry false
opaque f : Nat Nat
opaque g : Nat Nat
theorem fax : f (x + 1) = g (f x) := sorry
example : f (x + 100) = a := by
grind =>
set_option gen 15 in
-- The following instantiations should not fail since we set
-- `gen` to 15
use [fax]; use [fax]; use [fax]; use [fax]; use [fax]
use [fax]; use [fax]; use [fax]; use [fax]; use [fax]
use [fax]; use [fax]; use [fax]; use [fax]; use [fax]
fail_if_success use [fax] -- should fail
sorry