feat: reactivate extendJoinPointContext at mono phase

closes #1686

cc @hargoniX
This commit is contained in:
Leonardo de Moura 2022-10-07 16:27:44 -07:00
parent 15ad5254a1
commit 45974229d2
5 changed files with 16 additions and 5 deletions

View file

@ -534,7 +534,7 @@ def Decl.extendJoinPointContext (decl : Decl) : CompilerM Decl := do
JoinPointContextExtender.extend decl
def extendJoinPointContext : Pass :=
.mkPerDeclaration `extendJoinPointContext Decl.extendJoinPointContext .base
.mkPerDeclaration `extendJoinPointContext Decl.extendJoinPointContext .mono
builtin_initialize
registerTraceClass `Compiler.extendJoinPointContext (inherited := true)

View file

@ -55,6 +55,10 @@ def builtinPassManager : PassManager := {
cse,
saveBase, -- End of base phase
toMono,
simp (occurrence := 3) (phase := .mono),
reduceJpArity (phase := .mono),
extendJoinPointContext,
simp (occurrence := 4) (phase := .mono),
-- TODO: lambda lifting, reduce function arity
saveMono -- End of mono phase
]

View file

@ -70,8 +70,8 @@ def Decl.reduceJpArity (decl : Decl) : CompilerM Decl := do
let value ← reduce decl.value |>.run {}
return { decl with value }
def reduceJpArity : Pass :=
.mkPerDeclaration `reduceJpArity Decl.reduceJpArity .base
def reduceJpArity (phase := Phase.base) : Pass :=
.mkPerDeclaration `reduceJpArity Decl.reduceJpArity phase
builtin_initialize
registerTraceClass `Compiler.reduceJpArity (inherited := true)

View file

@ -56,8 +56,8 @@ where
else
return decl
def simp (config : Config := {}) (occurrence : Nat := 0) : Pass :=
.mkPerDeclaration `simp (Decl.simp · config) .base (occurrence := occurrence)
def simp (config : Config := {}) (occurrence : Nat := 0) (phase := Phase.base) : Pass :=
.mkPerDeclaration `simp (Decl.simp · config) phase (occurrence := occurrence)
builtin_initialize
registerTraceClass `Compiler.simp (inherited := true)

7
tests/lean/run/1686.lean Normal file
View file

@ -0,0 +1,7 @@
import Lean
open Lean Meta
def substIssue (hLocalDecl : LocalDecl) : MetaM Unit := do
let error {α} _ : MetaM α := throwError "{hLocalDecl.type}"
let some (_, lhs, rhs) ← matchEq? hLocalDecl.type | error ()
error ()