0cb79868f4
This PR adds “sparse casesOn” constructions. They are similar to `.casesOn`, but have arms only for some constructors and a catch-all (providing `t.ctorIdx ≠ 42` assumptions). The compiler has native support for these constructors and now (because of the similarity) also the per-constructor elimination principles.
75 lines
2.8 KiB
Text
75 lines
2.8 KiB
Text
/-
|
|
Copyright (c) 2019 Microsoft Corporation. All rights reserved.
|
|
Released under Apache 2.0 license as described in the file LICENSE.
|
|
Authors: Leonardo de Moura
|
|
-/
|
|
module
|
|
|
|
prelude
|
|
public import Lean.EnvExtension
|
|
import Init.Data.String.TakeDrop
|
|
|
|
public section
|
|
|
|
namespace Lean
|
|
|
|
def casesOnSuffix := "casesOn"
|
|
def recOnSuffix := "recOn"
|
|
def brecOnSuffix := "brecOn"
|
|
def belowSuffix := "below"
|
|
|
|
def mkCasesOnName (indDeclName : Name) : Name := Name.mkStr indDeclName casesOnSuffix
|
|
def mkRecOnName (indDeclName : Name) : Name := Name.mkStr indDeclName recOnSuffix
|
|
def mkBRecOnName (indDeclName : Name) : Name := Name.mkStr indDeclName brecOnSuffix
|
|
def mkBelowName (indDeclName : Name) : Name := Name.mkStr indDeclName belowSuffix
|
|
|
|
builtin_initialize auxRecExt : TagDeclarationExtension ← mkTagDeclarationExtension (asyncMode := .local)
|
|
|
|
def markAuxRecursor (env : Environment) (declName : Name) : Environment :=
|
|
auxRecExt.tag env declName
|
|
|
|
@[export lean_is_aux_recursor]
|
|
def isAuxRecursor (env : Environment) (declName : Name) : Bool :=
|
|
auxRecExt.isTagged env declName
|
|
-- TODO: use `markAuxRecursor` when they are defined
|
|
-- An attribute is not a good solution since we don't want users to control what is tagged as an auxiliary recursor.
|
|
|| declName == ``Eq.ndrec
|
|
|| declName == ``Eq.ndrecOn
|
|
|
|
def isAuxRecursorWithSuffix (env : Environment) (declName : Name) (suffix : String) : Bool :=
|
|
match declName with
|
|
| .str _ s => (s == suffix || s.startsWith s!"{suffix}_") && isAuxRecursor env declName
|
|
| _ => false
|
|
|
|
def isCasesOnRecursor (env : Environment) (declName : Name) : Bool :=
|
|
isAuxRecursorWithSuffix env declName casesOnSuffix
|
|
|
|
def isRecOnRecursor (env : Environment) (declName : Name) : Bool :=
|
|
isAuxRecursorWithSuffix env declName recOnSuffix
|
|
|
|
def isBRecOnRecursor (env : Environment) (declName : Name) : Bool :=
|
|
isAuxRecursorWithSuffix env declName brecOnSuffix
|
|
|
|
private builtin_initialize sparseCasesOnExt : TagDeclarationExtension ← mkTagDeclarationExtension (asyncMode := .local)
|
|
|
|
def markSparseCasesOn (env : Environment) (declName : Name) : Environment :=
|
|
sparseCasesOnExt.tag env declName
|
|
|
|
/-- Is this a constructor elimination or a sparse casesOn? -/
|
|
public def isSparseCasesOn (env : Environment) (declName : Name) : Bool :=
|
|
sparseCasesOnExt.isTagged env declName
|
|
|
|
/-- Is this a `.casesOn`, a constructor elimination or a sparse casesOn? -/
|
|
public def isCasesOnLike (env : Environment) (declName : Name) : Bool :=
|
|
isCasesOnRecursor env declName || isSparseCasesOn env declName
|
|
|
|
builtin_initialize noConfusionExt : TagDeclarationExtension ← mkTagDeclarationExtension
|
|
|
|
def markNoConfusion (env : Environment) (n : Name) : Environment :=
|
|
noConfusionExt.tag env n
|
|
|
|
@[export lean_is_no_confusion]
|
|
def isNoConfusion (env : Environment) (n : Name) : Bool :=
|
|
noConfusionExt.isTagged env n
|
|
|
|
end Lean
|