Compare commits

..

12 Commits

Author SHA1 Message Date
Leonardo de Moura
f12d008bb1 fix: update test imports for moved Poly and VarRename
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-04-05 22:09:48 -07:00
Leonardo de Moura
30315a59d4 refactor: delete Grind.Arith.CommRing.MonadCanon, use Sym.Arith.MonadCanon
Remove grind's `MonadCanon` type class. All files now import and use
`Sym.Arith.MonadCanon` directly. Grind's monads inherit the instance
via `MonadLift` from `SymM`.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-04-05 20:31:48 -07:00
Leonardo de Moura
9d078f64bc refactor: move ToExpr, VarRename, Poly to Sym.Arith
Move pure utility files that operate on `Grind.CommRing` types (`Power`,
`Mon`, `Poly`, `Expr`) from `Grind.Arith.CommRing/` to `Sym.Arith/`.
These have no dependencies on grind's solver state or `GoalM`.

Delete the grind originals and update all importers to use the Sym versions.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-04-05 20:16:52 -07:00
Leonardo de Moura
083b393294 feat: add Sym.Arith.DenoteExpr with reify-denote roundtrip tests
Convert reified `RingExpr`, `Poly`, `Mon`, `Power` back into Lean `Expr`s
using the ring's cached operator functions and `MonadGetVar` for variable
lookup. Generic over `MonadCanon`, `MonadRing`, `MonadGetVar`.

Add roundtrip tests verifying that reify→denote produces expressions
definitionally equal to the canonicalized original for `2 + 3`,
`2 * 3 + 1`, `-5`, `2 ^ 3`, `7 - 2`, and `(a + b*2) - (c*a + a*(3*b + c))`.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-04-05 19:30:29 -07:00
Leonardo de Moura
9ea2b7b533 feat: add Sym.Arith.Reify for arithmetic expression reification
Converts Lean expressions into `RingExpr` or `SemiringExpr` for
reflection-based normalization. Generic over `MonadCanon`, `MonadRing`/
`MonadSemiring`, and `MonadMkVar`, enabling reuse by both Sym's arith
normalizer and (eventually) grind's ring module.

Instance validation uses pointer equality (`isSameExpr`) against cached
function expressions from `Functions.lean`. Variable creation is
abstracted via `MonadMkVar` — Sym uses a local `PHashMap`, grind uses
E-graph internalization.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-04-05 19:18:07 -07:00
Leonardo de Moura
e17b0347c8 test: add unit tests for Sym.Arith classify, evalNum, and exp threshold
Test `classify?` on `Int` (commRing), `Nat` (commSemiring), `Bool` (none),
and caching. Test `evalNat?` on `Nat.zero`, `Nat.succ`, `OfNat.ofNat`,
`HAdd`, `HMul`, `HPow`. Test `withExpThreshold` limiting large exponents.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-04-05 18:32:26 -07:00
Leonardo de Moura
0a6c7eef66 refactor: use single typeClassify map instead of four separate maps
Replace `typeIdOf`, `stypeIdOf`, `nctypeIdOf`, `ncstypeIdOf` with a single
`typeClassify : PHashMap ExprPtr ClassifyResult`. One lookup tells you
the classification kind and id. Move `ClassifyResult` to `Types.lean`.

Simplify `Classify.lean`: `classify?` handles the cache lookup/insert,
internal helpers (`tryCommRing?`, etc.) focus on synthesis without caching.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-04-05 17:55:53 -07:00
Leonardo de Moura
46046b47a8 feat: add shared type classes and Functions.lean for arithmetic operators
Add type classes to `Sym.Arith/` that abstract over the ring/semiring state,
enabling both Sym's arith normalizer and grind's ring module to share code:

- `MonadCanon`: `canonExpr` + `synthInstance?`. `SymM` provides the real
  instance; grind's monads inherit it via `MonadLift`. `PP.M` uses identity.
- `MonadRing` / `MonadCommRing`: get/modify `Ring`/`CommRing` (classification
  + function caches, no solver state).
- `MonadSemiring` / `MonadCommSemiring`: same for semirings.
- `MonadGetVar`: read variable by index (for DenoteExpr, diagnostics).
- `MonadMkVar`: create/lookup variables (for reification).

`Functions.lean` is generic over these type classes and provides cached
function getters (`getAddFn`, `getMulFn`, `getSubFn`, `getNegFn`, `getPowFn`,
`getIntCastFn`, `getNatCastFn`, `getInvFn`, and semiring variants).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-04-05 17:45:48 -07:00
Leonardo de Moura
069e676532 feat: add Sym.Arith.Functions for cached arithmetic operator expressions
Synthesize and cache canonical Lean expressions for arithmetic operators
(`+`, `*`, `-`, `^`, `intCast`, `natCast`, `inv`) for classified rings
and semirings. Uses `Sym.canon` for canonicalization and `Sym.synthInstance`
for instance synthesis. Instances are validated against the expected ones
from the ring structure via `isDefEqI`.

Provides `getRingAddFn`, `getRingMulFn`, `getRingSubFn`, `getRingNegFn`,
`getRingPowFn`, `getRingIntCastFn`, `getRingNatCastFn`, `getCommRingInvFn`,
and semiring variants.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-03-27 21:27:50 -07:00
Leonardo de Moura
94bf1d34d1 feat: add Sym.Arith.Classify for algebraic structure detection
Detect the strongest algebraic structure for a type:
CommRing > Ring > CommSemiring > Semiring. Results are cached in
`Arith.State` via the `SymExtension`.

For `CommSemiring` types, creates the `OfSemiring.Q` envelope ring
and links it back to the semiring. Uses `Sym.synthInstance?` for
all instance synthesis and `Sym.canon` for type normalization.

Also detects `IsCharP` (via `evalNat?`), `NoNatZeroDivisors`, and
`Field` instances when available.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-03-27 21:11:57 -07:00
Leonardo de Moura
681769fb6d chore: add Sym/Arith.lean umbrella import
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-03-27 21:07:04 -07:00
Leonardo de Moura
dad6fe832d feat: add Sym.Arith.Types and Sym.Arith.EvalNum
Add algebraic structure classification types (`Semiring`, `Ring`,
`CommRing`, `CommSemiring`) and the `Arith.State` SymExtension for
caching type classifications across simp invocations within a `sym =>`
block.

The `exp` threshold for exponentiation evaluation lives in `Arith.State`
with `getExpThreshold`/`setExpThreshold`/`withExpThreshold` combinators.
Grind propagates its `Config.exp` via `withExpThreshold` at startup.

`EvalNum` provides `evalNat?`/`evalInt?` for evaluating ground Nat/Int
expressions in type classes (e.g., `IsCharP`), adapted from
`Grind.Arith.EvalNum` to use `SymM`.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-03-27 21:02:59 -07:00
102 changed files with 1443 additions and 2987 deletions

View File

@@ -7,11 +7,6 @@ To build Lean you should use `make -j$(nproc) -C build/release`.
The build uses `ccache`, and in a sandbox `ccache` may complain about read-only file systems.
Use `CCACHE_READONLY` and `CCACHE_TEMPDIR` instead of disabling ccache completely.
To rebuild individual modules without a full build, use Lake directly:
```
cd src && lake build Init.Prelude
```
## Running Tests
See `tests/README.md` for full documentation. Quick reference:
@@ -61,11 +56,6 @@ make -C build/release/stage2 clean-stdlib
```
must be run manually before building.
To rebuild individual stage 2 modules without a full `make stage2`, use Lake directly:
```
cd build/release/stage2 && lake build Init.Prelude
```
## New features
When asked to implement new features:

View File

@@ -157,16 +157,6 @@ Note: `gh pr checks --watch` exits as soon as ALL checks complete (pass or fail)
fail while others are still running, `--watch` will continue until everything settles, then exit
with a non-zero code. So a background `--watch` finishing = all checks done; check which failed.
## Mathlib Bump Branches
Mathlib `bump/v4.X.0` branches live on the **fork** `leanprover-community/mathlib4-nightly-testing`,
NOT on `leanprover-community/mathlib4`.
## Never Force-Update Remote Refs Without Confirmation
Never force-update an existing remote branch or tag via `git push --force` or the GitHub API
without explicit user confirmation.
## Error Handling
**CRITICAL**: If something goes wrong or a command fails:

View File

@@ -614,38 +614,6 @@ else()
OUTPUT_VARIABLE GIT_SHA1
OUTPUT_STRIP_TRAILING_WHITESPACE
)
# Fallback for jj workspaces where git cannot find .git directly.
# Use `jj git root` to find the backing git repo, then `jj log` to
# resolve the current workspace's commit (git HEAD points to the root
# workspace, not the current one).
if("${GIT_SHA1}" STREQUAL "")
find_program(JJ_EXECUTABLE jj)
if(JJ_EXECUTABLE)
execute_process(
COMMAND "${JJ_EXECUTABLE}" git root
WORKING_DIRECTORY "${CMAKE_CURRENT_SOURCE_DIR}"
OUTPUT_VARIABLE _jj_git_dir
OUTPUT_STRIP_TRAILING_WHITESPACE
ERROR_QUIET
RESULT_VARIABLE _jj_git_root_result
)
execute_process(
COMMAND "${JJ_EXECUTABLE}" log -r @ --no-graph -T "commit_id"
WORKING_DIRECTORY "${CMAKE_CURRENT_SOURCE_DIR}"
OUTPUT_VARIABLE _jj_commit
OUTPUT_STRIP_TRAILING_WHITESPACE
ERROR_QUIET
RESULT_VARIABLE _jj_rev_result
)
if(_jj_git_root_result EQUAL 0 AND _jj_rev_result EQUAL 0)
execute_process(
COMMAND git --git-dir "${_jj_git_dir}" ls-tree "${_jj_commit}" stage0 --object-only
OUTPUT_VARIABLE GIT_SHA1
OUTPUT_STRIP_TRAILING_WHITESPACE
)
endif()
endif()
endif()
message(STATUS "stage0 sha1: ${GIT_SHA1}")
# Now that we've prepared the information for the next stage, we can forget that we will use
# Lake in the future as we won't use it in this stage
@@ -829,14 +797,7 @@ if(LLVM AND STAGE GREATER 0)
set(EXTRA_LEANMAKE_OPTS "LLVM=1")
endif()
set(
STDLIBS
Init
Std
Lean
Leanc
LeanIR
)
set(STDLIBS Init Std Lean Leanc LeanIR)
if(NOT CMAKE_SYSTEM_NAME MATCHES "Emscripten")
list(APPEND STDLIBS Lake LeanChecker)
endif()
@@ -944,7 +905,10 @@ if(PREV_STAGE)
endif()
if(NOT CMAKE_SYSTEM_NAME MATCHES "Emscripten")
add_custom_target(leanir ALL DEPENDS leanshared COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make leanir VERBATIM)
add_custom_target(leanir ALL
DEPENDS leanshared
COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make leanir
VERBATIM)
endif()
# use Bash version for building, use Lean version in bin/ for tests & distribution

View File

@@ -30,13 +30,13 @@ simpMatchDiscrsOnly (match 0 with | 0 => true | _ => false) = true
```
using `eq_self`.
-/
@[expose] def simpMatchDiscrsOnly {α : Sort u} (a : α) : α := a
def simpMatchDiscrsOnly {α : Sort u} (a : α) : α := a
/--
Gadget for protecting lambda abstractions created by `abstractGroundMismatches?`
from beta reduction during preprocessing. See `ProveEq.lean` for details.
-/
@[expose] def abstractFn {α : Sort u} (a : α) : α := a
def abstractFn {α : Sort u} (a : α) : α := a
/-- Gadget for representing offsets `t+k` in patterns. -/
def offset (a b : Nat) : Nat := a + b

View File

@@ -624,23 +624,6 @@ existing code. It may be removed in a future version of the library.
syntax (name := deprecated) "deprecated" (ppSpace ident)? (ppSpace str)?
(" (" &"since" " := " str ")")? : attr
/--
The attribute `@[deprecated_arg old new]` marks a named parameter as deprecated.
When a caller uses the old name with a replacement available, a deprecation warning is emitted
and the argument is silently forwarded to the new parameter. When no replacement is provided,
the parameter is treated as removed and using it produces an error.
* `@[deprecated_arg old new (since := "2026-03-18")]` marks `old` as a deprecated alias for `new`.
* `@[deprecated_arg old new "use foo instead" (since := "2026-03-18")]` adds a custom message.
* `@[deprecated_arg old (since := "2026-03-18")]` marks `old` as a removed parameter (no replacement).
* `@[deprecated_arg old "no longer needed" (since := "2026-03-18")]` removed with a custom message.
A warning is emitted if `(since := "...")` is omitted.
-/
syntax (name := deprecated_arg) "deprecated_arg" ppSpace ident (ppSpace ident)? (ppSpace str)?
(" (" &"since" " := " str ")")? : attr
/--
The attribute `@[suggest_for ..]` on a declaration suggests likely ways in which
someone might **incorrectly** refer to a definition.

View File

@@ -21,7 +21,7 @@ Within a basic block, it is always safe to:
until the later inc) and thus doing all relevant `inc` in the beginning doesn't change
semantics.
- Move all decrements on a variable to the last `dec` location (summing the counts). Because the
value is guaranteed to stay alive until at least the last `dec` anyway so a similar argument to
value is guaranteed to stay alive until at least the last `dec` anyway so a similiar argument to
`inc` holds.
Crucially this pass must be placed after `expandResetReuse` as that one relies on `inc`s still being

View File

@@ -69,8 +69,8 @@ open ImpureType
abbrev Mask := Array (Option FVarId)
/--
Try to erase `inc` instructions on projections of `targetId` occurring in the tail of `ds`.
Return the updated `ds` and mask containing the `FVarId`s whose `inc` was removed.
Try to erase `inc` instructions on projections of `targetId` occuring in the tail of `ds`.
Return the updated `ds` and mask contianing the `FVarId`s whose `inc` was removed.
-/
partial def eraseProjIncFor (nFields : Nat) (targetId : FVarId) (ds : Array (CodeDecl .impure)) :
CompilerM (Array (CodeDecl .impure) × Mask) := do

View File

@@ -39,7 +39,6 @@ public import Lean.Elab.Extra
public import Lean.Elab.GenInjective
public import Lean.Elab.BuiltinTerm
public import Lean.Elab.Arg
public import Lean.Elab.DeprecatedArg
public import Lean.Elab.PatternVar
public import Lean.Elab.ElabRules
public import Lean.Elab.Macro

View File

@@ -11,7 +11,6 @@ public import Lean.Elab.Binders
public import Lean.Elab.RecAppSyntax
public import Lean.IdentifierSuggestion
import all Lean.Elab.ErrorUtils
import Lean.Elab.DeprecatedArg
import Init.Omega
public section
@@ -89,38 +88,6 @@ def synthesizeAppInstMVars (instMVars : Array MVarId) (app : Expr) : TermElabM U
private def findBinderName? (namedArgs : List NamedArg) (binderName : Name) : Option NamedArg :=
namedArgs.find? fun namedArg => namedArg.name == binderName
/--
If the function being applied is a constant, search `namedArgs` for an argument whose name is
a deprecated alias of `binderName`. When `linter.deprecated.arg` is enabled (the default),
returns `some namedArg` after emitting a deprecation warning with a code action hint. When the
option is disabled, returns `none` (the old name falls through to the normal "invalid argument"
error). The returned `namedArg` retains its original (old) name.
-/
private def findDeprecatedBinderName? (namedArgs : List NamedArg) (f : Expr) (binderName : Name) :
TermElabM (Option NamedArg) := do
unless linter.deprecated.arg.get <| getOptions do return .none
unless f.getAppFn.isConst do return none
let declName := f.getAppFn.constName!
let env getEnv
for namedArg in namedArgs do
if let some entry := findDeprecatedArg? env declName namedArg.name then
if entry.newArg? == some binderName then
let msg := formatDeprecatedArgMsg entry
let span? := namedArg.ref[1]
let hint
if span?.getHeadInfo matches .original .. then
MessageData.hint "Rename this argument:" #[{
suggestion := .string entry.newArg?.get!.toString
span?
toCodeActionTitle? := some fun s =>
s!"Rename argument `{entry.oldArg}` to `{s}`"
}]
else
pure .nil
logWarningAt namedArg.ref <| .tagged ``deprecatedArgExt msg ++ hint
return some namedArg
return none
/-- Erase entry for `binderName` from `namedArgs`. -/
def eraseNamedArg (namedArgs : List NamedArg) (binderName : Name) : List NamedArg :=
namedArgs.filter (·.name != binderName)
@@ -271,23 +238,6 @@ private def synthesizePendingAndNormalizeFunType : M Unit := do
else
for namedArg in s.namedArgs do
let f := s.f.getAppFn
if f.isConst then
let env getEnv
if linter.deprecated.arg.get ( getOptions) then
if let some entry := findDeprecatedArg? env f.constName! namedArg.name then
if entry.newArg?.isNone then
let msg := formatDeprecatedArgMsg entry
let hint
if namedArg.ref.getHeadInfo matches .original .. then
MessageData.hint "Delete this argument:" #[{
suggestion := .string ""
span? := namedArg.ref
toCodeActionTitle? := some fun _ =>
s!"Delete deprecated argument `{entry.oldArg}`"
}]
else
pure .nil
throwErrorAt namedArg.ref (msg ++ hint)
let validNames getFoundNamedArgs
let fnName? := if f.isConst then some f.constName! else none
throwInvalidNamedArg namedArg fnName? validNames
@@ -806,16 +756,13 @@ mutual
let binderName := fType.bindingName!
let binfo := fType.bindingInfo!
let s get
let namedArg? match findBinderName? s.namedArgs binderName with
| some namedArg => pure (some namedArg)
| none => findDeprecatedBinderName? s.namedArgs s.f binderName
match namedArg? with
match findBinderName? s.namedArgs binderName with
| some namedArg =>
propagateExpectedType namedArg.val
eraseNamedArg namedArg.name
eraseNamedArg binderName
elabAndAddNewArg binderName namedArg.val
main
| none =>
| none =>
unless binderName.hasMacroScopes do
pushFoundNamedArg binderName
match binfo with

View File

@@ -63,6 +63,6 @@ where
doElabToSyntax "else branch of if with condition {cond}" (elabDiteBranch false) fun else_ => do
let mγ mkMonadicType ( read).doBlockResultType
match h with
| `(_%$tk) => Term.elabTermEnsuringType ( `(if _%$tk : $cond then $then_ else $else_)) mγ
| `(_%$tk) => Term.elabTermEnsuringType ( `(if $(tk):hole : $cond then $then_ else $else_)) mγ
| `($h:ident) => Term.elabTermEnsuringType ( `(if $h:ident : $cond then $then_ else $else_)) mγ
| _ => throwUnsupportedSyntax

View File

