mirror of
https://github.com/leanprover/lean4.git
synced 2026-04-11 22:54:17 +00:00
Compare commits
12 Commits
hbv/dec_de
...
sym-arith-
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
f12d008bb1 | ||
|
|
30315a59d4 | ||
|
|
9d078f64bc | ||
|
|
083b393294 | ||
|
|
9ea2b7b533 | ||
|
|
e17b0347c8 | ||
|
|
0a6c7eef66 | ||
|
|
46046b47a8 | ||
|
|
069e676532 | ||
|
|
94bf1d34d1 | ||
|
|
681769fb6d | ||
|
|
dad6fe832d |
@@ -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:
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -9,7 +9,7 @@ prelude
|
||||
public import Init.Data.Order.Ord
|
||||
public import Init.Data.String.Basic
|
||||
import Init.Data.Char.Lemmas
|
||||
import Init.Data.String.Lemmas.StringOrder
|
||||
import Init.Data.String.Lemmas
|
||||
|
||||
public section
|
||||
|
||||
|
||||
@@ -17,7 +17,6 @@ namespace Std
|
||||
/--
|
||||
Appends all the elements in the iterator, in order.
|
||||
-/
|
||||
@[inline]
|
||||
public def Iter.joinString {α β : Type} [Iterator α Id β] [ToString β]
|
||||
(it : Std.Iter (α := α) β) : String :=
|
||||
(it.map toString).fold (init := "") (· ++ ·)
|
||||
|
||||
@@ -20,4 +20,49 @@ public import Init.Data.String.Lemmas.Intercalate
|
||||
public import Init.Data.String.Lemmas.Iter
|
||||
public import Init.Data.String.Lemmas.Hashable
|
||||
public import Init.Data.String.Lemmas.TakeDrop
|
||||
public import Init.Data.String.Lemmas.StringOrder
|
||||
import Init.Data.Order.Lemmas
|
||||
public import Init.Data.String.Basic
|
||||
import Init.Data.Char.Lemmas
|
||||
import Init.Data.Char.Order
|
||||
import Init.Data.List.Lex
|
||||
|
||||
public section
|
||||
|
||||
open Std
|
||||
|
||||
namespace String
|
||||
|
||||
@[deprecated toList_inj (since := "2025-10-30")]
|
||||
protected theorem data_eq_of_eq {a b : String} (h : a = b) : a.toList = b.toList :=
|
||||
h ▸ rfl
|
||||
@[deprecated toList_inj (since := "2025-10-30")]
|
||||
protected theorem ne_of_data_ne {a b : String} (h : a.toList ≠ b.toList) : a ≠ b := by
|
||||
simpa [← toList_inj]
|
||||
|
||||
@[simp] protected theorem not_le {a b : String} : ¬ a ≤ b ↔ b < a := Decidable.not_not
|
||||
@[simp] protected theorem not_lt {a b : String} : ¬ a < b ↔ b ≤ a := Iff.rfl
|
||||
@[simp] protected theorem le_refl (a : String) : a ≤ a := List.le_refl _
|
||||
@[simp] protected theorem lt_irrefl (a : String) : ¬ a < a := List.lt_irrefl _
|
||||
|
||||
attribute [local instance] Char.notLTTrans Char.ltTrichotomous Char.ltAsymm
|
||||
|
||||
protected theorem le_trans {a b c : String} : a ≤ b → b ≤ c → a ≤ c := List.le_trans
|
||||
protected theorem lt_trans {a b c : String} : a < b → b < c → a < c := List.lt_trans
|
||||
protected theorem le_total (a b : String) : a ≤ b ∨ b ≤ a := List.le_total _ _
|
||||
protected theorem le_antisymm {a b : String} : a ≤ b → b ≤ a → a = b := fun h₁ h₂ => String.ext (List.le_antisymm (as := a.toList) (bs := b.toList) h₁ h₂)
|
||||
protected theorem lt_asymm {a b : String} (h : a < b) : ¬ b < a := List.lt_asymm h
|
||||
protected theorem ne_of_lt {a b : String} (h : a < b) : a ≠ b := by
|
||||
have := String.lt_irrefl a
|
||||
intro h; subst h; contradiction
|
||||
|
||||
instance instIsLinearOrder : IsLinearOrder String := by
|
||||
apply IsLinearOrder.of_le
|
||||
case le_antisymm => constructor; apply String.le_antisymm
|
||||
case le_trans => constructor; apply String.le_trans
|
||||
case le_total => constructor; apply String.le_total
|
||||
|
||||
instance : LawfulOrderLT String where
|
||||
lt_iff a b := by
|
||||
simp [← String.not_le, Decidable.imp_iff_not_or, Std.Total.total]
|
||||
|
||||
end String
|
||||
|
||||
@@ -40,7 +40,7 @@ framework.
|
||||
/--
|
||||
This data-carrying typeclass is used to give semantics to a pattern type that implements
|
||||
{name}`ForwardPattern` and/or {name}`ToForwardSearcher` by providing an abstract, not necessarily
|
||||
decidable {name}`PatternModel.Matches` predicate that implementations of {name}`ForwardPattern`
|
||||
decidable {name}`PatternModel.Matches` predicate that implementates of {name}`ForwardPattern`
|
||||
and {name}`ToForwardSearcher` can be validated against.
|
||||
|
||||
Correctness results for generic functions relying on the pattern infrastructure, for example the
|
||||
@@ -151,7 +151,7 @@ theorem IsLongestMatch.le_of_isMatch {pat : ρ} [PatternModel pat] {s : Slice} {
|
||||
|
||||
/--
|
||||
Predicate stating that the region between the start of the slice {name}`s` and the position
|
||||
{name}`pos` matches the pattern {name}`pat`, and that there is no longer match starting at the
|
||||
{name}`pos` matches the patten {name}`pat`, and that there is no longer match starting at the
|
||||
beginning of the slice. This is what a correct matcher should match.
|
||||
|
||||
In some cases, being a match and being a longest match will coincide, see
|
||||
@@ -228,7 +228,7 @@ theorem isLongestRevMatch_iff_isRevMatch {ρ : Type} (pat : ρ) [PatternModel pa
|
||||
exact ht₅ (NoSuffixPatternModel.eq_empty _ _ ht₂ (ht₅'' ▸ ht₂'))
|
||||
|
||||
/--
|
||||
Predicate stating that the slice formed by {name}`startPos` and {name}`endPos` contains a match
|
||||
Predicate stating that the slice formed by {name}`startPos` and {name}`endPos` contains is a match
|
||||
of {name}`pat` in {name}`s` and it is longest among matches starting at {name}`startPos`.
|
||||
-/
|
||||
structure IsLongestMatchAt (pat : ρ) [PatternModel pat] {s : Slice} (startPos endPos : s.Pos) : Prop where
|
||||
@@ -411,7 +411,7 @@ theorem not_revMatchesAt_startPos {pat : ρ} [PatternModel pat] {s : Slice} :
|
||||
intro h
|
||||
simpa [← Pos.ofSliceTo_inj] using h.ne_endPos
|
||||
|
||||
theorem revMatchesAt_iff_revMatchesAt_ofSliceTo {pat : ρ} [PatternModel pat] {s : Slice} {base : s.Pos}
|
||||
theorem revMatchesAt_iff_revMatchesAt_ofSliceto {pat : ρ} [PatternModel pat] {s : Slice} {base : s.Pos}
|
||||
{pos : (s.sliceTo base).Pos} : RevMatchesAt pat pos ↔ RevMatchesAt pat (Pos.ofSliceTo pos) := by
|
||||
simp only [revMatchesAt_iff_exists_isLongestRevMatchAt]
|
||||
constructor
|
||||
@@ -505,8 +505,8 @@ theorem LawfulForwardPatternModel.skipPrefix?_eq_none_iff {ρ : Type} {pat : ρ}
|
||||
/--
|
||||
Predicate stating compatibility between {name}`PatternModel` and {name}`BackwardPattern`.
|
||||
|
||||
This extends {name}`LawfulBackwardPattern`, but it is much stronger because it forces the
|
||||
{name}`BackwardPattern` to match the longest prefix of the given slice that matches the property
|
||||
This extends {name}`LawfulForwardPattern`, but it is much stronger because it forces the
|
||||
{name}`ForwardPattern` to match the longest prefix of the given slice that matches the property
|
||||
supplied by the {name}`PatternModel` instance.
|
||||
-/
|
||||
class LawfulBackwardPatternModel {ρ : Type} (pat : ρ) [BackwardPattern pat]
|
||||
|
||||
@@ -65,7 +65,7 @@ theorem startsWith_prop_eq_head? {P : Char → Prop} [DecidablePred P] {s : Slic
|
||||
s.startsWith P = s.copy.toList.head?.any (decide <| P ·) := by
|
||||
simp [startsWith_prop_eq_startsWith_decide, startsWith_bool_eq_head?]
|
||||
|
||||
theorem eq_append_of_dropPrefix?_prop_eq_some {P : Char → Prop} [DecidablePred P] {s res : Slice} (h : s.dropPrefix? P = some res) :
|
||||
theorem eq_append_of_dropPrefix_prop_eq_some {P : Char → Prop} [DecidablePred P] {s res : Slice} (h : s.dropPrefix? P = some res) :
|
||||
∃ c, s.copy = singleton c ++ res.copy ∧ P c := by
|
||||
rw [dropPrefix?_prop_eq_dropPrefix?_decide] at h
|
||||
simpa using eq_append_of_dropPrefix?_bool_eq_some h
|
||||
@@ -162,7 +162,7 @@ theorem startsWith_prop_eq_head? {P : Char → Prop} [DecidablePred P] {s : Stri
|
||||
theorem eq_append_of_dropPrefix?_prop_eq_some {P : Char → Prop} [DecidablePred P] {s : String} {res : Slice}
|
||||
(h : s.dropPrefix? P = some res) : ∃ c, s = singleton c ++ res.copy ∧ P c := by
|
||||
rw [dropPrefix?_eq_dropPrefix?_toSlice] at h
|
||||
simpa using Slice.eq_append_of_dropPrefix?_prop_eq_some h
|
||||
simpa using Slice.eq_append_of_dropPrefix_prop_eq_some h
|
||||
|
||||
theorem skipSuffix?_bool_eq_some_iff {p : Char → Bool} {s : String} {pos : s.Pos} :
|
||||
s.skipSuffix? p = some pos ↔ ∃ h, pos = s.endPos.prev h ∧ p ((s.endPos.prev h).get (by simp)) = true := by
|
||||
|
||||
@@ -1,49 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Init.Data.String.Basic
|
||||
public import Init.Data.Order.Classes
|
||||
import Init.Data.List.Lex
|
||||
import Init.Data.Char.Lemmas
|
||||
import Init.Data.Char.Order
|
||||
import Init.Data.Order.Factories
|
||||
import Init.Data.Order.Lemmas
|
||||
|
||||
public section
|
||||
|
||||
open Std
|
||||
|
||||
namespace String
|
||||
|
||||
@[simp] protected theorem not_le {a b : String} : ¬ a ≤ b ↔ b < a := Decidable.not_not
|
||||
@[simp] protected theorem not_lt {a b : String} : ¬ a < b ↔ b ≤ a := Iff.rfl
|
||||
@[simp] protected theorem le_refl (a : String) : a ≤ a := List.le_refl _
|
||||
@[simp] protected theorem lt_irrefl (a : String) : ¬ a < a := List.lt_irrefl _
|
||||
|
||||
attribute [local instance] Char.notLTTrans Char.ltTrichotomous Char.ltAsymm
|
||||
|
||||
protected theorem le_trans {a b c : String} : a ≤ b → b ≤ c → a ≤ c := List.le_trans
|
||||
protected theorem lt_trans {a b c : String} : a < b → b < c → a < c := List.lt_trans
|
||||
protected theorem le_total (a b : String) : a ≤ b ∨ b ≤ a := List.le_total _ _
|
||||
protected theorem le_antisymm {a b : String} : a ≤ b → b ≤ a → a = b := fun h₁ h₂ => String.ext (List.le_antisymm (as := a.toList) (bs := b.toList) h₁ h₂)
|
||||
protected theorem lt_asymm {a b : String} (h : a < b) : ¬ b < a := List.lt_asymm h
|
||||
protected theorem ne_of_lt {a b : String} (h : a < b) : a ≠ b := by
|
||||
have := String.lt_irrefl a
|
||||
intro h; subst h; contradiction
|
||||
|
||||
instance instIsLinearOrder : IsLinearOrder String := by
|
||||
apply IsLinearOrder.of_le
|
||||
case le_antisymm => constructor; apply String.le_antisymm
|
||||
case le_trans => constructor; apply String.le_trans
|
||||
case le_total => constructor; apply String.le_total
|
||||
|
||||
instance : LawfulOrderLT String where
|
||||
lt_iff a b := by
|
||||
simp [← String.not_le, Decidable.imp_iff_not_or, Std.Total.total]
|
||||
|
||||
end String
|
||||
@@ -706,14 +706,14 @@ Returns {name}`none` otherwise.
|
||||
This function is generic over all currently supported patterns.
|
||||
-/
|
||||
@[inline]
|
||||
def Pos.revSkip? {s : Slice} (pos : s.Pos) (pat : ρ) [BackwardPattern pat] : Option s.Pos :=
|
||||
((s.sliceFrom pos).skipSuffix? pat).map Pos.ofSliceFrom
|
||||
def Pos.revSkip? {s : Slice} (pos : s.Pos) (pat : ρ) [ForwardPattern pat] : Option s.Pos :=
|
||||
((s.sliceFrom pos).skipPrefix? pat).map Pos.ofSliceFrom
|
||||
|
||||
/--
|
||||
If {name}`pat` matches a suffix of {name}`s`, returns the remainder. Returns {name}`none` otherwise.
|
||||
|
||||
Use {name (scope := "Init.Data.String.Slice")}`String.Slice.dropSuffix` to return the slice
|
||||
unchanged when {name}`pat` does not match a suffix.
|
||||
unchanged when {name}`pat` does not match a prefix.
|
||||
|
||||
This function is generic over all currently supported patterns.
|
||||
|
||||
@@ -775,7 +775,7 @@ def Pos.revSkipWhile {s : Slice} (pos : s.Pos) (pat : ρ) [BackwardPattern pat]
|
||||
termination_by pos.down
|
||||
|
||||
/--
|
||||
Returns the position at the start of the longest suffix of {name}`s` for which {name}`pat` matches
|
||||
Returns the position a the start of the longest suffix of {name}`s` for which {name}`pat` matches
|
||||
(potentially repeatedly).
|
||||
-/
|
||||
@[inline]
|
||||
|
||||
@@ -314,7 +314,7 @@ Returns {name}`none` otherwise.
|
||||
This function is generic over all currently supported patterns.
|
||||
-/
|
||||
@[inline]
|
||||
def Pos.revSkip? {s : String} (pos : s.Pos) (pat : ρ) [BackwardPattern pat] : Option s.Pos :=
|
||||
def Pos.revSkip? {s : String} (pos : s.Pos) (pat : ρ) [ForwardPattern pat] : Option s.Pos :=
|
||||
(pos.toSlice.revSkip? pat).map Pos.ofToSlice
|
||||
|
||||
/--
|
||||
@@ -461,7 +461,7 @@ def dropPrefix? (s : String) (pat : ρ) [ForwardPattern pat] : Option String.Sli
|
||||
If {name}`pat` matches a suffix of {name}`s`, returns the remainder. Returns {name}`none` otherwise.
|
||||
|
||||
Use {name (scope := "Init.Data.String.TakeDrop")}`String.dropSuffix` to return the slice
|
||||
unchanged when {name}`pat` does not match a suffix.
|
||||
unchanged when {name}`pat` does not match a prefix.
|
||||
|
||||
This is a cheap operation because it does not allocate a new string to hold the result.
|
||||
To convert the result into a string, use {name}`String.Slice.copy`.
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -36,6 +36,9 @@ private local instance : ToString Int where
|
||||
private local instance : Repr Int where
|
||||
reprPrec i prec := if i < 0 then Repr.addAppParen (toString i) prec else toString i
|
||||
|
||||
private local instance : Append String where
|
||||
append := String.Internal.append
|
||||
|
||||
/-- Internal representation of a linear combination of atoms, and a constant term. -/
|
||||
structure LinearCombo where
|
||||
/-- Constant term. -/
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -60,7 +60,7 @@ instance : EmptyCollection (Trie α) :=
|
||||
instance : Inhabited (Trie α) where
|
||||
default := empty
|
||||
|
||||
/-- Insert or update the value at the given key `s`. -/
|
||||
/-- Insert or update the value at a the given key `s`. -/
|
||||
partial def upsert (t : Trie α) (s : String) (f : Option α → α) : Trie α :=
|
||||
let rec insertEmpty (i : Nat) : Trie α :=
|
||||
if h : i < s.utf8ByteSize then
|
||||
@@ -100,7 +100,7 @@ partial def upsert (t : Trie α) (s : String) (f : Option α → α) : Trie α :
|
||||
node (f v) cs ts
|
||||
loop 0 t
|
||||
|
||||
/-- Inserts a value at the given key `s`, overriding an existing value if present. -/
|
||||
/-- Inserts a value at a the given key `s`, overriding an existing value if present. -/
|
||||
partial def insert (t : Trie α) (s : String) (val : α) : Trie α :=
|
||||
upsert t s (fun _ => val)
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
/--
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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"
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
20
src/Lean/Meta/Sym/Arith.lean
Normal file
20
src/Lean/Meta/Sym/Arith.lean
Normal 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
|
||||
143
src/Lean/Meta/Sym/Arith/Classify.lean
Normal file
143
src/Lean/Meta/Sym/Arith/Classify.lean
Normal 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
|
||||
93
src/Lean/Meta/Sym/Arith/DenoteExpr.lean
Normal file
93
src/Lean/Meta/Sym/Arith/DenoteExpr.lean
Normal 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
|
||||
90
src/Lean/Meta/Sym/Arith/EvalNum.lean
Normal file
90
src/Lean/Meta/Sym/Arith/EvalNum.lean
Normal 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
|
||||
171
src/Lean/Meta/Sym/Arith/Functions.lean
Normal file
171
src/Lean/Meta/Sym/Arith/Functions.lean
Normal 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
|
||||
@@ -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
|
||||
39
src/Lean/Meta/Sym/Arith/MonadRing.lean
Normal file
39
src/Lean/Meta/Sym/Arith/MonadRing.lean
Normal 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
|
||||
39
src/Lean/Meta/Sym/Arith/MonadSemiring.lean
Normal file
39
src/Lean/Meta/Sym/Arith/MonadSemiring.lean
Normal 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
|
||||
32
src/Lean/Meta/Sym/Arith/MonadVar.lean
Normal file
32
src/Lean/Meta/Sym/Arith/MonadVar.lean
Normal 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
|
||||
205
src/Lean/Meta/Sym/Arith/Reify.lean
Normal file
205
src/Lean/Meta/Sym/Arith/Reify.lean
Normal 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
|
||||
@@ -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
|
||||
137
src/Lean/Meta/Sym/Arith/Types.lean
Normal file
137
src/Lean/Meta/Sym/Arith/Types.lean
Normal 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
|
||||
@@ -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
|
||||
|
||||
@@ -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.
|
||||
-/
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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]
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)`
|
||||
-/
|
||||
|
||||
@@ -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}"
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -183,8 +183,7 @@ public theorem toInt?_repr (a : Int) : a.repr.toInt? = some a := by
|
||||
rw [repr_eq_if]
|
||||
split <;> (simp; omega)
|
||||
|
||||
@[simp]
|
||||
public theorem isInt_repr (a : Int) : a.repr.isInt = true := by
|
||||
public theorem isInt?_repr (a : Int) : a.repr.isInt = true := by
|
||||
simp [← String.isSome_toInt?]
|
||||
|
||||
public theorem repr_injective {a b : Int} (h : Int.repr a = Int.repr b) : a = b := by
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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`).
|
||||
-/
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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.
|
||||
-/
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -94,3 +94,4 @@ def parseOrRoot (s : String) : Std.Http.URI.Path :=
|
||||
parse? s |>.getD { segments := #[], absolute := true }
|
||||
|
||||
end Std.Http.URI.Path
|
||||
|
||||
|
||||
@@ -239,7 +239,7 @@ def ofFin' {lo : Nat} (fin : Fin (Nat.succ hi)) (h : lo ≤ hi) : Bounded.LE lo
|
||||
else ofNat' lo (And.intro (Nat.le_refl lo) h)
|
||||
|
||||
/--
|
||||
Creates a new `Bounded.LE` using the modulus of a number.
|
||||
Creates a new `Bounded.LE` using a the modulus of a number.
|
||||
-/
|
||||
@[inline]
|
||||
def byEmod (b : Int) (i : Int) (hi : i > 0) : Bounded.LE 0 (i - 1) := by
|
||||
@@ -252,7 +252,7 @@ def byEmod (b : Int) (i : Int) (hi : i > 0) : Bounded.LE 0 (i - 1) := by
|
||||
exact Int.emod_lt_of_pos b hi
|
||||
|
||||
/--
|
||||
Creates a new `Bounded.LE` using the Truncating modulus of a number.
|
||||
Creates a new `Bounded.LE` using a the Truncating modulus of a number.
|
||||
-/
|
||||
@[inline]
|
||||
def byMod (b : Int) (i : Int) (hi : 0 < i) : Bounded.LE (- (i - 1)) (i - 1) := by
|
||||
|
||||
@@ -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.
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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}"
|
||||
|
||||
|
||||
@@ -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?⟩
|
||||
|
||||
@@ -415,128 +415,17 @@ static void lean_del_core(object * o, object * & todo) {
|
||||
}
|
||||
}
|
||||
|
||||
// Adaptive deque for lean_dec_ref_cold.
|
||||
// Uses a small stack-allocated circular buffer processed in FIFO (BFS) order
|
||||
// for better cache locality when freeing wide structures (arrays, multi-field
|
||||
// constructors). When the buffer is full, excess objects overflow to the
|
||||
// existing in-object linked list (DFS order).
|
||||
#define LEAN_DEC_DEQUE_CAP 32u
|
||||
#define LEAN_DEC_DEQUE_MASK (LEAN_DEC_DEQUE_CAP - 1u)
|
||||
|
||||
struct lean_del_deque {
|
||||
lean_object * buf[LEAN_DEC_DEQUE_CAP];
|
||||
unsigned head;
|
||||
unsigned tail;
|
||||
lean_object * overflow;
|
||||
};
|
||||
|
||||
static inline void deque_enqueue(lean_del_deque & dq, lean_object * o) {
|
||||
unsigned next_tail = (dq.tail + 1) & LEAN_DEC_DEQUE_MASK;
|
||||
if (LEAN_LIKELY(next_tail != dq.head)) {
|
||||
dq.buf[dq.tail] = o;
|
||||
dq.tail = next_tail;
|
||||
} else {
|
||||
push_back(dq.overflow, o);
|
||||
}
|
||||
}
|
||||
|
||||
static inline lean_object * deque_pop(lean_del_deque & dq) {
|
||||
if (LEAN_LIKELY(dq.head != dq.tail)) {
|
||||
lean_object * r = dq.buf[dq.head];
|
||||
dq.head = (dq.head + 1) & LEAN_DEC_DEQUE_MASK;
|
||||
return r;
|
||||
}
|
||||
return pop_back(dq.overflow);
|
||||
}
|
||||
|
||||
static inline bool deque_empty(lean_del_deque const & dq) {
|
||||
return dq.head == dq.tail && dq.overflow == nullptr;
|
||||
}
|
||||
|
||||
static inline void dec_deque(lean_object * o, lean_del_deque & dq) {
|
||||
if (lean_is_scalar(o))
|
||||
return;
|
||||
if (LEAN_LIKELY(o->m_rc > 1)) {
|
||||
o->m_rc--;
|
||||
} else if (o->m_rc == 1) {
|
||||
deque_enqueue(dq, o);
|
||||
} else if (o->m_rc == 0) {
|
||||
return;
|
||||
} else if (std::atomic_fetch_add_explicit(lean_get_rc_mt_addr(o), 1, std::memory_order_acq_rel) == -1) {
|
||||
deque_enqueue(dq, o);
|
||||
}
|
||||
}
|
||||
|
||||
static void lean_del_core_deque(object * o, lean_del_deque & dq) {
|
||||
uint8 tag = lean_ptr_tag(o);
|
||||
if (tag <= LeanMaxCtorTag) {
|
||||
object ** it = lean_ctor_obj_cptr(o);
|
||||
object ** end = it + lean_ctor_num_objs(o);
|
||||
for (; it != end; ++it) dec_deque(*it, dq);
|
||||
lean_free_small_object(o);
|
||||
} else {
|
||||
switch (tag) {
|
||||
case LeanClosure: {
|
||||
object ** it = lean_closure_arg_cptr(o);
|
||||
object ** end = it + lean_closure_num_fixed(o);
|
||||
for (; it != end; ++it) dec_deque(*it, dq);
|
||||
lean_dealloc(o, lean_closure_byte_size(o));
|
||||
break;
|
||||
}
|
||||
case LeanArray: {
|
||||
object ** it = lean_array_cptr(o);
|
||||
object ** end = it + lean_array_size(o);
|
||||
for (; it != end; ++it) dec_deque(*it, dq);
|
||||
lean_dealloc(o, lean_array_byte_size(o));
|
||||
break;
|
||||
}
|
||||
case LeanScalarArray:
|
||||
lean_dealloc(o, lean_sarray_byte_size(o));
|
||||
break;
|
||||
case LeanString:
|
||||
lean_dealloc(o, lean_string_byte_size(o));
|
||||
break;
|
||||
case LeanMPZ:
|
||||
to_mpz(o)->m_value.~mpz();
|
||||
lean_free_small_object(o);
|
||||
break;
|
||||
case LeanThunk:
|
||||
if (object * c = lean_to_thunk(o)->m_closure) dec_deque(c, dq);
|
||||
if (object * v = lean_to_thunk(o)->m_value) dec_deque(v, dq);
|
||||
lean_free_small_object(o);
|
||||
break;
|
||||
case LeanRef:
|
||||
if (object * v = lean_to_ref(o)->m_value) dec_deque(v, dq);
|
||||
lean_free_small_object(o);
|
||||
break;
|
||||
case LeanTask:
|
||||
deactivate_task(lean_to_task(o));
|
||||
break;
|
||||
case LeanPromise:
|
||||
deactivate_promise(lean_to_promise(o));
|
||||
break;
|
||||
case LeanExternal:
|
||||
lean_to_external(o)->m_class->m_finalize(lean_to_external(o)->m_data);
|
||||
lean_free_small_object(o);
|
||||
break;
|
||||
default:
|
||||
lean_unreachable();
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
extern "C" LEAN_EXPORT void lean_dec_ref_cold(lean_object * o) {
|
||||
if (o->m_rc == 1 || std::atomic_fetch_add_explicit(lean_get_rc_mt_addr(o), 1, std::memory_order_acq_rel) == -1) {
|
||||
#ifdef LEAN_LAZY_RC
|
||||
push_back(g_to_free, o);
|
||||
#else
|
||||
lean_del_deque dq;
|
||||
dq.head = 0;
|
||||
dq.tail = 0;
|
||||
dq.overflow = nullptr;
|
||||
deque_enqueue(dq, o);
|
||||
while (!deque_empty(dq)) {
|
||||
lean_del_core_deque(deque_pop(dq), dq);
|
||||
object * todo = nullptr;
|
||||
while (true) {
|
||||
lean_del_core(o, todo);
|
||||
if (todo == nullptr)
|
||||
return;
|
||||
o = pop_back(todo);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
BIN
stage0/src/CMakeLists.txt
generated
BIN
stage0/src/CMakeLists.txt
generated
Binary file not shown.
BIN
stage0/stdlib/Lake/Config/Cache.c
generated
BIN
stage0/stdlib/Lake/Config/Cache.c
generated
Binary file not shown.
BIN
stage0/stdlib/Lake/Reservoir.c
generated
BIN
stage0/stdlib/Lake/Reservoir.c
generated
Binary file not shown.
BIN
stage0/stdlib/Lake/Util/Reservoir.c
generated
BIN
stage0/stdlib/Lake/Util/Reservoir.c
generated
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data.c
generated
BIN
stage0/stdlib/Std/Internal/Http/Data.c
generated
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body.c
generated
BIN
stage0/stdlib/Std/Internal/Http/Data/Body.c
generated
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Any.c
generated
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Any.c
generated
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Basic.c
generated
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Basic.c
generated
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Empty.c
generated
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Empty.c
generated
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Full.c
generated
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Full.c
generated
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Length.c
generated
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Length.c
generated
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Stream.c
generated
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Stream.c
generated
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Request.c
generated
BIN
stage0/stdlib/Std/Internal/Http/Data/Request.c
generated
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Response.c
generated
BIN
stage0/stdlib/Std/Internal/Http/Data/Response.c
generated
Binary file not shown.
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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
|
||||
@@ -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)
|
||||
@@ -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"
|
||||
@@ -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]
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user