diff --git a/src/Lean/CoreM.lean b/src/Lean/CoreM.lean index 49ebca437b..3943c5dfae 100644 --- a/src/Lean/CoreM.lean +++ b/src/Lean/CoreM.lean @@ -102,14 +102,23 @@ partial def mkUniqueName (env : Environment) (g : DeclNameGenerator) («infix» let «infix» := if g.namePrefix.hasMacroScopes && infix.hasMacroScopes then infix.eraseMacroScopes else «infix» let base := g.namePrefix ++ «infix» let mut g := g + while isConflict (curr g base) do + g := g.next + return (curr g base, g) +where + -- Check whether the name conflicts with an existing one. Conflicts ignore privacy. -- NOTE: We only check the current branch and rely on the documented invariant instead because we -- do not want to block here and because it would not solve the issue for completely separated -- threads of elaboration such as in Aesop's backtracking search. - while env.containsOnBranch (curr g base) do - g := g.next - return (curr g base, g) -where curr (g : DeclNameGenerator) (base : Name) : Name := - g.idxs.foldr (fun i n => n.appendIndexAfter i) base + isConflict (n : Name) : Bool := + (env.setExporting false).containsOnBranch n || + isPrivateName n && (env.setExporting false).containsOnBranch (privateToUserName n) || + !isPrivateName n && (env.setExporting false).containsOnBranch (mkPrivateName env n) + curr (g : DeclNameGenerator) (base : Name) : Name := Id.run do + let mut n := g.idxs.foldr (fun i n => n.appendIndexAfter i) base + if env.header.isModule && !env.isExporting && !isPrivateName n then + n := mkPrivateName env n + return n def mkChild (g : DeclNameGenerator) : DeclNameGenerator × DeclNameGenerator := ({ g with parentIdxs := g.idx :: g.parentIdxs, idx := 1 }, diff --git a/src/Lean/Elab/AuxDef.lean b/src/Lean/Elab/AuxDef.lean index de1c39ab4a..995bc5b2b7 100644 --- a/src/Lean/Elab/AuxDef.lean +++ b/src/Lean/Elab/AuxDef.lean @@ -27,7 +27,8 @@ def elabAuxDef : CommandElab -- We use a new generator here because we want more control over the name; the default would -- create a private name that then breaks the macro below. We assume that `aux_def` is not used -- with the same arguments in parallel contexts. - let (id, _) := { namePrefix := ns : DeclNameGenerator }.mkUniqueName (← getEnv) («infix» := Name.mkSimple id) + let env := (← getEnv).setExporting true + let (id, _) := { namePrefix := ns : DeclNameGenerator }.mkUniqueName env («infix» := Name.mkSimple id) let id := id.replacePrefix ns Name.anonymous -- TODO: replace with def _root_.id elabCommand <| ← `($[$doc?:docComment]? $[$attrs?:attributes]? diff --git a/src/Lean/Elab/SyntheticMVars.lean b/src/Lean/Elab/SyntheticMVars.lean index 35084b1f5e..02effa1401 100644 --- a/src/Lean/Elab/SyntheticMVars.lean +++ b/src/Lean/Elab/SyntheticMVars.lean @@ -347,8 +347,9 @@ mutual If `report := false`, then `runTactic` will not capture exceptions nor will report unsolved goals. Unsolved goals become exceptions. -/ partial def runTactic (mvarId : MVarId) (tacticCode : Syntax) (kind : TacticMVarKind) (report := true) : TermElabM Unit := withoutAutoBoundImplicit do + let wasExporting := (← getEnv).isExporting -- exit exporting context if entering proof - let isNoLongerExporting ← pure (← getEnv).isExporting <&&> do + let isNoLongerExporting ← pure wasExporting <&&> do mvarId.withContext do isProp (← mvarId.getType) instantiateMVarDeclMVars mvarId @@ -359,7 +360,7 @@ mutual if isNoLongerExporting then let mvarDecl ← getMVarDecl mvarId mvarId' := (← mkFreshExprMVarAt mvarDecl.lctx mvarDecl.localInstances mvarDecl.type mvarDecl.kind).mvarId! - withExporting (isExporting := (← getEnv).isExporting && !isNoLongerExporting) do + withExporting (isExporting := wasExporting && !isNoLongerExporting) do /- TODO: consider using `runPendingTacticsAt` at `mvarId` local context and target type. Issue #1380 demonstrates that the goal may still contain pending metavariables. @@ -395,7 +396,8 @@ mutual let mut e ← instantiateExprMVars (.mvar mvarId') if !e.isFVar then e ← mvarId'.withContext do - abstractProof e + withExporting (isExporting := wasExporting) do + abstractProof e mvarId.assign e) fun ex => do if report then diff --git a/src/Lean/Meta/AbstractNestedProofs.lean b/src/Lean/Meta/AbstractNestedProofs.lean index 1f0b2c33d0..4ab81ff747 100644 --- a/src/Lean/Meta/AbstractNestedProofs.lean +++ b/src/Lean/Meta/AbstractNestedProofs.lean @@ -11,9 +11,9 @@ import Lean.Meta.Transform namespace Lean.Meta /-- Abstracts the given proof into an auxiliary theorem, suitably pre-processing its type. -/ -def abstractProof [Monad m] [MonadLiftT MetaM m] (proof : Expr) (cache := true) - (postprocessType : Expr → m Expr := pure) : m Expr := do - let type ← inferType proof +def abstractProof [Monad m] [MonadLiftT MetaM m] [MonadEnv m] [MonadOptions m] [MonadFinally m] + (proof : Expr) (cache := true) (postprocessType : Expr → m Expr := pure) : m Expr := do + let type ← withoutExporting do inferType proof let type ← (Core.betaReduce type : MetaM _) let type ← zetaReduce type let type ← postprocessType type @@ -66,7 +66,7 @@ partial def visit (e : Expr) : M Expr := do lctx := lctx.modifyLocalDecl xFVarId fun _ => localDecl withLCtx lctx localInstances k checkCache { val := e : ExprStructEq } fun _ => do - if (← isNonTrivialProof e) then + if (← withoutExporting do isNonTrivialProof e) then /- Ensure proofs nested in type are also abstracted -/ abstractProof e (← read).cache visit else match e with diff --git a/src/Lean/Meta/Tactic/Simp/SimpTheorems.lean b/src/Lean/Meta/Tactic/Simp/SimpTheorems.lean index b41aa132d1..dbad7222aa 100644 --- a/src/Lean/Meta/Tactic/Simp/SimpTheorems.lean +++ b/src/Lean/Meta/Tactic/Simp/SimpTheorems.lean @@ -439,11 +439,11 @@ private def mkSimpTheoremsFromConst (declName : Name) (post : Bool) (inv : Bool) if inv || (← shouldPreprocess type) then let mut r := #[] for (val, type) in (← preprocess val type inv (isGlobal := true)) do - let auxName ← mkAuxLemma cinfo.levelParams type val - r := r.push <| (← mkSimpTheoremCore origin (mkConst auxName us) #[] (mkConst auxName) post prio (noIndexAtArgs := false)) + let auxName ← mkAuxLemma (kind? := `_simp) cinfo.levelParams type val + r := r.push <| (← withoutExporting do mkSimpTheoremCore origin (mkConst auxName us) #[] (mkConst auxName) post prio (noIndexAtArgs := false)) return r else - return #[← mkSimpTheoremCore origin (mkConst declName us) #[] (mkConst declName) post prio (noIndexAtArgs := false)] + return #[← withoutExporting do mkSimpTheoremCore origin (mkConst declName us) #[] (mkConst declName) post prio (noIndexAtArgs := false)] inductive SimpEntry where | thm : SimpTheorem → SimpEntry @@ -463,7 +463,7 @@ def SimpExtension.getTheorems (ext : SimpExtension) : CoreM SimpTheorems := return ext.getState (← getEnv) def addSimpTheorem (ext : SimpExtension) (declName : Name) (post : Bool) (inv : Bool) (attrKind : AttributeKind) (prio : Nat) : MetaM Unit := do - let simpThms ← mkSimpTheoremsFromConst declName post inv prio + let simpThms ← withExporting (isExporting := !isPrivateName declName) do mkSimpTheoremsFromConst declName post inv prio for simpThm in simpThms do ext.add (SimpEntry.thm simpThm) attrKind