@@ -43,7 +43,7 @@ builtin_initialize
Upon such rewrite, the code for adding flat inductives does not diverge much from the usual
way its done for inductive declarations, but we omit applying attributes/modifiers and
we do not set the syntax references to track those declarations (as this is auxiliary piece of
we do not set the syntax references to track those declarations (as this is auxillary piece of
data hidden from the user).
Then, upon adding such flat inductives for each definition in the mutual block to the environment,
@@ -345,7 +345,7 @@ private def mkCasesOnCoinductive (infos : Array InductiveVal) : MetaM Unit := do
| throwError "expected to be quantifier"
let motiveMVar mkFreshExprMVar type
/-
We intro all the indices and the occurrence of the coinductive predicate
We intro all the indices and the occurence of the coinductive predicate
-/
let (fvars, subgoal) motiveMVar.mvarId!.introN (info.numIndices + 1)
subgoal.withContext do
@@ -373,7 +373,7 @@ private def mkCasesOnCoinductive (infos : Array InductiveVal) : MetaM Unit := do
-/
let originalCasesOn := mkAppN originalCasesOn indices
/-
The next argument is the occurrence of the coinductive predicate.
The next argument is the occurence of the coinductive predicate.
The original `casesOn` of the flat inductive mentions it in
unrolled form, so we need to rewrite it.
-/
@@ -447,7 +447,7 @@ public def elabCoinductive (coinductiveElabData : Array CoinductiveElabData) : T
let consts := namesAndTypes.map fun (name, _) => (mkConst name levelParams)
/-
We create values of each of PreDefinitions, by taking existential (see `Meta.SumOfProducts`)
form of the associated flat inductives and applying parameters, as well as recursive calls
form of the associated flat inductives and applying paramaters, as well as recursive calls
(with their parameters passed).
-/
let preDefVals forallBoundedTelescope infos[0]!.type originalNumParams fun params _ => do

View File

@@ -1,97 +0,0 @@
/-
Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Wojciech Różowski
-/
module
prelude
public import Lean.EnvExtension
public import Lean.Message
import Lean.Elab.Term
public section
namespace Lean.Elab
open Meta
register_builtin_option linter.deprecated.arg : Bool := {
defValue := true
descr := "if true, generate deprecation warnings and errors for deprecated parameters"
}
/-- Entry mapping an old parameter name to a new (or no) parameter for a given declaration. -/
structure DeprecatedArgEntry where
declName : Name
oldArg : Name
newArg? : Option Name := none
text? : Option String := none
since? : Option String := none
deriving Inhabited
/-- State: `declName → (oldArg → entry)` -/
abbrev DeprecatedArgState := NameMap (NameMap DeprecatedArgEntry)
private def addDeprecatedArgEntry (s : DeprecatedArgState) (e : DeprecatedArgEntry) : DeprecatedArgState :=
let inner := (s.find? e.declName).getD {} |>.insert e.oldArg e
s.insert e.declName inner
builtin_initialize deprecatedArgExt :
SimplePersistentEnvExtension DeprecatedArgEntry DeprecatedArgState
registerSimplePersistentEnvExtension {
addEntryFn := addDeprecatedArgEntry
addImportedFn := mkStateFromImportedEntries addDeprecatedArgEntry {}
}
/-- Look up a deprecated argument mapping for `(declName, argName)`. -/
def findDeprecatedArg? (env : Environment) (declName : Name) (argName : Name) :
Option DeprecatedArgEntry :=
(deprecatedArgExt.getState env |>.find? declName) >>= (·.find? argName)
/-- Format the deprecation warning message for a deprecated argument. -/
def formatDeprecatedArgMsg (entry : DeprecatedArgEntry) : MessageData :=
let base := match entry.newArg? with
| some newArg =>
m!"parameter `{entry.oldArg}` of `{.ofConstName entry.declName}` has been deprecated, \
use `{newArg}` instead"
| none =>
m!"parameter `{entry.oldArg}` of `{.ofConstName entry.declName}` has been deprecated"
match entry.text? with
| some text => base ++ m!": {text}"
| none => base
builtin_initialize registerBuiltinAttribute {
name := `deprecated_arg
descr := "mark a parameter as deprecated"
add := fun declName stx _kind => do
let `(attr| deprecated_arg $oldId $[$newId?]? $[$text?]? $[(since := $since?)]?) := stx
| throwError "Invalid `[deprecated_arg]` attribute syntax"
let oldArg := oldId.getId
let newArg? := newId?.map TSyntax.getId
let text? := text?.map TSyntax.getString |>.filter (!·.isEmpty)
let since? := since?.map TSyntax.getString
let info getConstInfo declName
let paramNames MetaM.run' do
forallTelescopeReducing info.type fun xs _ =>
xs.mapM fun x => return ( x.fvarId!.getDecl).userName
if let some newArg := newArg? then
-- We have a replacement provided
unless Array.any paramNames (· == newArg) do
throwError "`{newArg}` is not a parameter of `{declName}`"
if Array.any paramNames (· == oldArg) then
throwError "`{oldArg}` is still a parameter of `{declName}`; \
rename it to `{newArg}` before adding `@[deprecated_arg]`"
else
-- We do not have a replacement provided
if Array.any paramNames (· == oldArg) then
throwError "`{oldArg}` is still a parameter of `{declName}`; \
remove it before adding `@[deprecated_arg]`"
if since?.isNone then
logWarning "`[deprecated_arg]` attribute should specify the date or library version \
at which the deprecation was introduced, using `(since := \"...\")`"
modifyEnv fun env => deprecatedArgExt.addEntry env {
declName, oldArg, newArg?, text?, since?
}
}
end Lean.Elab

View File

@@ -85,10 +85,6 @@ structure State where
-/
lctx : LocalContext
/--
The local instances.
The `MonadLift TermElabM DocM` instance runs the lifted action with these instances, so elaboration
commands that mutate this state cause it to take effect in subsequent commands.
-/
localInstances : LocalInstances
/--

View File

@@ -91,10 +91,10 @@ end FoldRelevantConstantsImpl
@[implemented_by FoldRelevantConstantsImpl.foldUnsafe]
public opaque foldRelevantConstants {α : Type} (e : Expr) (init : α) (f : Name α MetaM α) : MetaM α := pure init
/-- Collect the constants occurring in `e` (once each), skipping instance arguments and proofs. -/
/-- Collect the constants occuring in `e` (once each), skipping instance arguments and proofs. -/
public def relevantConstants (e : Expr) : MetaM (Array Name) := foldRelevantConstants e #[] (fun n ns => return ns.push n)
/-- Collect the constants occurring in `e` (once each), skipping instance arguments and proofs. -/
/-- Collect the constants occuring in `e` (once each), skipping instance arguments and proofs. -/
public def relevantConstantsAsSet (e : Expr) : MetaM NameSet := foldRelevantConstants e (fun n ns => return ns.insert n)
end Lean.Expr

View File

@@ -112,37 +112,15 @@ builtin_initialize
def lint (stx : Syntax) (msg : String) : CommandElabM Unit :=
logLint linter.missingDocs stx m!"missing doc string for {msg}"
def lintEmpty (stx : Syntax) (msg : String) : CommandElabM Unit :=
logLint linter.missingDocs stx m!"empty doc string for {msg}"
def lintNamed (stx : Syntax) (msg : String) : CommandElabM Unit :=
lint stx s!"{msg} {stx.getId}"
def lintEmptyNamed (stx : Syntax) (msg : String) : CommandElabM Unit :=
lintEmpty stx s!"{msg} {stx.getId}"
def lintField (parent stx : Syntax) (msg : String) : CommandElabM Unit :=
lint stx s!"{msg} {parent.getId}.{stx.getId}"
def lintEmptyField (parent stx : Syntax) (msg : String) : CommandElabM Unit :=
lintEmpty stx s!"{msg} {parent.getId}.{stx.getId}"
def lintStructField (parent stx : Syntax) (msg : String) : CommandElabM Unit :=
lint stx s!"{msg} {parent.getId}.{stx.getId}"
private def isEmptyDocString (docOpt : Syntax) : CommandElabM Bool := do
if docOpt.isNone then return false
let docStx : TSyntax `Lean.Parser.Command.docComment := docOpt[0]
-- Verso doc comments with interpolated content cannot be extracted as plain text,
-- but they are clearly not empty.
if let .node _ `Lean.Parser.Command.versoCommentBody _ := docStx.raw[1] then
if !docStx.raw[1][0].isAtom then return false
let text getDocStringText docStx
return text.trimAscii.isEmpty
def isMissingDoc (docOpt : Syntax) : CommandElabM Bool := do
return docOpt.isNone || ( isEmptyDocString docOpt)
def hasInheritDoc (attrs : Syntax) : Bool :=
attrs[0][1].getSepArgs.any fun attr =>
attr[1].isOfKind ``Parser.Attr.simple &&
@@ -152,68 +130,38 @@ def hasTacticAlt (attrs : Syntax) : Bool :=
attrs[0][1].getSepArgs.any fun attr =>
attr[1].isOfKind ``Parser.Attr.tactic_alt
def declModifiersDocStatus (mods : Syntax) : CommandElabM (Option Bool) := do
def declModifiersPubNoDoc (mods : Syntax) : CommandElabM Bool := do
let isPublic := if ( getEnv).header.isModule && !( getScope).isPublic then
mods[2][0].getKind == ``Command.public else
mods[2][0].getKind != ``Command.private
if !isPublic || hasInheritDoc mods[1] then return none
if mods[0].isNone then return some false
if ( isEmptyDocString mods[0]) then return some true
return none
return isPublic && mods[0].isNone && !hasInheritDoc mods[1]
def declModifiersPubNoDoc (mods : Syntax) : CommandElabM Bool := do
return ( declModifiersDocStatus mods).isSome
private def lintDocStatus (isEmpty : Bool) (stx : Syntax) (msg : String) : CommandElabM Unit :=
if isEmpty then lintEmpty stx msg else lint stx msg
private def lintDocStatusNamed (isEmpty : Bool) (stx : Syntax) (msg : String) : CommandElabM Unit :=
if isEmpty then lintEmptyNamed stx msg else lintNamed stx msg
private def lintDocStatusField (isEmpty : Bool) (parent stx : Syntax) (msg : String) :
CommandElabM Unit :=
if isEmpty then lintEmptyField parent stx msg else lintField parent stx msg
def lintDeclHead (k : SyntaxNodeKind) (id : Syntax) (isEmpty : Bool := false) :
CommandElabM Unit := do
if k == ``«abbrev» then lintDocStatusNamed isEmpty id "public abbrev"
else if k == ``definition then lintDocStatusNamed isEmpty id "public def"
else if k == ``«opaque» then lintDocStatusNamed isEmpty id "public opaque"
else if k == ``«axiom» then lintDocStatusNamed isEmpty id "public axiom"
else if k == ``«inductive» then lintDocStatusNamed isEmpty id "public inductive"
else if k == ``classInductive then lintDocStatusNamed isEmpty id "public inductive"
else if k == ``«structure» then lintDocStatusNamed isEmpty id "public structure"
private def docOptStatus (docOpt attrs : Syntax) (checkTacticAlt := false) :
CommandElabM (Option Bool) := do
if hasInheritDoc attrs then return none
if checkTacticAlt && hasTacticAlt attrs then return none
if docOpt.isNone then return some false
if ( isEmptyDocString docOpt) then return some true
return none
def lintDeclHead (k : SyntaxNodeKind) (id : Syntax) : CommandElabM Unit := do
if k == ``«abbrev» then lintNamed id "public abbrev"
else if k == ``definition then lintNamed id "public def"
else if k == ``«opaque» then lintNamed id "public opaque"
else if k == ``«axiom» then lintNamed id "public axiom"
else if k == ``«inductive» then lintNamed id "public inductive"
else if k == ``classInductive then lintNamed id "public inductive"
else if k == ``«structure» then lintNamed id "public structure"
@[builtin_missing_docs_handler declaration]
def checkDecl : SimpleHandler := fun stx => do
let head := stx[0]; let rest := stx[1]
if head[2][0].getKind == ``Command.private then return -- not private
let k := rest.getKind
if let some isEmpty declModifiersDocStatus head then
lintDeclHead k rest[1][0] isEmpty
if ( declModifiersPubNoDoc head) then -- no doc string
lintDeclHead k rest[1][0]
if k == ``«inductive» || k == ``classInductive then
for stx in rest[4].getArgs do
let head := stx[2]
-- Constructor has two doc comment positions: the leading one before `|` (stx[0])
-- and the one inside declModifiers (head[0]). If either is non-empty, skip.
let leadingEmpty isEmptyDocString stx[0]
if !stx[0].isNone && !leadingEmpty then
pure () -- constructor has a non-empty leading doc comment
else if let some modsEmpty declModifiersDocStatus head then
lintDocStatusField (leadingEmpty || modsEmpty) rest[1][0] stx[3] "public constructor"
if stx[0].isNone && ( declModifiersPubNoDoc head) then
lintField rest[1][0] stx[3] "public constructor"
unless rest[5].isNone do
for stx in rest[5][0][1].getArgs do
let head := stx[0]
if let some isEmpty declModifiersDocStatus head then
lintDocStatusField isEmpty rest[1][0] stx[1] "computed field"
if ( declModifiersPubNoDoc head) then -- no doc string
lintField rest[1][0] stx[1] "computed field"
else if rest.getKind == ``«structure» then
unless rest[4][2].isNone do
let redecls : Std.HashSet String.Pos.Raw :=
@@ -225,52 +173,45 @@ def checkDecl : SimpleHandler := fun stx => do
else s
else s
let parent := rest[1][0]
let lint1 isEmpty stx := do
let lint1 stx := do
if let some range := stx.getRange? then
if redecls.contains range.start then return
lintDocStatusField isEmpty parent stx "public field"
lintField parent stx "public field"
for stx in rest[4][2][0].getArgs do
let head := stx[0]
if let some isEmpty declModifiersDocStatus head then
if ( declModifiersPubNoDoc head) then
if stx.getKind == ``structSimpleBinder then
lint1 isEmpty stx[1]
lint1 stx[1]
else
for stx in stx[2].getArgs do
lint1 isEmpty stx
lint1 stx
@[builtin_missing_docs_handler «initialize»]
def checkInit : SimpleHandler := fun stx => do
if !stx[2].isNone then
if let some isEmpty declModifiersDocStatus stx[0] then
lintDocStatusNamed isEmpty stx[2][0] "initializer"
if !stx[2].isNone && ( declModifiersPubNoDoc stx[0]) then
lintNamed stx[2][0] "initializer"
@[builtin_missing_docs_handler «notation»]
def checkNotation : SimpleHandler := fun stx => do
if stx[2][0][0].getKind != ``«local» then
if let some isEmpty docOptStatus stx[0] stx[1] then
if stx[5].isNone then lintDocStatus isEmpty stx[3] "notation"
else lintDocStatusNamed isEmpty stx[5][0][3] "notation"
if stx[0].isNone && stx[2][0][0].getKind != ``«local» && !hasInheritDoc stx[1] then
if stx[5].isNone then lint stx[3] "notation"
else lintNamed stx[5][0][3] "notation"
@[builtin_missing_docs_handler «mixfix»]
def checkMixfix : SimpleHandler := fun stx => do
if stx[2][0][0].getKind != ``«local» then
if let some isEmpty docOptStatus stx[0] stx[1] then
if stx[5].isNone then lintDocStatus isEmpty stx[3] stx[3][0].getAtomVal
else lintDocStatusNamed isEmpty stx[5][0][3] stx[3][0].getAtomVal
if stx[0].isNone && stx[2][0][0].getKind != ``«local» && !hasInheritDoc stx[1] then
if stx[5].isNone then lint stx[3] stx[3][0].getAtomVal
else lintNamed stx[5][0][3] stx[3][0].getAtomVal
@[builtin_missing_docs_handler «syntax»]
def checkSyntax : SimpleHandler := fun stx => do
if stx[2][0][0].getKind != ``«local» then
if let some isEmpty docOptStatus stx[0] stx[1] (checkTacticAlt := true) then
if stx[5].isNone then lintDocStatus isEmpty stx[3] "syntax"
else lintDocStatusNamed isEmpty stx[5][0][3] "syntax"
if stx[0].isNone && stx[2][0][0].getKind != ``«local» && !hasInheritDoc stx[1] && !hasTacticAlt stx[1] then
if stx[5].isNone then lint stx[3] "syntax"
else lintNamed stx[5][0][3] "syntax"
def mkSimpleHandler (name : String) (declNameStxIdx := 2) : SimpleHandler := fun stx => do
if ( isMissingDoc stx[0]) then
if ( isEmptyDocString stx[0]) then
lintEmptyNamed stx[declNameStxIdx] name
else
lintNamed stx[declNameStxIdx] name
if stx[0].isNone then
lintNamed stx[declNameStxIdx] name
@[builtin_missing_docs_handler syntaxAbbrev]
def checkSyntaxAbbrev : SimpleHandler := mkSimpleHandler "syntax"
@@ -280,22 +221,20 @@ def checkSyntaxCat : SimpleHandler := mkSimpleHandler "syntax category"
@[builtin_missing_docs_handler «macro»]
def checkMacro : SimpleHandler := fun stx => do
if stx[2][0][0].getKind != ``«local» then
if let some isEmpty docOptStatus stx[0] stx[1] (checkTacticAlt := true) then
if stx[5].isNone then lintDocStatus isEmpty stx[3] "macro"
else lintDocStatusNamed isEmpty stx[5][0][3] "macro"
if stx[0].isNone && stx[2][0][0].getKind != ``«local» && !hasInheritDoc stx[1] && !hasTacticAlt stx[1] then
if stx[5].isNone then lint stx[3] "macro"
else lintNamed stx[5][0][3] "macro"
@[builtin_missing_docs_handler «elab»]
def checkElab : SimpleHandler := fun stx => do
if stx[2][0][0].getKind != ``«local» then
if let some isEmpty docOptStatus stx[0] stx[1] (checkTacticAlt := true) then
if stx[5].isNone then lintDocStatus isEmpty stx[3] "elab"
else lintDocStatusNamed isEmpty stx[5][0][3] "elab"
if stx[0].isNone && stx[2][0][0].getKind != ``«local» && !hasInheritDoc stx[1] && !hasTacticAlt stx[1] then
if stx[5].isNone then lint stx[3] "elab"
else lintNamed stx[5][0][3] "elab"
@[builtin_missing_docs_handler classAbbrev]
def checkClassAbbrev : SimpleHandler := fun stx => do
if let some isEmpty declModifiersDocStatus stx[0] then
lintDocStatusNamed isEmpty stx[3] "class abbrev"
if ( declModifiersPubNoDoc stx[0]) then
lintNamed stx[3] "class abbrev"
@[builtin_missing_docs_handler Parser.Tactic.declareSimpLikeTactic]
def checkSimpLike : SimpleHandler := mkSimpleHandler "simp-like tactic"
@@ -305,8 +244,8 @@ def checkRegisterBuiltinOption : SimpleHandler := mkSimpleHandler (declNameStxId
@[builtin_missing_docs_handler Option.registerOption]
def checkRegisterOption : SimpleHandler := fun stx => do
if let some isEmpty declModifiersDocStatus stx[0] then
lintDocStatusNamed isEmpty stx[2] "option"
if ( declModifiersPubNoDoc stx[0]) then
lintNamed stx[2] "option"
@[builtin_missing_docs_handler registerSimpAttr]
def checkRegisterSimpAttr : SimpleHandler := mkSimpleHandler "simp attr"

View File

@@ -25,6 +25,7 @@ public import Lean.Meta.Sym.Simp
public import Lean.Meta.Sym.Util
public import Lean.Meta.Sym.Eta
public import Lean.Meta.Sym.Canon
public import Lean.Meta.Sym.Arith
public import Lean.Meta.Sym.Grind
public import Lean.Meta.Sym.SynthInstance

View File

@@ -0,0 +1,20 @@
/-
Copyright (c) 2026 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.Sym.Arith.Types
public import Lean.Meta.Sym.Arith.EvalNum
public import Lean.Meta.Sym.Arith.Classify
public import Lean.Meta.Sym.Arith.MonadCanon
public import Lean.Meta.Sym.Arith.MonadRing
public import Lean.Meta.Sym.Arith.MonadSemiring
public import Lean.Meta.Sym.Arith.MonadVar
public import Lean.Meta.Sym.Arith.Functions
public import Lean.Meta.Sym.Arith.Reify
public import Lean.Meta.Sym.Arith.DenoteExpr
public import Lean.Meta.Sym.Arith.ToExpr
public import Lean.Meta.Sym.Arith.VarRename
public import Lean.Meta.Sym.Arith.Poly

View File

@@ -0,0 +1,143 @@
/-
Copyright (c) 2026 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.Sym.Arith.EvalNum
import Lean.Meta.Sym.SynthInstance
import Lean.Meta.Sym.Canon
import Lean.Meta.DecLevel
import Init.Grind.Ring
public section
namespace Lean.Meta.Sym.Arith
/-!
# Algebraic structure classification
Detects the strongest algebraic structure available for a type and caches
the classification in `Arith.State.typeClassify`. The detection order is:
1. `Grind.CommRing` (includes `Field` check)
2. `Grind.Ring` (non-commutative)
3. `Grind.CommSemiring` (via `OfSemiring.Q` envelope)
4. `Grind.Semiring` (non-commutative)
Results (including failures) are cached in a single `PHashMap ExprPtr ClassifyResult`
to avoid repeated synthesis attempts.
-/
private def getIsCharInst? (u : Level) (type : Expr) (semiringInst : Expr) : SymM (Option (Expr × Nat)) := do
withNewMCtxDepth do
let n mkFreshExprMVar (mkConst ``Nat)
let charType := mkApp3 (mkConst ``Grind.IsCharP [u]) type semiringInst n
let some charInst Sym.synthInstance? charType | return none
let n instantiateMVars n
let some n evalNat? n | return none
return some (charInst, n)
private def getNoZeroDivInst? (u : Level) (type : Expr) : SymM (Option Expr) := do
let natModuleType := mkApp (mkConst ``Grind.NatModule [u]) type
let some natModuleInst Sym.synthInstance? natModuleType | return none
let noZeroDivType := mkApp2 (mkConst ``Grind.NoNatZeroDivisors [u]) type natModuleInst
Sym.synthInstance? noZeroDivType
/-- Try to classify `type` as a `CommRing`. Returns the ring id on success. -/
private def tryCommRing? (type : Expr) : SymM (Option Nat) := do
let u getDecLevel type
let commRing := mkApp (mkConst ``Grind.CommRing [u]) type
let some commRingInst Sym.synthInstance? commRing | return none
let ringInst := mkApp2 (mkConst ``Grind.CommRing.toRing [u]) type commRingInst
let semiringInst := mkApp2 (mkConst ``Grind.Ring.toSemiring [u]) type ringInst
let commSemiringInst := mkApp2 (mkConst ``Grind.CommRing.toCommSemiring [u]) type semiringInst
let charInst? getIsCharInst? u type semiringInst
let noZeroDivInst? getNoZeroDivInst? u type
let fieldInst? Sym.synthInstance? <| mkApp (mkConst ``Grind.Field [u]) type
let semiringId? := none
let id := ( getArithState).rings.size
let ring : CommRing := {
id, semiringId?, type, u, semiringInst, ringInst, commSemiringInst,
commRingInst, charInst?, noZeroDivInst?, fieldInst?,
}
modifyArithState fun s => { s with rings := s.rings.push ring }
return some id
/-- Try to classify `type` as a non-commutative `Ring`. -/
private def tryNonCommRing? (type : Expr) : SymM (Option Nat) := do
let u getDecLevel type
let ring := mkApp (mkConst ``Grind.Ring [u]) type
let some ringInst Sym.synthInstance? ring | return none
let semiringInst := mkApp2 (mkConst ``Grind.Ring.toSemiring [u]) type ringInst
let charInst? getIsCharInst? u type semiringInst
let id := ( getArithState).ncRings.size
let ring : Ring := {
id, type, u, semiringInst, ringInst, charInst?
}
modifyArithState fun s => { s with ncRings := s.ncRings.push ring }
return some id
/-- Helper function for `tryCommSemiring? -/
private def tryCacheAndCommRing? (type : Expr) : SymM (Option Nat) := do
if let some result := ( getArithState).typeClassify.find? { expr := type } then
let .commRing id := result | return none
return id
let id? tryCommRing? type
let result := match id? with
| none => .none
| some id => .commRing id
modifyArithState fun s => { s with typeClassify := s.typeClassify.insert { expr := type } result }
return id?
/-- Try to classify `type` as a `CommSemiring`. Creates the `OfSemiring.Q` envelope ring. -/
private def tryCommSemiring? (type : Expr) : SymM (Option Nat) := do
let u getDecLevel type
let commSemiring := mkApp (mkConst ``Grind.CommSemiring [u]) type
let some commSemiringInst Sym.synthInstance? commSemiring | return none
let semiringInst := mkApp2 (mkConst ``Grind.CommSemiring.toSemiring [u]) type commSemiringInst
let q shareCommon ( Sym.canon (mkApp2 (mkConst ``Grind.Ring.OfSemiring.Q [u]) type semiringInst))
-- The envelope `Q` type must be classifiable as a CommRing.
let some ringId tryCacheAndCommRing? q
| reportIssue! "unexpected failure initializing ring{indentExpr q}"; return none
let id := ( getArithState).semirings.size
let semiring : CommSemiring := {
id, type, ringId, u, semiringInst, commSemiringInst
}
modifyArithState fun s => { s with semirings := s.semirings.push semiring }
-- Link the envelope ring back to this semiring
modifyArithState fun s =>
let rings := s.rings.modify ringId fun r => { r with semiringId? := some id }
{ s with rings }
return some id
/-- Try to classify `type` as a non-commutative `Semiring`. -/
private def tryNonCommSemiring? (type : Expr) : SymM (Option Nat) := do
let u getDecLevel type
let semiring := mkApp (mkConst ``Grind.Semiring [u]) type
let some semiringInst Sym.synthInstance? semiring | return none
let id := ( getArithState).ncSemirings.size
let semiring : Semiring := { id, type, u, semiringInst }
modifyArithState fun s => { s with ncSemirings := s.ncSemirings.push semiring }
return some id
/--
Classify the algebraic structure of `type`, trying the strongest first:
CommRing > Ring > CommSemiring > Semiring.
Results are cached in `Arith.State.typeClassify`.
-/
def classify? (type : Expr) : SymM ClassifyResult := do
if let some result := ( getArithState).typeClassify.find? { expr := type } then
return result
let result go
modifyArithState fun s => { s with typeClassify := s.typeClassify.insert { expr := type } result }
return result
where
go : SymM ClassifyResult := do
if let some id tryCommRing? type then return .commRing id
if let some id tryNonCommRing? type then return .nonCommRing id
if let some id tryCommSemiring? type then return .commSemiring id
if let some id tryNonCommSemiring? type then return .nonCommSemiring id
return .none
end Lean.Meta.Sym.Arith

View File

@@ -0,0 +1,93 @@
/-
Copyright (c) 2026 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.Sym.Arith.Functions
public import Lean.Meta.Sym.Arith.MonadVar
public section
namespace Lean.Meta.Sym.Arith
/-!
# Denotation of reified expressions
Converts reified `RingExpr`, `Poly`, `Mon`, `Power` back into Lean `Expr`s using
the ring's cached operator functions and variable array.
-/
variable [Monad m] [MonadError m] [MonadLiftT MetaM m] [MonadCanon m] [MonadRing m]
/-- Convert an integer to a numeral expression in the ring. Negative values use `getNegFn`. -/
def denoteNum (k : Int) : m Expr := do
let ring getRing
let n := mkRawNatLit k.natAbs
let ofNatInst if let some inst MonadCanon.synthInstance? (mkApp2 (mkConst ``OfNat [ring.u]) ring.type n) then
pure inst
else
pure <| mkApp3 (mkConst ``Grind.Semiring.ofNat [ring.u]) ring.type ring.semiringInst n
let e := mkApp3 (mkConst ``OfNat.ofNat [ring.u]) ring.type n ofNatInst
if k < 0 then
return mkApp ( getNegFn) e
else
return e
/-- Denote a `Power` (variable raised to a power). -/
def denotePower [MonadGetVar m] (pw : Power) : m Expr := do
let x getVar pw.x
if pw.k == 1 then
return x
else
return mkApp2 ( getPowFn) x (toExpr pw.k)
/-- Denote a `Mon` (product of powers). -/
def denoteMon [MonadGetVar m] (mn : Mon) : m Expr := do
match mn with
| .unit => denoteNum 1
| .mult pw mn => go mn ( denotePower pw)
where
go (mn : Mon) (acc : Expr) : m Expr := do
match mn with
| .unit => return acc
| .mult pw mn => go mn (mkApp2 ( getMulFn) acc ( denotePower pw))
/-- Denote a `Poly` (sum of coefficient × monomial terms). -/
def denotePoly [MonadGetVar m] (p : Poly) : m Expr := do
match p with
| .num k => denoteNum k
| .add k mn p => go p ( denoteTerm k mn)
where
denoteTerm (k : Int) (mn : Mon) : m Expr := do
if k == 1 then
denoteMon mn
else
return mkApp2 ( getMulFn) ( denoteNum k) ( denoteMon mn)
go (p : Poly) (acc : Expr) : m Expr := do
match p with
| .num 0 => return acc
| .num k => return mkApp2 ( getAddFn) acc ( denoteNum k)
| .add k mn p => go p (mkApp2 ( getAddFn) acc ( denoteTerm k mn))
/-- Denote a `RingExpr` using a variable lookup function. -/
@[specialize]
private def denoteRingExprCore (getVarExpr : Nat Expr) (e : RingExpr) : m Expr := do
go e
where
go : RingExpr m Expr
| .num k => denoteNum k
| .natCast k => return mkApp ( getNatCastFn) (mkNatLit k)
| .intCast k => return mkApp ( getIntCastFn) (mkIntLit k)
| .var x => return getVarExpr x
| .add a b => return mkApp2 ( getAddFn) ( go a) ( go b)
| .sub a b => return mkApp2 ( getSubFn) ( go a) ( go b)
| .mul a b => return mkApp2 ( getMulFn) ( go a) ( go b)
| .pow a k => return mkApp2 ( getPowFn) ( go a) (toExpr k)
| .neg a => return mkApp ( getNegFn) ( go a)
/-- Denote a `RingExpr` using an explicit variable array. -/
def denoteRingExpr (vars : Array Expr) (e : RingExpr) : m Expr := do
denoteRingExprCore (fun x => vars[x]!) e
end Lean.Meta.Sym.Arith

View File

@@ -0,0 +1,90 @@
/-
Copyright (c) 2026 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.Sym.Arith.Types
import Lean.Meta.Sym.LitValues
import Lean.Meta.IntInstTesters
import Lean.Meta.NatInstTesters
public section
namespace Lean.Meta.Sym.Arith
/-!
Functions for evaluating simple `Nat` and `Int` expressions that appear in type classes
(e.g., `ToInt` and `IsCharP`). Using `whnf` for this purpose is too expensive and can
exhaust the stack. We considered `evalExpr` as an alternative, but it introduces
considerable overhead. We may use `evalExpr` as a fallback in the future.
-/
def checkExp (k : Nat) : OptionT SymM Unit := do
let exp getExpThreshold
if k > exp then
reportIssue! "exponent {k} exceeds threshold for exponentiation `(exp := {exp})`"
failure
/-
**Note**: It is safe to use (the more efficient) structural instance tests here because
`Sym.Canon` has already run.
-/
open Structural in
mutual
private partial def evalNatCore (e : Expr) : OptionT SymM Nat := do
match_expr e with
| Nat.zero => return 0
| Nat.succ a => return ( evalNatCore a) + 1
| Int.toNat a => return ( evalIntCore a).toNat
| Int.natAbs a => return ( evalIntCore a).natAbs
| HAdd.hAdd _ _ _ inst a b => guard ( isInstHAddNat inst); return ( evalNatCore a) + ( evalNatCore b)
| HMul.hMul _ _ _ inst a b => guard ( isInstHMulNat inst); return ( evalNatCore a) * ( evalNatCore b)
| HSub.hSub _ _ _ inst a b => guard ( isInstHSubNat inst); return ( evalNatCore a) - ( evalNatCore b)
| HDiv.hDiv _ _ _ inst a b => guard ( isInstHDivNat inst); return ( evalNatCore a) / ( evalNatCore b)
| HMod.hMod _ _ _ inst a b => guard ( isInstHModNat inst); return ( evalNatCore a) % ( evalNatCore b)
| OfNat.ofNat _ _ _ =>
let some n := Sym.getNatValue? e |>.run | failure
return n
| HPow.hPow _ _ _ inst a k =>
guard ( isInstHPowNat inst)
let k evalNatCore k
checkExp k
let a evalNatCore a
return a ^ k
| _ => failure
private partial def evalIntCore (e : Expr) : OptionT SymM Int := do
match_expr e with
| Neg.neg _ i a => guard ( isInstNegInt i); return - ( evalIntCore a)
| HAdd.hAdd _ _ _ i a b => guard ( isInstHAddInt i); return ( evalIntCore a) + ( evalIntCore b)
| HSub.hSub _ _ _ i a b => guard ( isInstHSubInt i); return ( evalIntCore a) - ( evalIntCore b)
| HMul.hMul _ _ _ i a b => guard ( isInstHMulInt i); return ( evalIntCore a) * ( evalIntCore b)
| HDiv.hDiv _ _ _ i a b => guard ( isInstHDivInt i); return ( evalIntCore a) / ( evalIntCore b)
| HMod.hMod _ _ _ i a b => guard ( isInstHModInt i); return ( evalIntCore a) % ( evalIntCore b)
| HPow.hPow _ _ _ i a k =>
guard ( isInstHPowInt i)
let a evalIntCore a
let k evalNatCore k
checkExp k
return a ^ k
| OfNat.ofNat _ _ _ =>
let some n := Sym.getIntValue? e |>.run | failure
return n
| NatCast.natCast _ i a =>
let_expr instNatCastInt i | failure
return ( evalNatCore a)
| Nat.cast _ i a =>
let_expr instNatCastInt i | failure
return ( evalNatCore a)
| _ => failure
end
def evalNat? (e : Expr) : SymM (Option Nat) :=
evalNatCore e |>.run
def evalInt? (e : Expr) : SymM (Option Int) :=
evalIntCore e |>.run
end Lean.Meta.Sym.Arith

View File

@@ -0,0 +1,171 @@
/-
Copyright (c) 2026 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.Sym.Arith.MonadRing
public import Lean.Meta.Sym.Arith.MonadSemiring
public section
namespace Lean.Meta.Sym.Arith
/-!
# Cached function expressions for arithmetic operators
Synthesizes and caches the canonical Lean expressions for arithmetic operators
(`+`, `*`, `-`, `^`, `intCast`, `natCast`, etc.). These cached expressions are used
during reification to validate instances via pointer equality (`isSameExpr`).
Each getter checks the cache field first. On a miss, it synthesizes the instance,
verifies it against the expected instance from the ring structure using `isDefEqI`,
canonicalizes the result via `canonExpr`, and stores it.
-/
variable [MonadLiftT MetaM m] [MonadError m] [Monad m] [MonadCanon m]
private def checkInst (declName : Name) (inst inst' : Expr) : MetaM Unit := do
unless ( withReducibleAndInstances <| isDefEq inst inst') do
throwError "error while initializing arithmetic operators:\ninstance for `{declName}` {indentExpr inst}\nis not definitionally equal to the expected one {indentExpr inst'}\nwhen only reducible definitions and instances are reduced"
private def mkUnaryFn (type : Expr) (u : Level) (instDeclName : Name) (declName : Name) (expectedInst : Expr) : m Expr := do
let inst MonadCanon.synthInstance <| mkApp (mkConst instDeclName [u]) type
checkInst declName inst expectedInst
canonExpr <| mkApp2 (mkConst declName [u]) type inst
private def mkBinHomoFn (type : Expr) (u : Level) (instDeclName : Name) (declName : Name) (expectedInst : Expr) : m Expr := do
let inst MonadCanon.synthInstance <| mkApp3 (mkConst instDeclName [u, u, u]) type type type
checkInst declName inst expectedInst
canonExpr <| mkApp4 (mkConst declName [u, u, u]) type type type inst
private def mkPowFn (u : Level) (type : Expr) (semiringInst : Expr) : m Expr := do
let inst MonadCanon.synthInstance <| mkApp3 (mkConst ``HPow [u, 0, u]) type Nat.mkType type
let inst' := mkApp2 (mkConst ``Grind.Semiring.npow [u]) type semiringInst
checkInst ``HPow.hPow inst inst'
canonExpr <| mkApp4 (mkConst ``HPow.hPow [u, 0, u]) type Nat.mkType type inst
private def mkNatCastFn (u : Level) (type : Expr) (semiringInst : Expr) : m Expr := do
let inst' := mkApp2 (mkConst ``Grind.Semiring.natCast [u]) type semiringInst
let instType := mkApp (mkConst ``NatCast [u]) type
-- Note: `Semiring.natCast` is not a global instance, so `NatCast α` may not be available.
-- When present, verify defeq; otherwise fall back to the semiring field.
let inst match ( MonadCanon.synthInstance? instType) with
| none => pure inst'
| some inst => checkInst ``NatCast.natCast inst inst'; pure inst
canonExpr <| mkApp2 (mkConst ``NatCast.natCast [u]) type inst
section RingFns
variable [MonadRing m]
def getAddFn : m Expr := do
let ring getRing
if let some addFn := ring.addFn? then return addFn
let expectedInst := mkApp2 (mkConst ``instHAdd [ring.u]) ring.type <| mkApp2 (mkConst ``Grind.Semiring.toAdd [ring.u]) ring.type ring.semiringInst
let addFn mkBinHomoFn ring.type ring.u ``HAdd ``HAdd.hAdd expectedInst
modifyRing fun s => { s with addFn? := some addFn }
return addFn
def getMulFn : m Expr := do
let ring getRing
if let some mulFn := ring.mulFn? then return mulFn
let expectedInst := mkApp2 (mkConst ``instHMul [ring.u]) ring.type <| mkApp2 (mkConst ``Grind.Semiring.toMul [ring.u]) ring.type ring.semiringInst
let mulFn mkBinHomoFn ring.type ring.u ``HMul ``HMul.hMul expectedInst
modifyRing fun s => { s with mulFn? := some mulFn }
return mulFn
def getSubFn : m Expr := do
let ring getRing
if let some subFn := ring.subFn? then return subFn
let expectedInst := mkApp2 (mkConst ``instHSub [ring.u]) ring.type <| mkApp2 (mkConst ``Grind.Ring.toSub [ring.u]) ring.type ring.ringInst
let subFn mkBinHomoFn ring.type ring.u ``HSub ``HSub.hSub expectedInst
modifyRing fun s => { s with subFn? := some subFn }
return subFn
def getNegFn : m Expr := do
let ring getRing
if let some negFn := ring.negFn? then return negFn
let expectedInst := mkApp2 (mkConst ``Grind.Ring.toNeg [ring.u]) ring.type ring.ringInst
let negFn mkUnaryFn ring.type ring.u ``Neg ``Neg.neg expectedInst
modifyRing fun s => { s with negFn? := some negFn }
return negFn
def getPowFn : m Expr := do
let ring getRing
if let some powFn := ring.powFn? then return powFn
let powFn mkPowFn ring.u ring.type ring.semiringInst
modifyRing fun s => { s with powFn? := some powFn }
return powFn
def getIntCastFn : m Expr := do
let ring getRing
if let some intCastFn := ring.intCastFn? then return intCastFn
let inst' := mkApp2 (mkConst ``Grind.Ring.intCast [ring.u]) ring.type ring.ringInst
let instType := mkApp (mkConst ``IntCast [ring.u]) ring.type
-- Note: `Ring.intCast` is not a global instance. Same pattern as `mkNatCastFn`.
let inst match ( MonadCanon.synthInstance? instType) with
| none => pure inst'
| some inst => checkInst ``Int.cast inst inst'; pure inst
let intCastFn canonExpr <| mkApp2 (mkConst ``IntCast.intCast [ring.u]) ring.type inst
modifyRing fun s => { s with intCastFn? := some intCastFn }
return intCastFn
def getNatCastFn : m Expr := do
let ring getRing
if let some natCastFn := ring.natCastFn? then return natCastFn
let natCastFn mkNatCastFn ring.u ring.type ring.semiringInst
modifyRing fun s => { s with natCastFn? := some natCastFn }
return natCastFn
end RingFns
section CommRingFns
variable [MonadCommRing m]
def getInvFn : m Expr := do
let ring getCommRing
let some fieldInst := ring.fieldInst?
| throwError "internal error: type is not a field{indentExpr ring.type}"
if let some invFn := ring.invFn? then return invFn
let expectedInst := mkApp2 (mkConst ``Grind.Field.toInv [ring.u]) ring.type fieldInst
let invFn mkUnaryFn ring.type ring.u ``Inv ``Inv.inv expectedInst
modifyCommRing fun s => { s with invFn? := some invFn }
return invFn
end CommRingFns
section SemiringFns
variable [MonadSemiring m]
def getAddFn' : m Expr := do
let sr getSemiring
if let some addFn := sr.addFn? then return addFn
let expectedInst := mkApp2 (mkConst ``instHAdd [sr.u]) sr.type <| mkApp2 (mkConst ``Grind.Semiring.toAdd [sr.u]) sr.type sr.semiringInst
let addFn mkBinHomoFn sr.type sr.u ``HAdd ``HAdd.hAdd expectedInst
modifySemiring fun s => { s with addFn? := some addFn }
return addFn
def getMulFn' : m Expr := do
let sr getSemiring
if let some mulFn := sr.mulFn? then return mulFn
let expectedInst := mkApp2 (mkConst ``instHMul [sr.u]) sr.type <| mkApp2 (mkConst ``Grind.Semiring.toMul [sr.u]) sr.type sr.semiringInst
let mulFn mkBinHomoFn sr.type sr.u ``HMul ``HMul.hMul expectedInst
modifySemiring fun s => { s with mulFn? := some mulFn }
return mulFn
def getPowFn' : m Expr := do
let sr getSemiring
if let some powFn := sr.powFn? then return powFn
let powFn mkPowFn sr.u sr.type sr.semiringInst
modifySemiring fun s => { s with powFn? := some powFn }
return powFn
def getNatCastFn' : m Expr := do
let sr getSemiring
if let some natCastFn := sr.natCastFn? then return natCastFn
let natCastFn mkNatCastFn sr.u sr.type sr.semiringInst
modifySemiring fun s => { s with natCastFn? := some natCastFn }
return natCastFn
end SemiringFns
end Lean.Meta.Sym.Arith

View File

@@ -1,24 +1,23 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Copyright (c) 2026 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.Arith.CommRing.Types
public import Lean.Meta.Sym.Arith.Types
public section
namespace Lean.Meta.Grind.Arith.CommRing
namespace Lean.Meta.Sym.Arith
class MonadCanon (m : Type Type) where
/--
Helper function for removing dependency on `GoalM`.
In `RingM` and `SemiringM`, this is just `sharedCommon ( canon e)`
When printing counterexamples, we are at `MetaM`, and this is just the identity function.
Canonicalize an expression (types, instances, support arguments).
In `SymM`, this is `Sym.canon`. In `PP.M` (diagnostics), this is the identity.
-/
canonExpr : Expr m Expr
/--
Helper function for removing dependency on `GoalM`. During search we
want to track the instances synthesized by `grind`, and this is `Grind.synthInstance`.
Synthesize an instance, returning `none` on failure.
In `SymM`, this is `Sym.synthInstance?`. In `PP.M`, this is `Meta.synthInstance?`.
-/
synthInstance? : Expr m (Option Expr)
@@ -31,7 +30,7 @@ instance (m n) [MonadLift m n] [MonadCanon m] : MonadCanon n where
def MonadCanon.synthInstance [Monad m] [MonadError m] [MonadCanon m] (type : Expr) : m Expr := do
let some inst synthInstance? type
| throwError "`grind` failed to find instance{indentExpr type}"
| throwError "failed to find instance{indentExpr type}"
return inst
end Lean.Meta.Grind.Arith.CommRing
end Lean.Meta.Sym.Arith

View File

@@ -0,0 +1,39 @@
/-
Copyright (c) 2026 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.Sym.Arith.MonadCanon
public section
namespace Lean.Meta.Sym.Arith
class MonadRing (m : Type Type) where
getRing : m Ring
modifyRing : (Ring Ring) m Unit
export MonadRing (getRing modifyRing)
@[always_inline]
instance (m n) [MonadLift m n] [MonadRing m] : MonadRing n where
getRing := liftM (getRing : m Ring)
modifyRing f := liftM (modifyRing f : m Unit)
class MonadCommRing (m : Type Type) where
getCommRing : m CommRing
modifyCommRing : (CommRing CommRing) m Unit
export MonadCommRing (getCommRing modifyCommRing)
@[always_inline]
instance (m n) [MonadLift m n] [MonadCommRing m] : MonadCommRing n where
getCommRing := liftM (getCommRing : m CommRing)
modifyCommRing f := liftM (modifyCommRing f : m Unit)
@[always_inline]
instance (m) [Monad m] [MonadCommRing m] : MonadRing m where
getRing := return ( getCommRing).toRing
modifyRing f := modifyCommRing fun s => { s with toRing := f s.toRing }
end Lean.Meta.Sym.Arith

View File

@@ -0,0 +1,39 @@
/-
Copyright (c) 2026 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.Sym.Arith.MonadCanon
public section
namespace Lean.Meta.Sym.Arith
class MonadSemiring (m : Type Type) where
getSemiring : m Semiring
modifySemiring : (Semiring Semiring) m Unit
export MonadSemiring (getSemiring modifySemiring)
@[always_inline]
instance (m n) [MonadLift m n] [MonadSemiring m] : MonadSemiring n where
getSemiring := liftM (getSemiring : m Semiring)
modifySemiring f := liftM (modifySemiring f : m Unit)
class MonadCommSemiring (m : Type Type) where
getCommSemiring : m CommSemiring
modifyCommSemiring : (CommSemiring CommSemiring) m Unit
export MonadCommSemiring (getCommSemiring modifyCommSemiring)
@[always_inline]
instance (m n) [MonadLift m n] [MonadCommSemiring m] : MonadCommSemiring n where
getCommSemiring := liftM (getCommSemiring : m CommSemiring)
modifyCommSemiring f := liftM (modifyCommSemiring f : m Unit)
@[always_inline]
instance (m) [Monad m] [MonadCommSemiring m] : MonadSemiring m where
getSemiring := return ( getCommSemiring).toSemiring
modifySemiring f := modifyCommSemiring fun s => { s with toSemiring := f s.toSemiring }
end Lean.Meta.Sym.Arith

View File

@@ -0,0 +1,32 @@
/-
Copyright (c) 2026 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.Sym.Arith.Types
public section
namespace Lean.Meta.Sym.Arith
/-- Read a variable's Lean expression by index. Used by `DenoteExpr` and diagnostics (PP). -/
class MonadGetVar (m : Type Type) where
getVar : Var m Expr
export MonadGetVar (getVar)
@[always_inline]
instance (m n) [MonadLift m n] [MonadGetVar m] : MonadGetVar n where
getVar x := liftM (getVar x : m Expr)
/-- Create or lookup a variable for a Lean expression. Used by reification. -/
class MonadMkVar (m : Type Type) where
mkVar : Expr m Var
export MonadMkVar (mkVar)
@[always_inline]
instance (m n) [MonadLift m n] [MonadMkVar m] : MonadMkVar n where
mkVar e := liftM (mkVar e : m Var)
end Lean.Meta.Sym.Arith

View File

@@ -0,0 +1,205 @@
/-
Copyright (c) 2026 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.Sym.Arith.Functions
public import Lean.Meta.Sym.Arith.MonadVar
public import Lean.Meta.Sym.LitValues
public section
namespace Lean.Meta.Sym.Arith
open Sym.Arith (MonadCanon)
/-!
# Reification of arithmetic expressions
Converts Lean expressions into `CommRing.Expr` (ring) or `CommSemiring.Expr`
(semiring) for reflection-based normalization.
Instance validation uses pointer equality (`isSameExpr`) against cached function
expressions from `Functions.lean`.
## Differences from grind's `Reify.lean`
- Uses `MonadMkVar` for variable creation instead of grind's `internalize` + `mkVarCore`
- Uses `Sym.getNatValue?`/`Sym.getIntValue?` (pure) instead of `MetaM` versions
- No `MonadSetTermId` — term-to-ring-id tracking is grind-specific
-/
section RingReify
variable [MonadLiftT SymM m] [MonadLiftT MetaM m] [MonadError m] [Monad m] [MonadCanon m] [MonadRing m] [MonadMkVar m]
def isAddInst (inst : Expr) : m Bool :=
return isSameExpr ( getAddFn).appArg! inst
def isMulInst (inst : Expr) : m Bool :=
return isSameExpr ( getMulFn).appArg! inst
def isSubInst (inst : Expr) : m Bool :=
return isSameExpr ( getSubFn).appArg! inst
def isNegInst (inst : Expr) : m Bool :=
return isSameExpr ( getNegFn).appArg! inst
def isPowInst (inst : Expr) : m Bool :=
return isSameExpr ( getPowFn).appArg! inst
def isIntCastInst (inst : Expr) : m Bool :=
return isSameExpr ( getIntCastFn).appArg! inst
def isNatCastInst (inst : Expr) : m Bool :=
return isSameExpr ( getNatCastFn).appArg! inst
private def reportRingAppIssue [MonadLiftT SymM m] (e : Expr) : m Unit := do
reportIssue! "ring term with unexpected instance{indentExpr e}"
/--
Converts a Lean expression `e` into a `RingExpr`.
If `skipVar` is `true`, returns `none` if `e` is not an interpreted ring term
(used for equalities/disequalities). If `false`, treats non-interpreted terms
as variables (used for inequalities).
-/
partial def reifyRing? (e : Expr) (skipVar : Bool := true) : m (Option RingExpr) := do
let toVar (e : Expr) : m RingExpr := do
return .var ( mkVar e)
let asVar (e : Expr) : m RingExpr := do
reportRingAppIssue e
return .var ( mkVar e)
let rec go (e : Expr) : m RingExpr := do
match_expr e with
| HAdd.hAdd _ _ _ i a b =>
if ( isAddInst i) then return .add ( go a) ( go b) else asVar e
| HMul.hMul _ _ _ i a b =>
if ( isMulInst i) then return .mul ( go a) ( go b) else asVar e
| HSub.hSub _ _ _ i a b =>
if ( isSubInst i) then return .sub ( go a) ( go b) else asVar e
| HPow.hPow _ _ _ i a b =>
let some k := Sym.getNatValue? b |>.run | toVar e
if ( isPowInst i) then return .pow ( go a) k else asVar e
| Neg.neg _ i a =>
if ( isNegInst i) then return .neg ( go a) else asVar e
| IntCast.intCast _ i a =>
if ( isIntCastInst i) then
let some k := Sym.getIntValue? a |>.run | toVar e
return .intCast k
else
asVar e
| NatCast.natCast _ i a =>
if ( isNatCastInst i) then
let some k := Sym.getNatValue? a |>.run | toVar e
return .natCast k
else
asVar e
| OfNat.ofNat _ n _ =>
/-
**Note**: We extract `n` directly as a raw nat literal. The grind version uses `MetaM`'s
`getNatValue?` which handles multiple encodings (raw literals, nested `OfNat`, etc.).
In `SymM`, we assume terms have been canonicalized by `Sym.canon` before reification,
so `OfNat.ofNat _ n _` always has a raw nat literal at position 1.
-/
let .lit (.natVal k) := n | toVar e
return .num k
| BitVec.ofNat _ n =>
let .lit (.natVal k) := n | toVar e
return .num k
| _ => toVar e
let toTopVar (e : Expr) : m (Option RingExpr) := do
if skipVar then
return none
else
return some ( toVar e)
let asTopVar (e : Expr) : m (Option RingExpr) := do
reportRingAppIssue e
toTopVar e
match_expr e with
| HAdd.hAdd _ _ _ i a b =>
if ( isAddInst i) then return some (.add ( go a) ( go b)) else asTopVar e
| HMul.hMul _ _ _ i a b =>
if ( isMulInst i) then return some (.mul ( go a) ( go b)) else asTopVar e
| HSub.hSub _ _ _ i a b =>
if ( isSubInst i) then return some (.sub ( go a) ( go b)) else asTopVar e
| HPow.hPow _ _ _ i a b =>
let some k := Sym.getNatValue? b |>.run | asTopVar e
if ( isPowInst i) then return some (.pow ( go a) k) else asTopVar e
| Neg.neg _ i a =>
if ( isNegInst i) then return some (.neg ( go a)) else asTopVar e
| IntCast.intCast _ i a =>
if ( isIntCastInst i) then
let some k := Sym.getIntValue? a |>.run | toTopVar e
return some (.intCast k)
else
asTopVar e
| NatCast.natCast _ i a =>
if ( isNatCastInst i) then
let some k := Sym.getNatValue? a |>.run | toTopVar e
return some (.natCast k)
else
asTopVar e
| OfNat.ofNat _ n _ =>
let .lit (.natVal k) := n | asTopVar e
return some (.num k)
| _ => toTopVar e
end RingReify
section SemiringReify
variable [MonadLiftT SymM m] [MonadLiftT MetaM m] [MonadError m] [Monad m] [MonadCanon m] [MonadSemiring m] [MonadMkVar m]
private def reportSemiringAppIssue [MonadLiftT SymM m] (e : Expr) : m Unit := do
reportIssue! "semiring term with unexpected instance{indentExpr e}"
/--
Converts a Lean expression `e` into a `SemiringExpr`.
Only recognizes `add`, `mul`, `pow`, `natCast`, and numerals (no `sub`, `neg`, `intCast`).
-/
partial def reifySemiring? (e : Expr) : m (Option SemiringExpr) := do
let toVar (e : Expr) : m SemiringExpr := do
return .var ( mkVar e)
let asVar (e : Expr) : m SemiringExpr := do
reportSemiringAppIssue e
return .var ( mkVar e)
let rec go (e : Expr) : m SemiringExpr := do
match_expr e with
| HAdd.hAdd _ _ _ i a b =>
if isSameExpr ( getAddFn').appArg! i then return .add ( go a) ( go b) else asVar e
| HMul.hMul _ _ _ i a b =>
if isSameExpr ( getMulFn').appArg! i then return .mul ( go a) ( go b) else asVar e
| HPow.hPow _ _ _ i a b =>
let some k := Sym.getNatValue? b |>.run | toVar e
if isSameExpr ( getPowFn').appArg! i then return .pow ( go a) k else asVar e
| NatCast.natCast _ i a =>
if isSameExpr ( getNatCastFn').appArg! i then
let some k := Sym.getNatValue? a |>.run | toVar e
return .num k
else
asVar e
| OfNat.ofNat _ n _ =>
let .lit (.natVal k) := n | toVar e
return .num k
| _ => toVar e
let toTopVar (e : Expr) : m (Option SemiringExpr) := do
return some ( toVar e)
let asTopVar (e : Expr) : m (Option SemiringExpr) := do
reportSemiringAppIssue e
toTopVar e
match_expr e with
| HAdd.hAdd _ _ _ i a b =>
if isSameExpr ( getAddFn').appArg! i then return some (.add ( go a) ( go b)) else asTopVar e
| HMul.hMul _ _ _ i a b =>
if isSameExpr ( getMulFn').appArg! i then return some (.mul ( go a) ( go b)) else asTopVar e
| HPow.hPow _ _ _ i a b =>
let some k := Sym.getNatValue? b |>.run | return none
if isSameExpr ( getPowFn').appArg! i then return some (.pow ( go a) k) else asTopVar e
| NatCast.natCast _ i a =>
if isSameExpr ( getNatCastFn').appArg! i then
let some k := Sym.getNatValue? a |>.run | toTopVar e
return some (.num k)
else
asTopVar e
| OfNat.ofNat _ n _ =>
let .lit (.natVal k) := n | asTopVar e
return some (.num k)
| _ => toTopVar e
end SemiringReify
end Lean.Meta.Sym.Arith

View File

@@ -8,7 +8,7 @@ prelude
public import Init.Grind.Ring.CommSemiringAdapter
public import Lean.ToExpr
public section
namespace Lean.Meta.Grind.Arith.CommRing
namespace Lean.Meta.Sym.Arith
open Grind.CommRing
/-!
`ToExpr` instances for `CommRing.Poly` types.
@@ -57,4 +57,4 @@ instance : ToExpr CommRing.Expr where
toExpr := ofRingExpr
toTypeExpr := mkConst ``CommRing.Expr
end Lean.Meta.Grind.Arith.CommRing
end Lean.Meta.Sym.Arith

View File

@@ -0,0 +1,137 @@
/-
Copyright (c) 2026 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 Init.Grind.Ring.CommSemiringAdapter
public import Lean.Meta.Sym.SymM
public section
namespace Lean.Meta.Sym.Arith
export Lean.Grind.CommRing (Var Power Mon Poly)
abbrev RingExpr := Grind.CommRing.Expr
/-
**Note**: recall that we use ring expressions to represent semiring expressions,
and ignore non-applicable constructors.
-/
abbrev SemiringExpr := Grind.CommRing.Expr
/-- Classification state for a type with a `Semiring` instance. -/
structure Semiring where
id : Nat
type : Expr
/-- Cached `getDecLevel type` -/
u : Level
/-- `Semiring` instance for `type` -/
semiringInst : Expr
addFn? : Option Expr := none
mulFn? : Option Expr := none
powFn? : Option Expr := none
natCastFn? : Option Expr := none
deriving Inhabited
/-- Classification state for a type with a `Ring` instance. -/
structure Ring where
id : Nat
type : Expr
/-- Cached `getDecLevel type` -/
u : Level
/-- `Ring` instance for `type` -/
ringInst : Expr
/-- `Semiring` instance for `type` -/
semiringInst : Expr
/-- `IsCharP` instance for `type` if available. -/
charInst? : Option (Expr × Nat)
addFn? : Option Expr := none
mulFn? : Option Expr := none
subFn? : Option Expr := none
negFn? : Option Expr := none
powFn? : Option Expr := none
intCastFn? : Option Expr := none
natCastFn? : Option Expr := none
one? : Option Expr := none
deriving Inhabited
/-- Classification state for a type with a `CommRing` instance. -/
structure CommRing extends Ring where
/-- Inverse function if `fieldInst?` is `some inst` -/
invFn? : Option Expr := none
/--
If this is a `OfSemiring.Q α` ring, this field contains the
`semiringId` for `α`.
-/
semiringId? : Option Nat
/-- `CommSemiring` instance for `type` -/
commSemiringInst : Expr
/-- `CommRing` instance for `type` -/
commRingInst : Expr
/-- `NoNatZeroDivisors` instance for `type` if available. -/
noZeroDivInst? : Option Expr
/-- `Field` instance for `type` if available. -/
fieldInst? : Option Expr
deriving Inhabited
/--
Classification state for a type with a `CommSemiring` instance.
Recall that `CommSemiring` types are normalized using the `OfSemiring.Q` envelope.
-/
structure CommSemiring extends Semiring where
/-- Id of the envelope ring `OfSemiring.Q type` -/
ringId : Nat
/-- `CommSemiring` instance for `type` -/
commSemiringInst : Expr
/-- `AddRightCancel` instance for `type` if available. -/
addRightCancelInst? : Option (Option Expr) := none
toQFn? : Option Expr := none
deriving Inhabited
/-- Result of classifying a type's algebraic structure. -/
inductive ClassifyResult where
| commRing (id : Nat)
| nonCommRing (id : Nat)
| commSemiring (id : Nat)
| nonCommSemiring (id : Nat)
| /-- No algebraic structure found. -/ none
deriving Inhabited
/-- Arith type classification state, stored as a `SymExtension`. -/
structure State where
/-- Exponent threshold for `HPow` evaluation. -/
exp : Nat := 8
/-- Commutative rings. -/
rings : Array CommRing := {}
/-- Commutative semirings. -/
semirings : Array CommSemiring := {}
/-- Non-commutative rings. -/
ncRings : Array Ring := {}
/-- Non-commutative semirings. -/
ncSemirings : Array Semiring := {}
/-- Mapping from types to their classification result. Caches failures as `.none`. -/
typeClassify : PHashMap ExprPtr ClassifyResult := {}
deriving Inhabited
builtin_initialize arithExt : SymExtension State registerSymExtension (return {})
def getArithState : SymM State :=
arithExt.getState
@[inline] def modifyArithState (f : State State) : SymM Unit :=
arithExt.modifyState f
/-- Get the exponent threshold. -/
def getExpThreshold : SymM Nat :=
return ( getArithState).exp
/-- Set the exponent threshold. -/
def setExpThreshold (exp : Nat) : SymM Unit :=
modifyArithState fun s => { s with exp }
/-- Run `k` with a temporary exponent threshold. -/
def withExpThreshold (exp : Nat) (k : SymM α) : SymM α := do
let oldExp := ( getArithState).exp
setExpThreshold exp
try k finally setExpThreshold oldExp
end Lean.Meta.Sym.Arith

View File

@@ -5,11 +5,9 @@ Authors: Leonardo de Moura
-/
module
prelude
public import Lean.Meta.Tactic.Grind.Arith.CommRing.Poly
public import Lean.Meta.Tactic.Grind.Arith.CommRing.Types
public import Lean.Meta.Tactic.Grind.Arith.CommRing.RingId
public import Lean.Meta.Tactic.Grind.Arith.CommRing.Internalize
public import Lean.Meta.Tactic.Grind.Arith.CommRing.ToExpr
public import Lean.Meta.Tactic.Grind.Arith.CommRing.RingM
public import Lean.Meta.Tactic.Grind.Arith.CommRing.SemiringM
public import Lean.Meta.Tactic.Grind.Arith.CommRing.NonCommRingM
@@ -21,8 +19,6 @@ public import Lean.Meta.Tactic.Grind.Arith.CommRing.Proof
public import Lean.Meta.Tactic.Grind.Arith.CommRing.DenoteExpr
public import Lean.Meta.Tactic.Grind.Arith.CommRing.Inv
public import Lean.Meta.Tactic.Grind.Arith.CommRing.PP
public import Lean.Meta.Tactic.Grind.Arith.CommRing.VarRename
public import Lean.Meta.Tactic.Grind.Arith.CommRing.MonadCanon
public import Lean.Meta.Tactic.Grind.Arith.CommRing.MonadRing
public import Lean.Meta.Tactic.Grind.Arith.CommRing.MonadSemiring
public import Lean.Meta.Tactic.Grind.Arith.CommRing.Action

View File

@@ -8,6 +8,7 @@ prelude
public import Lean.Meta.Tactic.Grind.Arith.CommRing.Functions
public section
namespace Lean.Meta.Grind.Arith.CommRing
open Sym.Arith
/-!
Helper functions for converting reified terms back into their denotations.
-/

View File

@@ -8,6 +8,7 @@ prelude
public import Lean.Meta.Tactic.Grind.Arith.CommRing.MonadRing
public section
namespace Lean.Meta.Grind.Arith.CommRing
open Sym.Arith
variable [MonadLiftT MetaM m] [MonadError m] [Monad m] [MonadCanon m]
section

View File

@@ -6,7 +6,7 @@ Authors: Leonardo de Moura
module
prelude
public import Lean.Meta.Tactic.Grind.Arith.CommRing.RingM
import Lean.Meta.Tactic.Grind.Arith.CommRing.Poly
import Lean.Meta.Sym.Arith.Poly
public section
namespace Lean.Meta.Grind.Arith.CommRing

View File

@@ -5,7 +5,8 @@ Authors: Leonardo de Moura
-/
module
prelude
public import Lean.Meta.Tactic.Grind.Arith.CommRing.MonadCanon
public import Lean.Meta.Sym.Arith.MonadCanon
public import Lean.Meta.Tactic.Grind.Arith.CommRing.Types
public section
namespace Lean.Meta.Grind.Arith.CommRing

View File

@@ -5,7 +5,8 @@ Authors: Leonardo de Moura
-/
module
prelude
public import Lean.Meta.Tactic.Grind.Arith.CommRing.MonadCanon
public import Lean.Meta.Sym.Arith.MonadCanon
public import Lean.Meta.Tactic.Grind.Arith.CommRing.Types
public section
namespace Lean.Meta.Grind.Arith.CommRing

View File

@@ -8,7 +8,7 @@ prelude
public import Lean.Meta.Tactic.Grind.Arith.CommRing.RingM
public section
namespace Lean.Meta.Grind.Arith.CommRing
open Sym.Arith
structure NonCommRingM.Context where
ringId : Nat

View File

@@ -8,6 +8,7 @@ prelude
public import Lean.Meta.Tactic.Grind.Arith.CommRing.SemiringM
public section
namespace Lean.Meta.Grind.Arith.CommRing
open Sym.Arith (MonadCanon)
structure NonCommSemiringM.Context where
semiringId : Nat

View File

@@ -10,6 +10,7 @@ import Lean.Meta.Tactic.Grind.Arith.CommRing.DenoteExpr
import Init.Omega
public section
namespace Lean.Meta.Grind.Arith.CommRing
open Sym.Arith
private abbrev M := StateT CommRing MetaM

View File

@@ -12,12 +12,14 @@ import Lean.Data.RArray
import Lean.Meta.Tactic.Grind.Diseq
import Lean.Meta.Tactic.Grind.ProofUtil
import Lean.Meta.Tactic.Grind.Arith.CommRing.DenoteExpr
import Lean.Meta.Tactic.Grind.Arith.CommRing.ToExpr
import Lean.Meta.Tactic.Grind.Arith.CommRing.VarRename
import Lean.Meta.Sym.Arith.ToExpr
import Lean.Meta.Sym.Arith.VarRename
import Init.Data.Nat.Order
import Init.Data.Order.Lemmas
public section
namespace Lean.Meta.Grind.Arith.CommRing
open Sym.Arith (MonadCanon)
/--
Returns a context of type `RArray α` containing the variables `vars` where
`α` is the type of the ring.

View File

@@ -9,6 +9,7 @@ public import Lean.Meta.Tactic.Grind.Arith.CommRing.NonCommRingM
public import Lean.Meta.Tactic.Grind.Arith.CommRing.NonCommSemiringM
public section
namespace Lean.Meta.Grind.Arith.CommRing
open Sym.Arith (MonadCanon)
variable [MonadLiftT MetaM m] [MonadError m] [Monad m] [MonadCanon m] [MonadRing m]

View File

@@ -9,6 +9,7 @@ public import Lean.Meta.Tactic.Grind.SynthInstance
public import Lean.Meta.Tactic.Grind.Arith.CommRing.MonadRing
public section
namespace Lean.Meta.Grind.Arith.CommRing
open Sym.Arith
def checkMaxSteps : GoalM Bool := do
return ( get').steps >= ( getConfig).ringSteps

View File

@@ -6,7 +6,7 @@ Authors: Leonardo de Moura
module
prelude
public import Lean.Meta.Tactic.Grind.Arith.CommRing.RingM
public import Lean.Meta.Tactic.Grind.Arith.CommRing.Poly
public import Lean.Meta.Sym.Arith.Poly
import Lean.Meta.Tactic.Grind.Arith.EvalNum
import Init.Data.Nat.Linear
public section

View File

@@ -11,6 +11,7 @@ import Lean.Meta.Tactic.Grind.Arith.CommRing.DenoteExpr
public import Lean.Meta.Tactic.Grind.Arith.CommRing.Functions
public section
namespace Lean.Meta.Grind.Arith.CommRing
open Sym.Arith
structure SemiringM.Context where
semiringId : Nat

View File

@@ -7,7 +7,7 @@ module
prelude
public import Init.Grind.Ring.CommSemiringAdapter
public import Lean.Meta.Tactic.Grind.Types
import Lean.Meta.Tactic.Grind.Arith.CommRing.Poly
import Lean.Meta.Sym.Arith.Poly
public section
namespace Lean.Meta.Grind.Arith.CommRing

View File

@@ -14,8 +14,8 @@ import Lean.Meta.Tactic.Grind.Arith.Cutsat.CommRing
import Lean.Meta.Tactic.Grind.Arith.Cutsat.Util
import Lean.Meta.Tactic.Grind.Arith.Cutsat.Nat
import Lean.Meta.Tactic.Grind.Arith.Cutsat.VarRename
import Lean.Meta.Tactic.Grind.Arith.CommRing.VarRename
import Lean.Meta.Tactic.Grind.Arith.CommRing.ToExpr
import Lean.Meta.Sym.Arith.VarRename
import Lean.Meta.Sym.Arith.ToExpr
import Init.Data.Nat.Order
import Init.Data.Order.Lemmas
public section

View File

@@ -9,6 +9,7 @@ public import Lean.Meta.Tactic.Grind.Arith.Linear.Types
public import Lean.Meta.Tactic.Grind.Arith.CommRing.RingM
public section
namespace Lean.Meta.Grind.Arith.Linear
open Sym.Arith (MonadCanon)
def get' : GoalM State := do
linearExt.getState

View File

@@ -11,8 +11,8 @@ import Lean.Data.RArray
import Lean.Meta.Tactic.Grind.Arith.Linear.ToExpr
import Lean.Meta.Tactic.Grind.Diseq
import Lean.Meta.Tactic.Grind.ProofUtil
import Lean.Meta.Tactic.Grind.Arith.CommRing.VarRename
import Lean.Meta.Tactic.Grind.Arith.CommRing.ToExpr
import Lean.Meta.Sym.Arith.VarRename
import Lean.Meta.Sym.Arith.ToExpr
import Lean.Meta.Tactic.Grind.Arith.Linear.VarRename
public import Lean.Meta.Tactic.Grind.Arith.Linear.DenoteExpr
public import Lean.Meta.Tactic.Grind.Arith.Linear.OfNatModule

View File

@@ -97,6 +97,8 @@ def mkCnstrNorm0 (s : Struct) (ringInst : Expr) (kind : CnstrKind) (lhs rhs : Ex
| .le => mkLeNorm0 s ringInst lhs rhs
| .lt => mkLtNorm0 s ringInst lhs rhs
open Sym.Arith (MonadCanon)
/--
Returns `rel lhs (rhs + 0)`
-/

View File

@@ -99,7 +99,7 @@ where
if ( withReducibleAndInstances <| isDefEq x val) then
return true
else
trace[Meta.Tactic.simp.discharge] "{← ppOrigin thmId}, failed to assign instance{indentExpr type}\nsynthesized value{indentExpr val}\nis not definitionally equal to{indentExpr x}"
trace[Meta.Tactic.simp.discharge] "{← ppOrigin thmId}, failed to assign instance{indentExpr type}\nsythesized value{indentExpr val}\nis not definitionally equal to{indentExpr x}"
return false
| _ =>
trace[Meta.Tactic.simp.discharge] "{← ppOrigin thmId}, failed to synthesize instance{indentExpr type}"

View File

@@ -46,7 +46,7 @@ structure LeanSemanticToken where
stx : Syntax
/-- Type of the semantic token. -/
type : SemanticTokenType
/-- In case of overlap, higher-priority tokens will take precedence -/
/-- In case of overlap, higher-priority tokens will take precendence -/
priority : Nat := 5
/-- Semantic token information with absolute LSP positions. -/
@@ -57,7 +57,7 @@ structure AbsoluteLspSemanticToken where
tailPos : Lsp.Position
/-- Start position of the semantic token. -/
type : SemanticTokenType
/-- In case of overlap, higher-priority tokens will take precedence -/
/-- In case of overlap, higher-priority tokens will take precendence -/
priority : Nat := 5
deriving BEq, Hashable, FromJson, ToJson

View File

@@ -14,7 +14,6 @@ public import Std.Internal.Http.Data.Status
public import Std.Internal.Http.Data.Chunk
public import Std.Internal.Http.Data.Headers
public import Std.Internal.Http.Data.URI
public import Std.Internal.Http.Data.Body
/-!
# HTTP Data Types

View File

@@ -1,24 +0,0 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
module
prelude
public import Std.Internal.Http.Data.Body.Basic
public import Std.Internal.Http.Data.Body.Length
public import Std.Internal.Http.Data.Body.Any
public import Std.Internal.Http.Data.Body.Stream
public import Std.Internal.Http.Data.Body.Empty
public import Std.Internal.Http.Data.Body.Full
public section
/-!
# Body
This module re-exports all HTTP body types: `Body.Empty`, `Body.Full`, `Body.Stream`,
`Body.Any`, and `Body.Length`, along with the `Http.Body` typeclass and conversion
utilities (`ToByteArray`, `FromByteArray`).
-/

View File

@@ -1,83 +0,0 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
module
prelude
public import Std.Internal.Http.Data.Body.Basic
public section
/-!
# Body.Any
A type-erased body backed by closures. Implements `Http.Body` and can be constructed from any
type that also implements `Http.Body`. Used as the default handler response body type.
-/
namespace Std.Http.Body
open Std Internal IO Async
set_option linter.all true
/--
A type-erased body handle. Operations are stored as closures, making it open to any body type
that implements `Http.Body`.
-/
structure Any where
/--
Receives the next body chunk. Returns `none` at end-of-stream.
-/
recv : Async (Option Chunk)
/--
Closes the body stream.
-/
close : Async Unit
/--
Returns `true` when the body stream is closed.
-/
isClosed : Async Bool
/--
Selector that resolves when a chunk is available or EOF is reached.
-/
recvSelector : Selector (Option Chunk)
/--
Returns the declared size.
-/
getKnownSize : Async (Option Body.Length)
/--
Sets the size of the body.
-/
setKnownSize : Option Body.Length Async Unit
namespace Any
/--
Erases a body of any `Http.Body` instance into a `Body.Any`.
-/
def ofBody [Http.Body α] (body : α) : Any where
recv := Http.Body.recv body
close := Http.Body.close body
isClosed := Http.Body.isClosed body
recvSelector := Http.Body.recvSelector body
getKnownSize := Http.Body.getKnownSize body
setKnownSize := Http.Body.setKnownSize body
end Any
instance : Http.Body Any where
recv := Any.recv
close := Any.close
isClosed := Any.isClosed
recvSelector := Any.recvSelector
getKnownSize := Any.getKnownSize
setKnownSize := Any.setKnownSize
end Std.Http.Body

View File

@@ -1,102 +0,0 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
module
prelude
public import Std.Internal.Async
public import Std.Internal.Async.ContextAsync
public import Std.Internal.Http.Data.Chunk
public import Std.Internal.Http.Data.Headers
public import Std.Internal.Http.Data.Body.Length
public section
/-!
# Body.Basic
This module defines the `Body` typeclass for HTTP body streams, and shared conversion types
`ToByteArray` and `FromByteArray` used for encoding and decoding body content.
-/
namespace Std.Http
open Std Internal IO Async
set_option linter.all true
/--
Typeclass for values that can be read as HTTP body streams.
-/
class Body (α : Type) where
/--
Receives the next body chunk. Returns `none` at end-of-stream.
-/
recv : α Async (Option Chunk)
/--
Closes the body stream.
-/
close : α Async Unit
/--
Returns `true` when the body stream is closed.
-/
isClosed : α Async Bool
/--
Selector that resolves when a chunk is available or EOF is reached.
-/
recvSelector : α Selector (Option Chunk)
/--
Gets the declared size of the body.
-/
getKnownSize : α Async (Option Body.Length)
/--
Sets the declared size of a body.
-/
setKnownSize : α Option Body.Length Async Unit
end Std.Http
namespace Std.Http.Body
/--
Typeclass for types that can be converted to a `ByteArray`.
-/
class ToByteArray (α : Type) where
/--
Transforms into a `ByteArray`.
-/
toByteArray : α ByteArray
instance : ToByteArray ByteArray where
toByteArray := id
instance : ToByteArray String where
toByteArray := String.toUTF8
/--
Typeclass for types that can be decoded from a `ByteArray`. The conversion may fail with an error
message if the bytes are not valid for the target type.
-/
class FromByteArray (α : Type) where
/--
Attempts to decode a `ByteArray` into the target type, returning an error message on failure.
-/
fromByteArray : ByteArray Except String α
instance : FromByteArray ByteArray where
fromByteArray := .ok
instance : FromByteArray String where
fromByteArray bs :=
match String.fromUTF8? bs with
| some s => .ok s
| none => .error "invalid UTF-8 encoding"
end Std.Http.Body

View File

@@ -1,116 +0,0 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
module
prelude
public import Std.Internal.Http.Data.Request
public import Std.Internal.Http.Data.Response
public import Std.Internal.Http.Data.Body.Any
public section
/-!
# Body.Empty
Represents an always-empty, already-closed body handle.
-/
namespace Std.Http.Body
open Std Internal IO Async
set_option linter.all true
/--
An empty body handle.
-/
structure Empty where
deriving Inhabited, BEq
namespace Empty
/--
Receives from an empty body, always returning end-of-stream.
-/
@[inline]
def recv (_ : Empty) : Async (Option Chunk) :=
pure none
/--
Closes an empty body (no-op).
-/
@[inline]
def close (_ : Empty) : Async Unit :=
pure ()
/--
Empty bodies are always closed for reading.
-/
@[inline]
def isClosed (_ : Empty) : Async Bool :=
pure true
/--
Selector that immediately resolves with end-of-stream for an empty body.
-/
@[inline]
def recvSelector (_ : Empty) : Selector (Option Chunk) where
tryFn := pure (some none)
registerFn waiter := do
let lose := pure ()
let win promise := do
promise.resolve (.ok none)
waiter.race lose win
unregisterFn := pure ()
end Empty
instance : Http.Body Empty where
recv := Empty.recv
close := Empty.close
isClosed := Empty.isClosed
recvSelector := Empty.recvSelector
getKnownSize _ := pure (some <| .fixed 0)
setKnownSize _ _ := pure ()
instance : Coe Empty Any := Any.ofBody
instance : Coe (Response Empty) (Response Any) where
coe f := { f with }
instance : Coe (ContextAsync (Response Empty)) (ContextAsync (Response Any)) where
coe action := do
let response action
pure (response : Response Any)
instance : Coe (Async (Response Empty)) (ContextAsync (Response Any)) where
coe action := do
let response action
pure (response : Response Any)
end Body
namespace Request.Builder
open Internal.IO.Async
/--
Builds a request with no body.
-/
def empty (builder : Builder) : Async (Request Body.Empty) :=
pure <| builder.body {}
end Request.Builder
namespace Response.Builder
open Internal.IO.Async
/--
Builds a response with no body.
-/
def empty (builder : Builder) : Async (Response Body.Empty) :=
pure <| builder.body {}
end Response.Builder

View File

@@ -1,232 +0,0 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
module
prelude
public import Std.Sync
public import Std.Internal.Http.Data.Request
public import Std.Internal.Http.Data.Response
public import Std.Internal.Http.Data.Body.Any
public import Init.Data.ByteArray
public section
/-!
# Body.Full
A body backed by a fixed `ByteArray` held in a `Mutex`.
The byte array is consumed at most once: the first call to `recv` atomically takes the data
and returns it as a single chunk; subsequent calls return `none` (end-of-stream).
Closing the body discards any unconsumed data.
-/
namespace Std.Http.Body
open Std Internal IO Async
set_option linter.all true
/--
A body backed by a fixed, mutex-protected `ByteArray`.
The data is consumed on the first read. Once consumed (or explicitly closed), the body
behaves as a closed, empty channel.
-/
structure Full where
private mk ::
private state : Mutex (Option ByteArray)
deriving Nonempty
namespace Full
private def takeChunk : AtomicT (Option ByteArray) Async (Option Chunk) := do
match get with
| none =>
pure none
| some data =>
set (none : Option ByteArray)
if data.isEmpty then
pure none
else
pure (some (Chunk.ofByteArray data))
/--
Creates a `Full` body from a `ByteArray`.
-/
def ofByteArray (data : ByteArray) : Async Full := do
let state Mutex.new (some data)
return { state }
/--
Creates a `Full` body from a `String`.
-/
def ofString (data : String) : Async Full := do
let state Mutex.new (some data.toUTF8)
return { state }
/--
Receives the body data. Returns the full byte array on the first call as a single chunk,
then `none` on all subsequent calls.
-/
def recv (full : Full) : Async (Option Chunk) :=
full.state.atomically do
takeChunk
/--
Closes the body, discarding any unconsumed data.
-/
def close (full : Full) : Async Unit :=
full.state.atomically do
set (none : Option ByteArray)
/--
Returns `true` when the data has been consumed or the body has been closed.
-/
def isClosed (full : Full) : Async Bool :=
full.state.atomically do
return ( get).isNone
/--
Returns the known size of the remaining data.
Returns `some (.fixed n)` with the current byte count, or `some (.fixed 0)` if the body has
already been consumed or closed.
-/
def getKnownSize (full : Full) : Async (Option Body.Length) :=
full.state.atomically do
match get with
| none => pure (some (.fixed 0))
| some data => pure (some (.fixed data.size))
/--
Selector that immediately resolves to the remaining chunk (or EOF).
-/
def recvSelector (full : Full) : Selector (Option Chunk) where
tryFn := do
let chunk full.state.atomically do
takeChunk
pure (some chunk)
registerFn waiter := do
full.state.atomically do
let lose := pure ()
let win promise := do
let chunk takeChunk
promise.resolve (.ok chunk)
waiter.race lose win
unregisterFn := pure ()
end Full
instance : Http.Body Full where
recv := Full.recv
close := Full.close
isClosed := Full.isClosed
recvSelector := Full.recvSelector
getKnownSize := Full.getKnownSize
setKnownSize _ _ := pure ()
instance : Coe Full Any := Any.ofBody
instance : Coe (Response Full) (Response Any) where
coe f := { f with }
instance : Coe (ContextAsync (Response Full)) (ContextAsync (Response Any)) where
coe action := do
let response action
pure (response : Response Any)
instance : Coe (Async (Response Full)) (ContextAsync (Response Any)) where
coe action := do
let response action
pure (response : Response Any)
end Body
namespace Request.Builder
open Internal.IO.Async
/--
Builds a request body from raw bytes without setting any headers.
Use `bytes` instead if you want `Content-Type: application/octet-stream` set automatically.
-/
def fromBytes (builder : Builder) (content : ByteArray) : Async (Request Body.Full) := do
return builder.body ( Body.Full.ofByteArray content)
/--
Builds a request with a binary body.
Sets `Content-Type: application/octet-stream`.
Use `fromBytes` instead if you need to set a different `Content-Type` or none at all.
-/
def bytes (builder : Builder) (content : ByteArray) : Async (Request Body.Full) :=
fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "application/octet-stream")) content
/--
Builds a request with a text body.
Sets `Content-Type: text/plain; charset=utf-8`.
-/
def text (builder : Builder) (content : String) : Async (Request Body.Full) :=
fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "text/plain; charset=utf-8")) content.toUTF8
/--
Builds a request with a JSON body.
Sets `Content-Type: application/json`.
-/
def json (builder : Builder) (content : String) : Async (Request Body.Full) :=
fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "application/json")) content.toUTF8
/--
Builds a request with an HTML body.
Sets `Content-Type: text/html; charset=utf-8`.
-/
def html (builder : Builder) (content : String) : Async (Request Body.Full) :=
fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "text/html; charset=utf-8")) content.toUTF8
end Request.Builder
namespace Response.Builder
open Internal.IO.Async
/--
Builds a response body from raw bytes without setting any headers.
Use `bytes` instead if you want `Content-Type: application/octet-stream` set automatically.
-/
def fromBytes (builder : Builder) (content : ByteArray) : Async (Response Body.Full) := do
return builder.body ( Body.Full.ofByteArray content)
/--
Builds a response with a binary body.
Sets `Content-Type: application/octet-stream`.
Use `fromBytes` instead if you need to set a different `Content-Type` or none at all.
-/
def bytes (builder : Builder) (content : ByteArray) : Async (Response Body.Full) :=
fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "application/octet-stream")) content
/--
Builds a response with a text body.
Sets `Content-Type: text/plain; charset=utf-8`.
-/
def text (builder : Builder) (content : String) : Async (Response Body.Full) :=
fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "text/plain; charset=utf-8")) content.toUTF8
/--
Builds a response with a JSON body.
Sets `Content-Type: application/json`.
-/
def json (builder : Builder) (content : String) : Async (Response Body.Full) :=
fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "application/json")) content.toUTF8
/--
Builds a response with an HTML body.
Sets `Content-Type: text/html; charset=utf-8`.
-/
def html (builder : Builder) (content : String) : Async (Response Body.Full) :=
fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "text/html; charset=utf-8")) content.toUTF8
end Response.Builder

View File

@@ -1,60 +0,0 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
module
prelude
public import Init.Data.Repr
public section
/-!
# Body.Length
This module defines the `Length` type, that represents the Content-Length or Transfer-Encoding
of an HTTP request or response.
-/
namespace Std.Http.Body
set_option linter.all true
/--
Size of the body of a response or request.
-/
inductive Length
/--
Indicates that the HTTP message body uses **chunked transfer encoding**.
-/
| chunked
/--
Indicates that the HTTP message body has a **fixed, known length**, as specified by the
`Content-Length` header.
-/
| fixed (n : Nat)
deriving Repr, BEq
namespace Length
/--
Checks if the `Length` is chunked.
-/
@[inline]
def isChunked : Length Bool
| .chunked => true
| _ => false
/--
Checks if the `Length` is a fixed size.
-/
@[inline]
def isFixed : Length Bool
| .fixed _ => true
| _ => false
end Length
end Std.Http.Body

View File

@@ -1,650 +0,0 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
module
prelude
public import Std.Sync
public import Std.Internal.Async
public import Std.Internal.Http.Data.Request
public import Std.Internal.Http.Data.Response
public import Std.Internal.Http.Data.Chunk
public import Std.Internal.Http.Data.Body.Basic
public import Std.Internal.Http.Data.Body.Any
public import Init.Data.ByteArray
public section
/-!
# Body.Stream
This module defines a zero-buffer rendezvous body channel (`Body.Stream`) that supports
both sending and receiving chunks.
There is no queue and no capacity. A send waits for a receiver and a receive waits for a sender.
At most one blocked producer and one blocked consumer are supported.
-/
namespace Std.Http
namespace Body
open Std Internal IO Async
set_option linter.all true
namespace Channel
open Internal.IO.Async in
private inductive Consumer where
| normal (promise : IO.Promise (Option Chunk))
| select (finished : Waiter (Option Chunk))
private def Consumer.resolve (c : Consumer) (x : Option Chunk) : BaseIO Bool := do
match c with
| .normal promise =>
promise.resolve x
return true
| .select waiter =>
let lose := return false
let win promise := do
promise.resolve (.ok x)
return true
waiter.race lose win
private structure Producer where
chunk : Chunk
/--
Resolved with `true` when consumed by a receiver, `false` when the channel closes.
-/
done : IO.Promise Bool
open Internal.IO.Async in
private def resolveInterestWaiter (waiter : Waiter Bool) (x : Bool) : BaseIO Bool := do
let lose := return false
let win promise := do
promise.resolve (.ok x)
return true
waiter.race lose win
private structure State where
/--
A single blocked producer waiting for a receiver.
-/
pendingProducer : Option Producer
/--
A single blocked consumer waiting for a producer.
-/
pendingConsumer : Option Consumer
/--
A waiter for `Stream.interestSelector`.
-/
interestWaiter : Option (Internal.IO.Async.Waiter Bool)
/--
Whether the channel is closed.
-/
closed : Bool
/--
Known size of the stream if available.
-/
knownSize : Option Body.Length
/--
Buffered partial chunk data accumulated from `Stream.send ... (incomplete := true)`.
These partial pieces are collapsed and emitted as a single chunk on the next complete send.
-/
pendingIncompleteChunk : Option Chunk := none
deriving Nonempty
end Channel
/--
A zero-buffer rendezvous body channel that supports both sending and receiving chunks.
-/
structure Stream where
private mk ::
private state : Mutex Channel.State
deriving Nonempty, TypeName
/--
Creates a rendezvous body stream.
-/
def mkStream : Async Stream := do
let state Mutex.new {
pendingProducer := none
pendingConsumer := none
interestWaiter := none
closed := false
knownSize := none
}
return { state }
namespace Channel
private def decreaseKnownSize (knownSize : Option Body.Length) (chunk : Chunk) : Option Body.Length :=
match knownSize with
| some (.fixed res) => some (Body.Length.fixed (res - chunk.data.size))
| _ => knownSize
private def pruneFinishedWaiters [Monad m] [MonadLiftT (ST IO.RealWorld) m] :
AtomicT State m Unit := do
let st get
let pendingConsumer
match st.pendingConsumer with
| some (.select waiter) =>
if waiter.checkFinished then
pure none
else
pure st.pendingConsumer
| _ =>
pure st.pendingConsumer
let interestWaiter
match st.interestWaiter with
| some waiter =>
if waiter.checkFinished then
pure none
else
pure st.interestWaiter
| none =>
pure none
set { st with pendingConsumer, interestWaiter }
private def signalInterest [Monad m] [MonadLiftT (ST IO.RealWorld) m] [MonadLiftT BaseIO m] :
AtomicT State m Unit := do
let st get
if let some waiter := st.interestWaiter then
discard <| resolveInterestWaiter waiter true
set { st with interestWaiter := none }
private def recvReady' [Monad m] [MonadLiftT (ST IO.RealWorld) m] :
AtomicT State m Bool := do
let st get
return st.pendingProducer.isSome || st.closed
private def hasInterest' [Monad m] [MonadLiftT (ST IO.RealWorld) m] :
AtomicT State m Bool := do
let st get
return st.pendingConsumer.isSome
private def tryRecv' [Monad m] [MonadLiftT (ST IO.RealWorld) m] [MonadLiftT BaseIO m] :
AtomicT State m (Option Chunk) := do
let st get
if let some producer := st.pendingProducer then
set {
st with
pendingProducer := none
knownSize := decreaseKnownSize st.knownSize producer.chunk
}
discard <| producer.done.resolve true
return some producer.chunk
else
return none
private def close' [Monad m] [MonadLiftT (ST IO.RealWorld) m] [MonadLiftT BaseIO m] :
AtomicT State m Unit := do
let st get
if st.closed then
return ()
if let some consumer := st.pendingConsumer then
discard <| consumer.resolve none
if let some waiter := st.interestWaiter then
discard <| resolveInterestWaiter waiter false
if let some producer := st.pendingProducer then
discard <| producer.done.resolve false
set {
st with
pendingProducer := none
pendingConsumer := none
interestWaiter := none
pendingIncompleteChunk := none
closed := true
}
end Channel
namespace Stream
/--
Attempts to receive a chunk from the channel without blocking.
Returns `some chunk` only when a producer is already waiting.
-/
def tryRecv (stream : Stream) : Async (Option Chunk) :=
stream.state.atomically do
Channel.pruneFinishedWaiters
Channel.tryRecv'
private def recv' (stream : Stream) : BaseIO (AsyncTask (Option Chunk)) := do
stream.state.atomically do
Channel.pruneFinishedWaiters
if let some chunk Channel.tryRecv' then
return AsyncTask.pure (some chunk)
let st get
if st.closed then
return AsyncTask.pure none
if st.pendingConsumer.isSome then
return Task.pure (.error (IO.Error.userError "only one blocked consumer is allowed"))
let promise IO.Promise.new
set { st with pendingConsumer := some (.normal promise) }
Channel.signalInterest
return promise.result?.map (sync := true) fun
| none => .error (IO.Error.userError "the promise linked to the consumer was dropped")
| some res => .ok res
/--
Receives a chunk from the channel. Blocks until a producer sends one.
Returns `none` if the channel is closed and no producer is waiting.
-/
def recv (stream : Stream) : Async (Option Chunk) := do
Async.ofAsyncTask ( recv' stream)
/--
Closes the channel.
-/
def close (stream : Stream) : Async Unit :=
stream.state.atomically do
Channel.close'
/--
Checks whether the channel is closed.
-/
@[always_inline, inline]
def isClosed (stream : Stream) : Async Bool :=
stream.state.atomically do
return ( get).closed
/--
Gets the known size if available.
-/
@[always_inline, inline]
def getKnownSize (stream : Stream) : Async (Option Body.Length) :=
stream.state.atomically do
return ( get).knownSize
/--
Sets known size metadata.
-/
@[always_inline, inline]
def setKnownSize (stream : Stream) (size : Option Body.Length) : Async Unit :=
stream.state.atomically do
modify fun st => { st with knownSize := size }
open Internal.IO.Async in
/--
Creates a selector that resolves when a producer is waiting (or the channel closes).
-/
def recvSelector (stream : Stream) : Selector (Option Chunk) where
tryFn := do
stream.state.atomically do
Channel.pruneFinishedWaiters
if Channel.recvReady' then
return some ( Channel.tryRecv')
else
return none
registerFn waiter := do
stream.state.atomically do
Channel.pruneFinishedWaiters
if Channel.recvReady' then
let lose := return ()
let win promise := do
promise.resolve (.ok ( Channel.tryRecv'))
waiter.race lose win
else
let st get
if st.pendingConsumer.isSome then
throw (.userError "only one blocked consumer is allowed")
set { st with pendingConsumer := some (.select waiter) }
Channel.signalInterest
unregisterFn := do
stream.state.atomically do
Channel.pruneFinishedWaiters
/--
Iterates over chunks until the channel closes.
-/
@[inline]
protected partial def forIn
{β : Type} (stream : Stream) (acc : β)
(step : Chunk β Async (ForInStep β)) : Async β := do
let rec @[specialize] loop (stream : Stream) (acc : β) : Async β := do
if let some chunk stream.recv then
match step chunk acc with
| .done res => return res
| .yield res => loop stream res
else
return acc
loop stream acc
/--
Context-aware iteration over chunks until the channel closes.
-/
@[inline]
protected partial def forIn'
{β : Type} (stream : Stream) (acc : β)
(step : Chunk β ContextAsync (ForInStep β)) : ContextAsync β := do
let rec @[specialize] loop (stream : Stream) (acc : β) : ContextAsync β := do
let data Selectable.one #[
.case stream.recvSelector pure,
.case ( ContextAsync.doneSelector) (fun _ => pure none),
]
if let some chunk := data then
match step chunk acc with
| .done res => return res
| .yield res => loop stream res
else
return acc
loop stream acc
/--
Abstracts over how the next chunk is received, allowing `readAll` to work in both `Async`
(no cancellation) and `ContextAsync` (races with cancellation via `doneSelector`).
-/
class NextChunk (m : Type Type) where
/--
Receives the next chunk, stopping at EOF or (in `ContextAsync`) when the context is cancelled.
-/
nextChunk : Stream m (Option Chunk)
instance : NextChunk Async where
nextChunk := Stream.recv
instance : NextChunk ContextAsync where
nextChunk stream := do
Selectable.one #[
.case stream.recvSelector pure,
.case ( ContextAsync.doneSelector) (fun _ => pure none),
]
/--
Reads all remaining chunks and decodes them into `α`.
Works in both `Async` (reads until EOF, no cancellation) and `ContextAsync` (also stops if the
context is cancelled).
-/
partial def readAll
[FromByteArray α]
[Monad m] [MonadExceptOf IO.Error m] [NextChunk m]
(stream : Stream)
(maximumSize : Option UInt64 := none) :
m α := do
let rec loop (result : ByteArray) : m ByteArray := do
match NextChunk.nextChunk stream with
| none => return result
| some chunk =>
let result := result ++ chunk.data
if let some max := maximumSize then
if result.size.toUInt64 > max then
throw (.userError s!"body exceeded maximum size of {max} bytes")
loop result
let result loop ByteArray.empty
match FromByteArray.fromByteArray result with
| .ok a => return a
| .error msg => throw (.userError msg)
private def collapseForSend
(stream : Stream)
(chunk : Chunk)
(incomplete : Bool) : BaseIO (Except IO.Error (Option Chunk)) := do
stream.state.atomically do
Channel.pruneFinishedWaiters
let st get
if st.closed then
return .error (.userError "channel closed")
let merged := match st.pendingIncompleteChunk with
| some pending =>
{
data := pending.data ++ chunk.data
extensions := if pending.extensions.isEmpty then chunk.extensions else pending.extensions
}
| none => chunk
if incomplete then
set { st with pendingIncompleteChunk := some merged }
return .ok none
else
set { st with pendingIncompleteChunk := none }
return .ok (some merged)
/--
Sends a chunk, retrying if a select-mode consumer races and loses. If no consumer is ready,
installs the chunk as a pending producer and awaits acknowledgement from the receiver.
-/
private partial def send' (stream : Stream) (chunk : Chunk) : Async Unit := do
let done IO.Promise.new
let result : Except IO.Error (Option Bool) stream.state.atomically do
Channel.pruneFinishedWaiters
let st get
if st.closed then
return .error (IO.Error.userError "channel closed")
if let some consumer := st.pendingConsumer then
let success consumer.resolve (some chunk)
if success then
set {
st with
pendingConsumer := none
knownSize := Channel.decreaseKnownSize st.knownSize chunk
}
return .ok (some true)
else
set { st with pendingConsumer := none }
return .ok (some false)
else if st.pendingProducer.isSome then
return .error (IO.Error.userError "only one blocked producer is allowed")
else
set { st with pendingProducer := some { chunk, done } }
return .ok none
match result with
| .error err =>
throw err
| .ok (some true) =>
return ()
| .ok (some false) =>
-- The select-mode consumer raced and lost; recurse to allocate a fresh `done` promise.
send' stream chunk
| .ok none =>
match await done.result? with
| some true => return ()
| _ => throw (IO.Error.userError "channel closed")
/--
Sends a chunk.
If `incomplete := true`, the chunk is buffered and collapsed with subsequent chunks, and is not
delivered to the receiver yet.
If `incomplete := false`, any buffered incomplete pieces are collapsed with this chunk and the
single merged chunk is sent.
-/
def send (stream : Stream) (chunk : Chunk) (incomplete : Bool := false) : Async Unit := do
match ( collapseForSend stream chunk incomplete) with
| .error err => throw err
| .ok none => pure ()
| .ok (some toSend) =>
if toSend.data.isEmpty toSend.extensions.isEmpty then
return ()
send' stream toSend
/--
Returns `true` when a consumer is currently blocked waiting for data.
-/
def hasInterest (stream : Stream) : Async Bool :=
stream.state.atomically do
Channel.pruneFinishedWaiters
Channel.hasInterest'
open Internal.IO.Async in
/--
Creates a selector that resolves when consumer interest is present.
Returns `true` when a consumer is waiting, `false` when the channel closes first.
-/
def interestSelector (stream : Stream) : Selector Bool where
tryFn := do
stream.state.atomically do
Channel.pruneFinishedWaiters
let st get
if st.pendingConsumer.isSome then
return some true
else if st.closed then
return some false
else
return none
registerFn waiter := do
stream.state.atomically do
Channel.pruneFinishedWaiters
let st get
if st.pendingConsumer.isSome then
let lose := return ()
let win promise := do
promise.resolve (.ok true)
waiter.race lose win
else if st.closed then
let lose := return ()
let win promise := do
promise.resolve (.ok false)
waiter.race lose win
else if st.interestWaiter.isSome then
throw (.userError "only one blocked interest selector is allowed")
else
set { st with interestWaiter := some waiter }
unregisterFn := do
stream.state.atomically do
Channel.pruneFinishedWaiters
end Stream
/--
Creates a body from a producer function.
Returns the stream immediately and runs `gen` in a detached task.
The channel is always closed when `gen` returns or throws.
Errors from `gen` are not rethrown here; consumers observe end-of-stream via `recv = none`.
-/
def stream (gen : Stream Async Unit) : Async Stream := do
let s mkStream
background <| do
try
gen s
finally
s.close
return s
/--
Creates a body from a fixed byte array.
-/
def fromBytes (content : ByteArray) : Async Stream := do
stream fun s => do
s.setKnownSize (some (.fixed content.size))
if content.size > 0 then
s.send (Chunk.ofByteArray content)
/--
Creates an empty `Stream` body channel (already closed, no data).
Prefer `Body.Empty` when you need a concrete zero-cost type. Use this when the calling
context requires a `Stream` specifically.
-/
def empty : Async Stream := do
let s mkStream
s.setKnownSize (some (.fixed 0))
s.close
return s
instance : ForIn Async Stream Chunk where
forIn := Stream.forIn
instance : ForIn ContextAsync Stream Chunk where
forIn := Stream.forIn'
instance : Http.Body Stream where
recv := Stream.recv
close := Stream.close
isClosed := Stream.isClosed
recvSelector := Stream.recvSelector
getKnownSize := Stream.getKnownSize
setKnownSize := Stream.setKnownSize
instance : Coe Stream Any := Any.ofBody
instance : Coe (Response Stream) (Response Any) where
coe f := { f with }
instance : Coe (ContextAsync (Response Stream)) (ContextAsync (Response Any)) where
coe action := do
let response action
pure (response : Response Any)
instance : Coe (Async (Response Stream)) (ContextAsync (Response Any)) where
coe action := do
let response action
pure (response : Response Any)
end Body
namespace Request.Builder
open Internal.IO.Async
/--
Builds a request with a streaming body generator.
-/
def stream
(builder : Builder)
(gen : Body.Stream Async Unit) :
Async (Request Body.Stream) := do
let s Body.stream gen
return Request.Builder.body builder s
end Request.Builder
namespace Response.Builder
open Internal.IO.Async
/--
Builds a response with a streaming body generator.
-/
def stream
(builder : Builder)
(gen : Body.Stream Async Unit) :
Async (Response Body.Stream) := do
let s Body.stream gen
return Response.Builder.body builder s
end Response.Builder

View File

@@ -124,6 +124,12 @@ def new : Builder := { }
namespace Builder
/--
Creates a new HTTP request builder with the default head
(method: GET, version: HTTP/1.1, target: `*`).
-/
def empty : Builder := { }
/--
Sets the HTTP method for the request being built.
-/

View File

@@ -111,7 +111,7 @@ namespace Builder
/--
Creates a new HTTP Response builder with default head (status: 200 OK, version: HTTP/1.1).
-/
def new : Builder := { }
def empty : Builder := { }
/--
Sets the HTTP status code for the response being built.
@@ -173,66 +173,66 @@ end Builder
Creates a new HTTP Response builder with the 200 status code.
-/
def ok : Builder :=
.new |>.status .ok
.empty |>.status .ok
/--
Creates a new HTTP Response builder with the provided status.
-/
def withStatus (status : Status) : Builder :=
.new |>.status status
.empty |>.status status
/--
Creates a new HTTP Response builder with the 404 status code.
-/
def notFound : Builder :=
.new |>.status .notFound
.empty |>.status .notFound
/--
Creates a new HTTP Response builder with the 500 status code.
-/
def internalServerError : Builder :=
.new |>.status .internalServerError
.empty |>.status .internalServerError
/--
Creates a new HTTP Response builder with the 400 status code.
-/
def badRequest : Builder :=
.new |>.status .badRequest
.empty |>.status .badRequest
/--
Creates a new HTTP Response builder with the 201 status code.
-/
def created : Builder :=
.new |>.status .created
.empty |>.status .created
/--
Creates a new HTTP Response builder with the 202 status code.
-/
def accepted : Builder :=
.new |>.status .accepted
.empty |>.status .accepted
/--
Creates a new HTTP Response builder with the 401 status code.
-/
def unauthorized : Builder :=
.new |>.status .unauthorized
.empty |>.status .unauthorized
/--
Creates a new HTTP Response builder with the 403 status code.
-/
def forbidden : Builder :=
.new |>.status .forbidden
.empty |>.status .forbidden
/--
Creates a new HTTP Response builder with the 409 status code.
-/
def conflict : Builder :=
.new |>.status .conflict
.empty |>.status .conflict
/--
Creates a new HTTP Response builder with the 503 status code.
-/
def serviceUnavailable : Builder :=
.new |>.status .serviceUnavailable
.empty |>.status .serviceUnavailable
end Response

View File

@@ -94,3 +94,4 @@ def parseOrRoot (s : String) : Std.Http.URI.Path :=
parse? s |>.getD { segments := #[], absolute := true }
end Std.Http.URI.Path

View File

@@ -386,7 +386,7 @@ OPTIONS:
--force-download redownload existing files
Downloads build outputs for packages in the workspace from a remote cache
service. The cache service used can be specified via the `--service` option.
service. The cache service used can be specifed via the `--service` option.
Otherwise, Lake will the system default, or, if none is configured, Reservoir.
See `lake cache services` for more information on how to configure services.
@@ -429,7 +429,7 @@ USAGE:
Uploads the input-to-output mappings contained in the specified file along
with the corresponding output artifacts to a remote cache. The cache service
used can be specified via the `--service` option. If not specified, Lake will use
used via be specified via `--service` option. If not specifed, Lake will used
the system default, or error if none is configured. See the help page of
`lake cache services` for more information on how to configure services.

View File

@@ -446,7 +446,7 @@ protected def get : CliM PUnit := do
logWarning endpointDeprecation
if opts.mappingsOnly then
error "`--mappings-only` requires services to be configured
via the Lake system configuration (not environment variables)"
via the Lake system configuration (not enviroment variables)"
return .downloadService artifactEndpoint revisionEndpoint ws.lakeEnv.cacheService?
| none, none =>
return ws.defaultCacheService

View File

@@ -765,13 +765,12 @@ where
\n remote URL: {info.url}"
match cfg.kind with
| .get =>
unless code? matches .ok 404 do -- ignore response bodies on 404s
if let .ok size := out.getAs Nat "size_download" then
if size > 0 then
if let .ok contentType := out.getAs String "content_type" then
if contentType != artifactContentType then
if let .ok resp IO.FS.readFile info.path |>.toBaseIO then
msg := s!"{msg}\nunexpected response:\n{resp}"
if let .ok size := out.getAs Nat "size_download" then
if size > 0 then
if let .ok contentType := out.getAs String "content_type" then
if contentType != artifactContentType then
if let .ok resp IO.FS.readFile info.path |>.toBaseIO then
msg := s!"{msg}\nunexpected response:\n{resp}"
removeFileIfExists info.path
| .put =>
if let .ok size := out.getAs Nat "size_download" then
@@ -788,7 +787,7 @@ private def transferArtifacts
match cfg.kind with
| .get =>
cfg.infos.forM fun info => do
h.putStrLn s!"url = {info.url.quote}"
h.putStrLn s!"url = {info.url}"
h.putStrLn s!"-o {info.path.toString.quote}"
h.flush
return #[
@@ -799,7 +798,7 @@ private def transferArtifacts
| .put =>
cfg.infos.forM fun info => do
h.putStrLn s!"-T {info.path.toString.quote}"
h.putStrLn s!"url = {info.url.quote}"
h.putStrLn s!"url = {info.url}"
h.flush
return #[
"-Z", "-X", "PUT", "-L",
@@ -828,13 +827,6 @@ private def transferArtifacts
if s.didError then
failure
private def reservoirArtifactsUrl (service : CacheService) (scope : CacheServiceScope) : String :=
let endpoint :=
match scope.impl with
| .repo scope => appendScope s!"{service.impl.apiEndpoint}/repositories" scope
| .str scope => appendScope s!"{service.impl.apiEndpoint}/packages" scope
s!"{endpoint}/artifacts"
public def downloadArtifacts
(descrs : Array ArtifactDescr) (cache : Cache)
(service : CacheService) (scope : CacheServiceScope) (force := false)
@@ -852,68 +844,8 @@ public def downloadArtifacts
return s.push {url, path, descr}
if infos.isEmpty then
return
let infos id do
if service.isReservoir then
-- Artifact cloud storage URLs are fetched in a single request
-- to avoid hammering the Reservoir web host
fetchUrls (service.reservoirArtifactsUrl scope) infos
else return infos
IO.FS.createDirAll cache.artifactDir
transferArtifacts {scope, infos, kind := .get}
where
fetchUrls url infos := IO.FS.withTempFile fun h path => do
let body := Json.arr <| infos.map (toJson ·.descr.hash)
h.putStr body.compress
h.flush
let args := #[
"-X", "POST", "-L", "-d", s!"@{path}",
"--retry", "3", -- intermittent network errors can occur
"-s", "-w", "%{stderr}%{json}\n",
"-H", "Content-Type: application/json",
]
let args := Reservoir.lakeHeaders.foldl (· ++ #["-H", ·]) args
let spawnArgs := {
cmd := "curl", args := args.push url
stdout := .piped, stderr := .piped
}
logVerbose (mkCmdLog spawnArgs)
let {stdout, stderr, exitCode} IO.Process.output spawnArgs
match Json.parse stdout >>= fromJson? with
| .ok (resp : ReservoirResp (Array String)) =>
match resp with
| .data urls =>
if h : infos.size = urls.size then
let s := infos.size.fold (init := infos.toVector) fun i hi s =>
s.set i {s[i] with url := urls[i]'(h hi)}
return s.toArray
else
error s!"failed to fetch artifact URLs\
\n POST {url}\
\nIncorrect number of results: expected {infos.size}, got {urls.size}"
| .error status message =>
error s!"failed to fetch artifact URLs (status code: {status})\
\n POST {url}\
\nReservoir error: {message}"
| .error _ =>
match Json.parse stderr >>= fromJson? with
| .ok (out : JsonObject) =>
let mut msg := "failed to fetch artifact URLs"
if let .ok code := out.getAs Nat "http_code" then
msg := s!"{msg} (status code: {code})"
msg := s!"{msg}\n POST {url}"
if let .ok errMsg := out.getAs String "errormsg" then
msg := s!"{msg}\n Transfer error: {errMsg}"
unless stdout.isEmpty do
msg := s!"{msg}\nstdout:\n{stdout.trimAsciiEnd}"
logError msg
logVerbose s!"curl JSON:\n{stderr.trimAsciiEnd}"
| .error e =>
logError s!"failed to fetch artifact URLs\
\n POST {url}
\nInvalid curl JSON: {e}; received: {stderr.trimAscii}"
unless stdout.isEmpty do
logWarning s!"curl produced unexpected output:\n{stdout.trimAsciiEnd}"
error s!"curl exited with code {exitCode}"
@[deprecated "Deprecated without replacement." (since := "2026-02-27")]
public def downloadOutputArtifacts

View File

@@ -103,6 +103,24 @@ public instance : FromJson RegistryPkg := ⟨RegistryPkg.fromJson?⟩
end RegistryPkg
/-- A Reservoir API response object. -/
public inductive ReservoirResp (α : Type u)
| data (a : α)
| error (status : Nat) (message : String)
public protected def ReservoirResp.fromJson? [FromJson α] (val : Json) : Except String (ReservoirResp α) := do
let obj JsonObject.fromJson? val
if let some (err : JsonObject) obj.get? "error" then
let status err.get "status"
let message err.get "message"
return .error status message
else if let some (val : Json) obj.get? "data" then
.data <$> fromJson? val
else
.data <$> fromJson? val
public instance [FromJson α] : FromJson (ReservoirResp α) := ReservoirResp.fromJson?
public def Reservoir.pkgApiUrl (lakeEnv : Lake.Env) (owner pkg : String) :=
s!"{lakeEnv.reservoirApiUrl}/packages/{uriEncode owner}/{uriEncode pkg}"

View File

@@ -6,9 +6,8 @@ Authors: Mac Malone
module
prelude
public import Lake.Util.JsonObject
open Lean
public import Init.Prelude
import Init.Data.Array.Basic
namespace Lake
@@ -16,23 +15,3 @@ public def Reservoir.lakeHeaders : Array String := #[
"X-Reservoir-Api-Version:1.0.0",
"X-Lake-Registry-Api-Version:0.1.0"
]
/-- A Reservoir API response object. -/
public inductive ReservoirResp (α : Type u)
| data (a : α)
| error (status : Nat) (message : String)
public protected def ReservoirResp.fromJson? [FromJson α] (val : Json) : Except String (ReservoirResp α) := do
if let .ok obj := JsonObject.fromJson? val then
if let some (err : JsonObject) obj.get? "error" then
let status err.get "status"
let message err.get "message"
return .error status message
else if let some (val : Json) obj.get? "data" then
.data <$> fromJson? val
else
.data <$> fromJson? val
else
.data <$> fromJson? val
public instance [FromJson α] : FromJson (ReservoirResp α) := ReservoirResp.fromJson?

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@@ -6,7 +6,6 @@ open Lean Meta Elab Tactic Sym Std Do SpecAttr
namespace GetThrowSet
set_option mvcgen.warning false
set_option backward.do.legacy false -- exercises asymmetric bind depth from new do elaborator
abbrev M := ExceptT String <| StateM Nat

View File

@@ -876,10 +876,11 @@ meta def emitVC (goal : Grind.Goal) : VCGenM Unit := do
meta def work (goal : Grind.Goal) : VCGenM Unit := do
let mvarId preprocessMVar goal.mvarId
let goal := { goal with mvarId }
let mut worklist := #[goal]
let mut worklist := Std.Queue.empty.enqueue goal
repeat do
let mut some goal := worklist.back? | break
worklist := worklist.pop
let some (goal, worklist') := worklist.dequeue? | break
let mut goal := goal
worklist := worklist'
let res solve goal.mvarId
match res with
| .noEntailment .. | .noProgramFoundInTarget .. =>
@@ -895,7 +896,7 @@ meta def work (goal : Grind.Goal) : VCGenM Unit := do
-- to share E-graph context before forking.
if subgoals.length > 1 then
goal ( read).preTac.processHypotheses goal
worklist := worklist ++ (subgoals |>.map ({ goal with mvarId := · }) |>.reverse)
worklist := worklist.enqueueAll (subgoals.map ({ goal with mvarId := · }))
public structure Result where
invariants : Array MVarId

View File

@@ -15,7 +15,5 @@ set_option maxHeartbeats 100000000
-- Benchmark `mvcgen' with grind`: grind integrated into VCGen loop for incremental
-- context internalization. This avoids O(n) re-internalization per VC.
-- `simplifying_assumptions [Nat.add_assoc]` here speeds up grind and kernel checking by a factor
-- of 2 because long chains `s + 1 + ... + 1` are collapsed into `s + n`.
#eval runBenchUsingTactic ``GetThrowSetGrind.Goal [``loop, ``step] `(tactic| mvcgen' simplifying_assumptions [Nat.add_assoc] with grind) `(tactic| fail)
#eval runBenchUsingTactic ``GetThrowSetGrind.Goal [``loop, ``step] `(tactic| mvcgen' with grind) `(tactic| fail)
[50, 100, 150]

View File

@@ -1,725 +0,0 @@
import Std.Internal.Http.Data.Body
open Std.Internal.IO Async
open Std.Http
open Std.Http.Body
/-! ## Stream tests -/
-- Test send and recv on stream
def channelSendRecv : Async Unit := do
let stream Body.mkStream
let chunk := Chunk.ofByteArray "hello".toUTF8
let sendTask async (t := AsyncTask) <| stream.send chunk
let result stream.recv
assert! result.isSome
assert! result.get!.data == "hello".toUTF8
await sendTask
#eval channelSendRecv.block
-- Test tryRecv on empty stream returns none
def channelTryRecvEmpty : Async Unit := do
let stream Body.mkStream
let result stream.tryRecv
assert! result.isNone
#eval channelTryRecvEmpty.block
-- Test tryRecv consumes a waiting producer
def channelTryRecvWithPendingSend : Async Unit := do
let stream Body.mkStream
let sendTask async (t := AsyncTask) <| stream.send (Chunk.ofByteArray "data".toUTF8)
let mut result := none
let mut fuel := 100
while result.isNone && fuel > 0 do
result stream.tryRecv
if result.isNone then
let _ Selectable.one #[
.case ( Selector.sleep 1) pure
]
fuel := fuel - 1
assert! result.isSome
assert! result.get!.data == "data".toUTF8
await sendTask
#eval channelTryRecvWithPendingSend.block
-- Test close sets closed flag
def channelClose : Async Unit := do
let stream Body.mkStream
assert! !( stream.isClosed)
stream.close
assert! ( stream.isClosed)
#eval channelClose.block
-- Test recv on closed stream returns none
def channelRecvAfterClose : Async Unit := do
let stream Body.mkStream
stream.close
let result stream.recv
assert! result.isNone
#eval channelRecvAfterClose.block
-- Test for-in iteration collects chunks until close
def channelForIn : Async Unit := do
let stream Body.mkStream
let producer async (t := AsyncTask) <| do
stream.send (Chunk.ofByteArray "a".toUTF8)
stream.send (Chunk.ofByteArray "b".toUTF8)
stream.close
let mut acc : ByteArray := .empty
for chunk in stream do
acc := acc ++ chunk.data
assert! acc == "ab".toUTF8
await producer
#eval channelForIn.block
-- Test chunk extensions are preserved
def channelExtensions : Async Unit := do
let stream Body.mkStream
let chunk := { data := "hello".toUTF8, extensions := #[(.mk "key", some (Chunk.ExtensionValue.ofString! "value"))] : Chunk }
let sendTask async (t := AsyncTask) <| stream.send chunk
let result stream.recv
assert! result.isSome
assert! result.get!.extensions.size == 1
assert! result.get!.extensions[0]! == (Chunk.ExtensionName.mk "key", some <| .ofString! "value")
await sendTask
#eval channelExtensions.block
-- Test known size metadata
def channelKnownSize : Async Unit := do
let stream Body.mkStream
stream.setKnownSize (some (.fixed 100))
let size stream.getKnownSize
assert! size == some (.fixed 100)
#eval channelKnownSize.block
-- Test known size decreases when a chunk is consumed
def channelKnownSizeDecreases : Async Unit := do
let stream Body.mkStream
stream.setKnownSize (some (.fixed 5))
let sendTask async (t := AsyncTask) <| stream.send (Chunk.ofByteArray "hello".toUTF8)
let _ stream.recv
await sendTask
let size stream.getKnownSize
assert! size == some (.fixed 0)
#eval channelKnownSizeDecreases.block
-- Test only one blocked producer is allowed
def channelSingleProducerRule : Async Unit := do
let stream Body.mkStream
let send1 async (t := AsyncTask) <| stream.send (Chunk.ofByteArray "one".toUTF8)
-- Yield so `send1` can occupy the single pending-producer slot.
let _ Selectable.one #[
.case ( Selector.sleep 5) pure
]
let send2Failed
try
stream.send (Chunk.ofByteArray "two".toUTF8)
pure false
catch _ =>
pure true
assert! send2Failed
let first stream.recv
assert! first.isSome
assert! first.get!.data == "one".toUTF8
await send1
#eval channelSingleProducerRule.block
-- Test only one blocked consumer is allowed
def channelSingleConsumerRule : Async Unit := do
let stream Body.mkStream
let recv1 async (t := AsyncTask) <| stream.recv
let hasInterest Selectable.one #[
.case stream.interestSelector pure
]
assert! hasInterest
let recv2Failed
try
let _ stream.recv
pure false
catch _ =>
pure true
assert! recv2Failed
let sendTask async (t := AsyncTask) <| stream.send (Chunk.ofByteArray "ok".toUTF8)
let r1 await recv1
assert! r1.isSome
assert! r1.get!.data == "ok".toUTF8
await sendTask
#eval channelSingleConsumerRule.block
-- Test hasInterest reflects blocked receiver state
def channelHasInterest : Async Unit := do
let stream Body.mkStream
assert! !( stream.hasInterest)
let recvTask async (t := AsyncTask) <| stream.recv
let hasInterest Selectable.one #[
.case stream.interestSelector pure
]
assert! hasInterest
assert! ( stream.hasInterest)
let sendTask async (t := AsyncTask) <| stream.send (Chunk.ofByteArray "x".toUTF8)
let _ await recvTask
await sendTask
assert! !( stream.hasInterest)
#eval channelHasInterest.block
-- Test interestSelector resolves false when stream closes first
def channelInterestSelectorClose : Async Unit := do
let stream Body.mkStream
let waitInterest async (t := AsyncTask) <|
Selectable.one #[
.case stream.interestSelector pure
]
stream.close
let interested await waitInterest
assert! interested == false
#eval channelInterestSelectorClose.block
-- Test incomplete sends are buffered and merged into one chunk on the final send
def channelIncompleteChunks : Async Unit := do
let stream Body.mkStream
let sendTask async (t := AsyncTask) <| do
stream.send (Chunk.ofByteArray "hel".toUTF8) (incomplete := true)
stream.send (Chunk.ofByteArray "lo".toUTF8)
let result stream.recv
assert! result.isSome
assert! result.get!.data == "hello".toUTF8
await sendTask
#eval channelIncompleteChunks.block
-- Test sending to a closed stream raises an error
def channelSendAfterClose : Async Unit := do
let stream Body.mkStream
stream.close
let failed
try
stream.send (Chunk.ofByteArray "test".toUTF8)
pure false
catch _ =>
pure true
assert! failed
#eval channelSendAfterClose.block
-- Test Body.stream runs producer and returns the stream handle
def channelStreamHelper : Async Unit := do
let stream Body.stream fun s => do
s.send (Chunk.ofByteArray "hello".toUTF8)
let result stream.recv
assert! result.isSome
assert! result.get!.data == "hello".toUTF8
let eof stream.recv
assert! eof.isNone
#eval channelStreamHelper.block
-- Test Body.empty creates an already-closed Stream
def channelEmptyHelper : Async Unit := do
let stream Body.empty
assert! ( stream.isClosed)
let result stream.recv
assert! result.isNone
#eval channelEmptyHelper.block
-- Test Stream.readAll concatenates all chunks
def channelReadAll : Async Unit := do
let stream Body.mkStream
let sendTask async (t := AsyncTask) <| do
stream.send (Chunk.ofByteArray "foo".toUTF8)
stream.send (Chunk.ofByteArray "bar".toUTF8)
stream.close
let result : ByteArray stream.readAll
assert! result == "foobar".toUTF8
await sendTask
#eval channelReadAll.block
-- Test Stream.readAll enforces a maximum size limit
def channelReadAllMaxSize : Async Unit := do
let stream Body.mkStream
let sendTask async (t := AsyncTask) <| do
stream.send (Chunk.ofByteArray "abcdefgh".toUTF8)
stream.close
let failed
try
let _ : ByteArray stream.readAll (maximumSize := some 4)
pure false
catch _ =>
pure true
assert! failed
await sendTask
#eval channelReadAllMaxSize.block
-- Test Stream.getKnownSize reflects the value set via setKnownSize
def channelKnownSizeRoundtrip : Async Unit := do
let stream Body.mkStream
stream.setKnownSize (some (.fixed 42))
let size stream.getKnownSize
assert! size == some (.fixed 42)
#eval channelKnownSizeRoundtrip.block
/-! ## Full tests -/
-- Test Full.recv returns content once then EOF
def fullRecvConsumesOnce : Async Unit := do
let full Body.Full.ofString "hello"
let first full.recv
let second full.recv
assert! first.isSome
assert! first.get!.data == "hello".toUTF8
assert! second.isNone
#eval fullRecvConsumesOnce.block
-- Test Full known-size metadata tracks consumption
def fullKnownSizeLifecycle : Async Unit := do
let data := ByteArray.mk #[0x01, 0x02, 0x03, 0x04]
let full Body.Full.ofByteArray data
assert! ( full.getKnownSize) == some (.fixed 4)
let chunk full.recv
assert! chunk.isSome
assert! chunk.get!.data == data
assert! ( full.getKnownSize) == some (.fixed 0)
#eval fullKnownSizeLifecycle.block
-- Test Full.close discards remaining content
def fullClose : Async Unit := do
let full Body.Full.ofString "bye"
assert! !( full.isClosed)
full.close
assert! ( full.isClosed)
assert! ( full.recv).isNone
#eval fullClose.block
-- Test Full from an empty ByteArray returns none on the first recv
def fullEmptyBytes : Async Unit := do
let full Body.Full.ofByteArray ByteArray.empty
let result full.recv
assert! result.isNone
#eval fullEmptyBytes.block
-- Test Full.recvSelector resolves immediately with the stored chunk
def fullRecvSelectorResolves : Async Unit := do
let full Body.Full.ofString "world"
let result Selectable.one #[
.case full.recvSelector pure
]
assert! result.isSome
assert! result.get!.data == "world".toUTF8
#eval fullRecvSelectorResolves.block
-- Test Full.getKnownSize returns 0 after close
def fullKnownSizeAfterClose : Async Unit := do
let full Body.Full.ofString "data"
assert! ( full.getKnownSize) == some (.fixed 4)
full.close
assert! ( full.getKnownSize) == some (.fixed 0)
#eval fullKnownSizeAfterClose.block
-- Test Full.tryRecv succeeds once and returns none thereafter
def fullTryRecvIdempotent : Async Unit := do
let full Body.Full.ofString "once"
let first full.recv
let second full.recv
assert! first.isSome
assert! first.get!.data == "once".toUTF8
assert! second.isNone
#eval fullTryRecvIdempotent.block
/-! ## Empty tests -/
-- Test Empty.recv always returns none
def emptyBodyRecv : Async Unit := do
let body : Body.Empty := {}
let result body.recv
assert! result.isNone
#eval emptyBodyRecv.block
-- Test Empty.isClosed is always true
def emptyBodyIsClosed : Async Unit := do
let body : Body.Empty := {}
assert! ( body.isClosed)
#eval emptyBodyIsClosed.block
-- Test Empty.close is a no-op: still closed and recv still returns none
def emptyBodyClose : Async Unit := do
let body : Body.Empty := {}
body.close
assert! ( body.isClosed)
let result body.recv
assert! result.isNone
#eval emptyBodyClose.block
-- Test Empty.recvSelector resolves immediately with none
def emptyBodyRecvSelector : Async Unit := do
let body : Body.Empty := {}
let result Selectable.one #[
.case body.recvSelector pure
]
assert! result.isNone
#eval emptyBodyRecvSelector.block
/-! ## Any tests -/
-- Test Any wrapping a Full body forwards recv correctly
def anyFromFull : Async Unit := do
let full Body.Full.ofString "hello"
let any : Body.Any := full
let result any.recv
assert! result.isSome
assert! result.get!.data == "hello".toUTF8
#eval anyFromFull.block
-- Test Any wrapping an Empty body returns none and reports closed
def anyFromEmpty : Async Unit := do
let empty : Body.Empty := {}
let any : Body.Any := empty
let result any.recv
assert! result.isNone
assert! ( any.isClosed)
#eval anyFromEmpty.block
-- Test Any.close closes the underlying body
def anyCloseForwards : Async Unit := do
let full Body.Full.ofString "test"
let any : Body.Any := full
any.close
assert! ( any.isClosed)
let result any.recv
assert! result.isNone
#eval anyCloseForwards.block
-- Test Any.recvSelector resolves immediately for a Full body
def anyRecvSelectorFromFull : Async Unit := do
let full Body.Full.ofString "sel"
let any : Body.Any := full
let result Selectable.one #[
.case any.recvSelector pure
]
assert! result.isSome
assert! result.get!.data == "sel".toUTF8
#eval anyRecvSelectorFromFull.block
/-! ## Request.Builder body tests -/
private def recvBuiltBody (body : Body.Full) : Async (Option Chunk) :=
body.recv
-- Test Request.Builder.text sets correct headers
def requestBuilderText : Async Unit := do
let req Request.post (.originForm! "/api")
|>.text "Hello, World!"
assert! req.line.headers.get? Header.Name.contentType == some (Header.Value.ofString! "text/plain; charset=utf-8")
assert! req.line.headers.get? Header.Name.contentLength == none
let body recvBuiltBody req.body
assert! body.isSome
assert! body.get!.data == "Hello, World!".toUTF8
#eval requestBuilderText.block
-- Test Request.Builder.json sets correct headers
def requestBuilderJson : Async Unit := do
let req Request.post (.originForm! "/api")
|>.json "{\"key\": \"value\"}"
assert! req.line.headers.get? Header.Name.contentType == some (Header.Value.ofString! "application/json")
assert! req.line.headers.get? Header.Name.contentLength == none
let body recvBuiltBody req.body
assert! body.isSome
assert! body.get!.data == "{\"key\": \"value\"}".toUTF8
#eval requestBuilderJson.block
-- Test Request.Builder.fromBytes sets body
def requestBuilderFromBytes : Async Unit := do
let data := ByteArray.mk #[0x01, 0x02, 0x03]
let req Request.post (.originForm! "/api")
|>.fromBytes data
assert! req.line.headers.get? Header.Name.contentLength == none
let body recvBuiltBody req.body
assert! body.isSome
assert! body.get!.data == data
#eval requestBuilderFromBytes.block
-- Test Request.Builder.noBody creates empty body
def requestBuilderNoBody : Async Unit := do
let req Request.get (.originForm! "/api")
|>.empty
assert! req.body == {}
#eval requestBuilderNoBody.block
-- Test Request.Builder.bytes sets application/octet-stream content type
def requestBuilderBytes : Async Unit := do
let data := ByteArray.mk #[0xde, 0xad, 0xbe, 0xef]
let req Request.post (.originForm! "/api")
|>.bytes data
assert! req.line.headers.get? Header.Name.contentType == some (Header.Value.ofString! "application/octet-stream")
let body recvBuiltBody req.body
assert! body.isSome
assert! body.get!.data == data
#eval requestBuilderBytes.block
-- Test Request.Builder.html sets text/html content type
def requestBuilderHtml : Async Unit := do
let req Request.post (.originForm! "/api")
|>.html "<h1>Hello</h1>"
assert! req.line.headers.get? Header.Name.contentType == some (Header.Value.ofString! "text/html; charset=utf-8")
let body recvBuiltBody req.body
assert! body.isSome
assert! body.get!.data == "<h1>Hello</h1>".toUTF8
#eval requestBuilderHtml.block
-- Test Request.Builder.stream creates a streaming body
def requestBuilderStream : Async Unit := do
let req Request.post (.originForm! "/api")
|>.stream fun s => do
s.send (Chunk.ofByteArray "streamed".toUTF8)
let result req.body.recv
assert! result.isSome
assert! result.get!.data == "streamed".toUTF8
#eval requestBuilderStream.block
-- Test Request.Builder.noBody body is always closed and returns none
def requestBuilderNoBodyAlwaysClosed : Async Unit := do
let req Request.get (.originForm! "/api")
|>.empty
assert! ( req.body.isClosed)
let result req.body.recv
assert! result.isNone
#eval requestBuilderNoBodyAlwaysClosed.block
/-! ## Response.Builder body tests -/
-- Test Response.Builder.text sets correct headers
def responseBuilderText : Async Unit := do
let res Response.ok
|>.text "Hello, World!"
assert! res.line.headers.get? Header.Name.contentType == some (Header.Value.ofString! "text/plain; charset=utf-8")
assert! res.line.headers.get? Header.Name.contentLength == none
let body recvBuiltBody res.body
assert! body.isSome
assert! body.get!.data == "Hello, World!".toUTF8
#eval responseBuilderText.block
-- Test Response.Builder.json sets correct headers
def responseBuilderJson : Async Unit := do
let res Response.ok
|>.json "{\"status\": \"ok\"}"
assert! res.line.headers.get? Header.Name.contentType == some (Header.Value.ofString! "application/json")
assert! res.line.headers.get? Header.Name.contentLength == none
let body recvBuiltBody res.body
assert! body.isSome
assert! body.get!.data == "{\"status\": \"ok\"}".toUTF8
#eval responseBuilderJson.block
-- Test Response.Builder.fromBytes sets body
def responseBuilderFromBytes : Async Unit := do
let data := ByteArray.mk #[0xaa, 0xbb]
let res Response.ok
|>.fromBytes data
assert! res.line.headers.get? Header.Name.contentLength == none
let body recvBuiltBody res.body
assert! body.isSome
assert! body.get!.data == data
#eval responseBuilderFromBytes.block
-- Test Response.Builder.noBody creates empty body
def responseBuilderNoBody : Async Unit := do
let res Response.ok
|>.empty
assert! res.body == {}
#eval responseBuilderNoBody.block
-- Test Response.Builder.bytes sets application/octet-stream content type
def responseBuilderBytes : Async Unit := do
let data := ByteArray.mk #[0xca, 0xfe]
let res Response.ok
|>.bytes data
assert! res.line.headers.get? Header.Name.contentType == some (Header.Value.ofString! "application/octet-stream")
let body recvBuiltBody res.body
assert! body.isSome
assert! body.get!.data == data
#eval responseBuilderBytes.block
-- Test Response.Builder.html sets text/html content type
def responseBuilderHtml : Async Unit := do
let res Response.ok
|>.html "<p>OK</p>"
assert! res.line.headers.get? Header.Name.contentType == some (Header.Value.ofString! "text/html; charset=utf-8")
let body recvBuiltBody res.body
assert! body.isSome
assert! body.get!.data == "<p>OK</p>".toUTF8
#eval responseBuilderHtml.block
-- Test Response.Builder.stream creates a streaming body
def responseBuilderStream : Async Unit := do
let res Response.ok
|>.stream fun s => do
s.send (Chunk.ofByteArray "streamed".toUTF8)
let result res.body.recv
assert! result.isSome
assert! result.get!.data == "streamed".toUTF8
#eval responseBuilderStream.block
-- Test Response.Builder.noBody body is always closed and returns none
def responseBuilderNoBodyAlwaysClosed : Async Unit := do
let res Response.ok
|>.empty
assert! ( res.body.isClosed)
let result res.body.recv
assert! result.isNone
#eval responseBuilderNoBodyAlwaysClosed.block

View File

@@ -1,330 +0,0 @@
/-
Tests for the `deprecated_arg` attribute.
-/
-- `newArg` is not a parameter of the declaration
/--
error: `new` is not a parameter of `f1`
-/
#guard_msgs in
@[deprecated_arg old new]
def f1 (x : Nat) : Nat := x
-- `oldArg` is still a parameter of the declaration (rename not applied)
/--
error: `old` is still a parameter of `f2`; rename it to `new` before adding `@[deprecated_arg]`
-/
#guard_msgs in
@[deprecated_arg old new]
def f2 (old new : Nat) : Nat := old + new
-- Neither name is a parameter — reports that `newArg` is not a parameter
/--
error: `baz` is not a parameter of `f3`
-/
#guard_msgs in
@[deprecated_arg bar baz]
def f3 (x : Nat) : Nat := x
-- Valid usage without `since`: warns about missing `since`
/--
warning: `[deprecated_arg]` attribute should specify the date or library version at which the deprecation was introduced, using `(since := "...")`
-/
#guard_msgs in
@[deprecated_arg old new]
def f4 (new : Nat) : Nat := new
-- Valid usage with `since`: no warning
#guard_msgs in
@[deprecated_arg old new (since := "2026-03-18")]
def f5 (new : Nat) : Nat := new
-- Multiple renames without `since`: warns twice
/--
warning: `[deprecated_arg]` attribute should specify the date or library version at which the deprecation was introduced, using `(since := "...")`
---
warning: `[deprecated_arg]` attribute should specify the date or library version at which the deprecation was introduced, using `(since := "...")`
-/
#guard_msgs in
@[deprecated_arg old1 new1, deprecated_arg old2 new2]
def f6 (new1 new2 : Nat) : Nat := new1 + new2
/-! ## Functional tests: warning + correct elaboration -/
-- Old name produces warning with code action hint and elaborates correctly
/--
warning: parameter `old` of `f4` has been deprecated, use `new` instead
Hint: Rename this argument:
o̵l̵d̵n̲e̲w̲
---
info: f4 42 : Nat
-/
#guard_msgs in
#check f4 (old := 42)
-- New name produces no warning
/--
info: f4 42 : Nat
-/
#guard_msgs in
#check f4 (new := 42)
-- Positional arguments are unaffected
/--
info: f4 42 : Nat
-/
#guard_msgs in
#check f4 42
-- `since` field does not appear in warning message (consistent with `@[deprecated]`)
/--
warning: parameter `old` of `f5` has been deprecated, use `new` instead
Hint: Rename this argument:
o̵l̵d̵n̲e̲w̲
---
info: f5 42 : Nat
-/
#guard_msgs in
#check f5 (old := 42)
-- Multiple renames: both warnings emitted with code action hints
/--
warning: parameter `old1` of `f6` has been deprecated, use `new1` instead
Hint: Rename this argument:
o̵l̵d̵n̲e̲w̲1
---
warning: parameter `old2` of `f6` has been deprecated, use `new2` instead
Hint: Rename this argument:
o̵l̵d̵n̲e̲w̲2
---
info: f6 1 2 : Nat
-/
#guard_msgs in
#check f6 (old1 := 1) (old2 := 2)
-- Multiple renames: new names produce no warnings
/--
info: f6 1 2 : Nat
-/
#guard_msgs in
#check f6 (new1 := 1) (new2 := 2)
-- Mixed: one old name, one new name
/--
warning: parameter `old1` of `f6` has been deprecated, use `new1` instead
Hint: Rename this argument:
o̵l̵d̵n̲e̲w̲1
---
info: f6 1 2 : Nat
-/
#guard_msgs in
#check f6 (old1 := 1) (new2 := 2)
/-! ## Disabling the linter rejects old names -/
-- When `linter.deprecated.arg` is false, old names produce a clean error
/--
error: Invalid argument name `old` for function `f4`
Hint: Perhaps you meant one of the following parameter names:
• `new`: o̵l̵d̵n̲e̲w̲
-/
#guard_msgs in
set_option linter.deprecated.arg false in
#check f4 (old := 42)
-- New name still works when linter is disabled
/--
info: f4 42 : Nat
-/
#guard_msgs in
set_option linter.deprecated.arg false in
#check f4 (new := 42)
/-! ## Removed (no replacement) deprecated arguments -/
-- `oldArg` is still a parameter of the declaration
/--
error: `removed` is still a parameter of `r1`; remove it before adding `@[deprecated_arg]`
-/
#guard_msgs in
@[deprecated_arg removed]
def r1 (removed : Nat) : Nat := removed
-- Valid removed arg without `since`: warns about missing `since`
/--
warning: `[deprecated_arg]` attribute should specify the date or library version at which the deprecation was introduced, using `(since := "...")`
-/
#guard_msgs in
@[deprecated_arg removed]
def r2 (x : Nat) : Nat := x
-- Valid removed arg with `since`: no warning
#guard_msgs in
@[deprecated_arg removed (since := "2026-03-23")]
def r3 (x : Nat) : Nat := x
-- Using a removed arg produces an error with delete hint
/--
error: parameter `removed` of `r2` has been deprecated
Hint: Delete this argument:
(̵r̵e̵m̵o̵v̵e̵d̵ ̵:̵=̵ ̵4̵2̵)̵
-/
#guard_msgs in
#check r2 (removed := 42)
-- Using a removed arg with `since` produces an error with delete hint
/--
error: parameter `removed` of `r3` has been deprecated
Hint: Delete this argument:
(̵r̵e̵m̵o̵v̵e̵d̵ ̵:̵=̵ ̵4̵2̵)̵
-/
#guard_msgs in
#check r3 (removed := 42)
-- Normal args still work alongside removed deprecated args
/--
info: r2 42 : Nat
-/
#guard_msgs in
#check r2 (x := 42)
-- Positional args work fine
/--
info: r3 42 : Nat
-/
#guard_msgs in
#check r3 42
-- Removed arg: when linter is disabled, falls through to normal "invalid arg" error
/--
error: Invalid argument name `removed` for function `r2`
Hint: Perhaps you meant one of the following parameter names:
• `x`: r̵e̵m̵o̵v̵e̵d̵x̲
-/
#guard_msgs in
set_option linter.deprecated.arg false in
#check r2 (removed := 42)
-- Mix of renamed and removed on same declaration
/--
warning: `[deprecated_arg]` attribute should specify the date or library version at which the deprecation was introduced, using `(since := "...")`
---
warning: `[deprecated_arg]` attribute should specify the date or library version at which the deprecation was introduced, using `(since := "...")`
-/
#guard_msgs in
@[deprecated_arg old new, deprecated_arg removed]
def r4 (new : Nat) : Nat := new
-- Renamed arg still warns
/--
warning: parameter `old` of `r4` has been deprecated, use `new` instead
Hint: Rename this argument:
o̵l̵d̵n̲e̲w̲
---
info: r4 42 : Nat
-/
#guard_msgs in
#check r4 (old := 42)
-- Removed arg errors
/--
error: parameter `removed` of `r4` has been deprecated
Hint: Delete this argument:
(̵r̵e̵m̵o̵v̵e̵d̵ ̵:̵=̵ ̵4̵2̵)̵
-/
#guard_msgs in
#check r4 (removed := 42)
@[deprecated_arg arg (since := "26.03.26")]
def r5 (x : Nat) : Nat := x
/--
error: parameter `arg` of `r5` has been deprecated
Hint: Delete this argument:
(̵a̵r̵g̵ ̵:̵=̵ ̵6̵)̵
-/
#guard_msgs in
#check r5 3 (arg := 6)
/--
error: Invalid argument name `arg` for function `r5`
Hint: Perhaps you meant one of the following parameter names:
• `x`: a̵r̵g̵x̲
-/
#guard_msgs in
set_option linter.deprecated.arg false in
#check r5 3 (arg := 6)
/-! ## Custom deprecation messages -/
-- Renamed arg with custom message
#guard_msgs in
@[deprecated_arg old new "this parameter was split into two" (since := "2026-03-26")]
def m1 (new : Nat) : Nat := new
-- Using renamed arg with message shows the message in the warning
/--
warning: parameter `old` of `m1` has been deprecated, use `new` instead: this parameter was split into two
Hint: Rename this argument:
o̵l̵d̵n̲e̲w̲
---
info: m1 42 : Nat
-/
#guard_msgs in
#check m1 (old := 42)
-- Removed arg with custom message
#guard_msgs in
@[deprecated_arg gone "no longer needed" (since := "2026-03-26")]
def m2 (x : Nat) : Nat := x
-- Using removed arg with message shows the message in the error
/--
error: parameter `gone` of `m2` has been deprecated: no longer needed
Hint: Delete this argument:
(̵g̵o̵n̵e̵ ̵:̵=̵ ̵4̵2̵)̵
-/
#guard_msgs in
#check m2 (gone := 42)
-- Without custom message, behavior unchanged
/--
error: parameter `removed` of `r3` has been deprecated
Hint: Delete this argument:
(̵r̵e̵m̵o̵v̵e̵d̵ ̵:̵=̵ ̵4̵2̵)̵
-/
#guard_msgs in
#check r3 (removed := 42)
-- Removed arg with text but no `since`: warns about missing `since`
/--
warning: `[deprecated_arg]` attribute should specify the date or library version at which the deprecation was introduced, using `(since := "...")`
-/
#guard_msgs in
@[deprecated_arg dropped "use positional args"]
def m3 (x : Nat) : Nat := x
/--
error: parameter `dropped` of `m3` has been deprecated: use positional args
Hint: Delete this argument:
(̵d̵r̵o̵p̵p̵e̵d̵ ̵:̵=̵ ̵4̵2̵)̵
-/
#guard_msgs in
#check m3 (dropped := 42)

View File

@@ -1,14 +0,0 @@
-- Test that anonymous `if _ : cond then ...` works in do blocks (new do elaborator)
set_option backward.do.legacy false
def testDepIfAnon (n : Nat) : IO Unit := do
if _ : n > 0 then
IO.println "positive"
else
IO.println "zero"
-- Test the named variant too
def testDepIfNamed (n : Nat) : IO Unit := do
if h : n > 0 then
IO.println s!"positive: {n} > 0"
else
IO.println "zero"

View File

@@ -1,6 +0,0 @@
module
-- https://github.com/leanprover/lean4/issues/13167
theorem Option.bind_pmap {α β γ} {p : α Prop} (f : a, p a β) (x : Option α) (g : β Option γ) (H) :
pmap f x H >>= g = x.pbind fun a h g (f a (H _ h)) := by
grind [cases Option, pmap]

View File

@@ -1,6 +1,6 @@
module
public import Init.Grind.Ring.CommSolver
public import Lean.Meta.Tactic.Grind.Arith.CommRing.Poly
public import Lean.Meta.Sym.Arith.Poly
open Lean.Grind.CommRing
def w : Var := 0

View File

@@ -1,5 +1,5 @@
module
import Lean.Meta.Tactic.Grind.Arith.CommRing.Poly
import Lean.Meta.Sym.Arith.Poly
open Lean.Grind.CommRing
def w : Expr := .var 0

View File

@@ -27,7 +27,7 @@ Note: This linter can be disabled with `set_option linter.deprecatedCoercions fa
#guard_msgs in
def h (foo : X) : Y := foo
/-- A docstring to make `missingDocs` linter happy-/
/-- -/
notation a " +' " b => a + b
@[deprecated "" (since := "")]

View File

@@ -105,37 +105,3 @@ def handleMyCmd : SimpleHandler := fun
my_command y
my_command z
-- Test: empty doc strings should be treated as missing
/---/
def emptyDoc1 (x : Nat) := x
/--
-/
def emptyDoc2 (x : Nat) := x
/-- -/
def emptyDoc3 (x : Nat) := x
-- Test: empty doc strings on other declaration kinds
/---/
inductive EmptyInd where
/---/ | emptyCtorDoc
| noCtorDoc
/---/
notation:20 "empty_nota" x y => Nat.add x y
/---/
macro "empty_macro" : term => `(my_elab)
/---/
elab "empty_elab" : term => return Lean.mkConst ``false
-- Test: @[inherit_doc] suppresses even with empty doc
@[inherit_doc hasDoc]
def inheritedDoc (x : Nat) := x
-- Test: Verso doc comments with interpolated content are not empty
/-- See {name}`hasDoc` for details. -/
def versoDoc (x : Nat) := x

View File

@@ -109,30 +109,3 @@ Note: This linter can be disabled with `set_option linter.missingDocs false`
linterMissingDocs.lean:107:11-107:12: warning: missing doc string for my_command z
Note: This linter can be disabled with `set_option linter.missingDocs false`
linterMissingDocs.lean:111:4-111:13: warning: empty doc string for public def emptyDoc1
Note: This linter can be disabled with `set_option linter.missingDocs false`
linterMissingDocs.lean:115:4-115:13: warning: empty doc string for public def emptyDoc2
Note: This linter can be disabled with `set_option linter.missingDocs false`
linterMissingDocs.lean:118:4-118:13: warning: empty doc string for public def emptyDoc3
Note: This linter can be disabled with `set_option linter.missingDocs false`
linterMissingDocs.lean:122:10-122:18: warning: empty doc string for public inductive EmptyInd
Note: This linter can be disabled with `set_option linter.missingDocs false`
linterMissingDocs.lean:123:10-123:22: warning: empty doc string for public constructor EmptyInd.emptyCtorDoc
Note: This linter can be disabled with `set_option linter.missingDocs false`
linterMissingDocs.lean:124:4-124:13: warning: missing doc string for public constructor EmptyInd.noCtorDoc
Note: This linter can be disabled with `set_option linter.missingDocs false`
linterMissingDocs.lean:127:0-127:8: warning: empty doc string for notation
Note: This linter can be disabled with `set_option linter.missingDocs false`
linterMissingDocs.lean:130:0-130:5: warning: empty doc string for macro
Note: This linter can be disabled with `set_option linter.missingDocs false`
linterMissingDocs.lean:133:0-133:4: warning: empty doc string for elab
Note: This linter can be disabled with `set_option linter.missingDocs false`

View File

@@ -0,0 +1,138 @@
import Lean
/-!
# Tests for `Sym.Arith.Classify`, `Sym.Arith.EvalNum`, and `Sym.Arith.Functions`
-/
open Lean Meta Sym Arith
/-- Extract the value of a definition by name. -/
def getDefValue (n : Name) : MetaM Expr := do
let some (.defnInfo info) := ( getEnv).find? n
| throwError "expected definition: {n}"
return info.value
/-! ## Classification tests -/
deriving instance Repr for ClassifyResult
/-- info: Lean.Meta.Sym.Arith.ClassifyResult.commRing 0 -/
#guard_msgs in
run_meta SymM.run do
logInfo m!"{repr (← classify? (mkConst ``Int))}"
/-- info: Lean.Meta.Sym.Arith.ClassifyResult.commSemiring 0 -/
#guard_msgs in
run_meta SymM.run do
logInfo m!"{repr (← classify? (mkConst ``Nat))}"
/-- info: Lean.Meta.Sym.Arith.ClassifyResult.none -/
#guard_msgs in
run_meta SymM.run do
logInfo m!"{repr (← classify? (mkConst ``Bool))}"
-- Classifying the same type twice should return cached result with same id
/-- info: true -/
#guard_msgs in
run_meta SymM.run do
let .commRing id1 classify? (mkConst ``Int) | unreachable!
let .commRing id2 classify? (mkConst ``Int) | unreachable!
logInfo m!"{id1 == id2}"
/--
info: Lean.Meta.Sym.Arith.ClassifyResult.commRing 0
---
info: Lean.Meta.Sym.Arith.ClassifyResult.commSemiring 0
---
info: Lean.Meta.Sym.Arith.ClassifyResult.commRing 2
---
info: Lean.Meta.Sym.Arith.ClassifyResult.commRing 1
-/
#guard_msgs in
run_meta SymM.run do
let int shareCommon (mkConst ``Int)
let nat shareCommon (mkConst ``Nat)
let rat shareCommon (mkConst ``Rat)
logInfo m!"{repr (← classify? int)}"
logInfo m!"{repr (← classify? nat)}"
logInfo m!"{repr (← classify? rat)}"
let inst Sym.synthInstance (mkApp (mkConst ``Grind.Semiring [0]) nat)
let ofSemiring shareCommon ( Sym.canon <| mkApp2 (mkConst ``Grind.Ring.OfSemiring.Q [0]) nat inst)
logInfo m!"{repr (← classify? ofSemiring)}"
/-! ## EvalNum tests -/
def natZero : Nat := 0
def natSucc3 : Nat := Nat.succ (Nat.succ (Nat.succ 0))
def natSeven : Nat := 7
def natAdd : Nat := 2 + 3
def natMul : Nat := 2 * 3
def natPow : Nat := 2 ^ 3
def natBigPow : Nat := 2 ^ 100
def natPow10 : Nat := 2 ^ 10
/-- info: some (0) -/
#guard_msgs in
run_meta SymM.run do
logInfo m!"{← evalNat? (← getDefValue ``natZero)}"
/-- info: some (3) -/
#guard_msgs in
run_meta SymM.run do
logInfo m!"{← evalNat? (← getDefValue ``natSucc3)}"
/-- info: some (7) -/
#guard_msgs in
run_meta SymM.run do
logInfo m!"{← evalNat? (← getDefValue ``natSeven)}"
/-- info: some (5) -/
#guard_msgs in
run_meta SymM.run do
logInfo m!"{← evalNat? (← getDefValue ``natAdd)}"
/-- info: some (6) -/
#guard_msgs in
run_meta SymM.run do
logInfo m!"{← evalNat? (← getDefValue ``natMul)}"
/-- info: some (8) -/
#guard_msgs in
run_meta SymM.run do
logInfo m!"{← evalNat? (← getDefValue ``natPow)}"
/-! ## Exp threshold tests -/
-- 2 ^ 100 should fail with default exp threshold (8)
/-- info: none -/
#guard_msgs in
run_meta SymM.run do
logInfo m!"{← evalNat? (← getDefValue ``natBigPow)}"
-- 2 ^ 10 succeeds with exp threshold raised to 20
/-- info: some (1024) -/
#guard_msgs in
run_meta SymM.run do
withExpThreshold 20 do
logInfo m!"{← evalNat? (← getDefValue ``natPow10)}"
/-! ## Int EvalNum tests -/
def intNeg : Int := -5
def intAdd : Int := 3 + (-2)
def intMul : Int := (-3) * 4
/-- info: some (-5) -/
#guard_msgs in
run_meta SymM.run do
logInfo m!"{← evalInt? (← getDefValue ``intNeg)}"
/-- info: some (1) -/
#guard_msgs in
run_meta SymM.run do
logInfo m!"{← evalInt? (← getDefValue ``intAdd)}"
/-- info: some (-12) -/
#guard_msgs in
run_meta SymM.run do
logInfo m!"{← evalInt? (← getDefValue ``intMul)}"

View File

@@ -0,0 +1,172 @@
import Lean
/-!
# Tests for `Sym.Arith.Reify`
-/
open Lean Meta Sym Arith
/-- Extract the value of a definition by name. -/
def getDefValue (n : Name) : MetaM Expr := do
let some (.defnInfo info) := ( getEnv).find? n
| throwError "expected definition: {n}"
return info.value
/-!
## Setup: a simple monad for testing reification
-/
structure TestState where
ring : CommRing
vars : Array Expr := {}
varMap : PHashMap ExprPtr Var := {}
abbrev TestM := StateRefT TestState SymM
instance : MonadCanon TestM where
canonExpr e := Sym.canon e
synthInstance? e := Sym.synthInstance? e
instance : MonadCommRing TestM where
getCommRing := return ( get).ring
modifyCommRing f := modify fun s => { s with ring := f s.ring }
instance : MonadMkVar TestM where
mkVar e := do
if let some v := ( get).varMap.find? { expr := e } then
return v
let v := ( get).vars.size
modify fun s => { s with
vars := s.vars.push e
varMap := s.varMap.insert { expr := e } v
}
return v
instance : MonadGetVar TestM where
getVar x := return ( get).vars[x]!
/-- Run a `TestM` on `Int`'s `CommRing`, canonicalizing `e` first. -/
def reifyIntExpr (n : Name) (skipVar := true) : TestM (Option RingExpr) := do
let e canonExpr ( getDefValue n)
reifyRing? e (skipVar := skipVar)
def runTestOnInt (x : TestM α) : SymM α := do
let .commRing id classify? (mkConst ``Int) | throwError "Int is not a CommRing"
let ring := ( getArithState).rings[id]!
x |>.run' { ring }
/-! ## Reify ring tests on Int -/
deriving instance Repr for Lean.Grind.CommRing.Expr
def intAdd : Int := 2 + 3
def intMulAdd : Int := 2 * 3 + 1
def intNeg : Int := -5
def intPow : Int := 2 ^ 3
def intSub : Int := 7 - 2
/-- info: some (Lean.Grind.CommRing.Expr.add (Lean.Grind.CommRing.Expr.num 2) (Lean.Grind.CommRing.Expr.num 3)) -/
#guard_msgs in
run_meta SymM.run do runTestOnInt do
logInfo m!"{repr (← reifyIntExpr ``intAdd)}"
/--
info: some (Lean.Grind.CommRing.Expr.add
(Lean.Grind.CommRing.Expr.mul (Lean.Grind.CommRing.Expr.num 2) (Lean.Grind.CommRing.Expr.num 3))
(Lean.Grind.CommRing.Expr.num 1))
-/
#guard_msgs in
run_meta SymM.run do runTestOnInt do
logInfo m!"{repr (← reifyIntExpr ``intMulAdd)}"
/-- info: some (Lean.Grind.CommRing.Expr.neg (Lean.Grind.CommRing.Expr.num 5)) -/
#guard_msgs in
run_meta SymM.run do runTestOnInt do
logInfo m!"{repr (← reifyIntExpr ``intNeg)}"
/-- info: some (Lean.Grind.CommRing.Expr.pow (Lean.Grind.CommRing.Expr.num 2) 3) -/
#guard_msgs in
run_meta SymM.run do runTestOnInt do
logInfo m!"{repr (← reifyIntExpr ``intPow)}"
/--
info: some (Lean.Grind.CommRing.Expr.sub (Lean.Grind.CommRing.Expr.num 7) (Lean.Grind.CommRing.Expr.num 2))
-/
#guard_msgs in
run_meta SymM.run do runTestOnInt do
logInfo m!"{repr (← reifyIntExpr ``intSub)}"
-- skipVar test: a non-arithmetic term returns none with skipVar=true
/-- info: none -/
#guard_msgs in
run_meta SymM.run do runTestOnInt do
let a mkFreshExprMVar (mkConst ``Int)
logInfo m!"{repr (← reifyRing? a)}"
-- skipVar=false: a non-arithmetic term becomes a variable
/-- info: some (Lean.Grind.CommRing.Expr.var 0) -/
#guard_msgs in
run_meta SymM.run do runTestOnInt do
let a mkFreshExprMVar (mkConst ``Int)
logInfo m!"{repr (← reifyRing? a (skipVar := false))}"
opaque a : Int
opaque b : Int
opaque c : Int
def e := (a + b*2) - (c*a + a*(3*b + c))
/--
info: some (Lean.Grind.CommRing.Expr.sub
(Lean.Grind.CommRing.Expr.add
(Lean.Grind.CommRing.Expr.var 0)
(Lean.Grind.CommRing.Expr.mul (Lean.Grind.CommRing.Expr.var 1) (Lean.Grind.CommRing.Expr.num 2)))
(Lean.Grind.CommRing.Expr.add
(Lean.Grind.CommRing.Expr.mul (Lean.Grind.CommRing.Expr.var 2) (Lean.Grind.CommRing.Expr.var 0))
(Lean.Grind.CommRing.Expr.mul
(Lean.Grind.CommRing.Expr.var 0)
(Lean.Grind.CommRing.Expr.add
(Lean.Grind.CommRing.Expr.mul (Lean.Grind.CommRing.Expr.num 3) (Lean.Grind.CommRing.Expr.var 1))
(Lean.Grind.CommRing.Expr.var 2)))))
---
info: #[a, b, c]
-/
#guard_msgs in
run_meta SymM.run do runTestOnInt do
logInfo m!"{repr (← reifyIntExpr ``e)}"
logInfo ( get).vars
/-! ## Roundtrip tests: reify then denote -/
/-- Reify an expression, denote it back, and check they're definitionally equal. -/
def roundtrip (n : Name) : TestM Unit := do
let orig canonExpr ( getDefValue n)
let some re reifyRing? orig (skipVar := false) | throwError "reify failed"
let vars := ( get).vars
let denoted denoteRingExpr vars re
let denoted canonExpr denoted
unless ( isDefEq orig denoted) do
logInfo m!"MISMATCH for {n}:\n orig: {orig}\n denoted: {denoted}"
return
logInfo m!"roundtrip OK: {n}: {denoted}"
/--
info: roundtrip OK: intAdd: 2 + 3
---
info: roundtrip OK: intMulAdd: 2 * 3 + 1
---
info: roundtrip OK: intNeg: -5
---
info: roundtrip OK: intPow: 2 ^ 3
---
info: roundtrip OK: intSub: 7 - 2
---
info: roundtrip OK: e: a + b * 2 - (c * a + a * (3 * b + c))
-/
#guard_msgs in
run_meta SymM.run do runTestOnInt do
roundtrip ``intAdd
roundtrip ``intMulAdd
roundtrip ``intNeg
roundtrip ``intPow
roundtrip ``intSub
roundtrip ``e

View File

@@ -1 +0,0 @@
import DeprecatedArg.Use

View File

@@ -1,5 +0,0 @@
@[deprecated_arg arg foo (since := "2026-03-18")]
def f (foo : Nat) : Nat := foo + 1
@[deprecated_arg old1 new1 (since := "2026-03-18"), deprecated_arg old2 new2 (since := "2026-03-18")]
def g (new1 new2 : Nat) : Nat := new1 + new2

View File

@@ -1,55 +0,0 @@
import DeprecatedArg.Def
-- Cross-file: old name produces warning
/--
warning: parameter `arg` of `f` has been deprecated, use `foo` instead
Hint: Rename this argument:
a̵r̵g̵f̲o̲o̲
---
info: f 42 : Nat
-/
#guard_msgs in
#check f (arg := 42)
-- Cross-file: new name produces no warning
/--
info: f 42 : Nat
-/
#guard_msgs in
#check f (foo := 42)
-- Cross-file: positional arg produces no warning
/--
info: f 42 : Nat
-/
#guard_msgs in
#check f 42
-- Cross-file: multiple renames
/--
warning: parameter `old1` of `g` has been deprecated, use `new1` instead
Hint: Rename this argument:
o̵l̵d̵n̲e̲w̲1
---
warning: parameter `old2` of `g` has been deprecated, use `new2` instead
Hint: Rename this argument:
o̵l̵d̵n̲e̲w̲2
---
info: g 1 2 : Nat
-/
#guard_msgs in
#check g (old1 := 1) (old2 := 2)
-- Cross-file: disabling the linter rejects old names with a clean error
/--
error: Invalid argument name `arg` for function `f`
Hint: Perhaps you meant one of the following parameter names:
• `foo`: a̵r̵g̵f̲o̲o̲
-/
#guard_msgs in
set_option linter.deprecated.arg false in
#check f (arg := 42)

View File

@@ -1,5 +0,0 @@
import Lake
open Lake DSL
package deprecated_arg
@[default_target] lean_lib DeprecatedArg

View File

@@ -1 +0,0 @@
../../../build/release/stage1

Some files were not shown because too many files have changed in this diff Show More