mirror of
https://github.com/leanprover/lean4.git
synced 2026-04-01 01:34:06 +00:00
Compare commits
16 Commits
sofia/open
...
worktree-e
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
6cbb299261 | ||
|
|
a88f81bc28 | ||
|
|
313abdb49f | ||
|
|
f08983bf01 | ||
|
|
22308dbaaa | ||
|
|
51e87865c5 | ||
|
|
75ec8e42c8 | ||
|
|
9fc62b7042 | ||
|
|
583c223b16 | ||
|
|
ccc7157c08 | ||
|
|
05046dc3d7 | ||
|
|
43f18fd502 | ||
|
|
b06eb981a3 | ||
|
|
f72137f53a | ||
|
|
96dbc324f3 | ||
|
|
d6e69649b6 |
@@ -7,6 +7,11 @@ 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:
|
||||
@@ -56,6 +61,11 @@ 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,6 +614,38 @@ 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
|
||||
@@ -797,7 +829,14 @@ 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()
|
||||
@@ -905,10 +944,7 @@ 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
|
||||
|
||||
@@ -40,6 +40,7 @@ public import Init.Grind
|
||||
public import Init.GrindInstances
|
||||
public import Init.Sym
|
||||
public import Init.While
|
||||
public import Init.Repeat
|
||||
public import Init.Syntax
|
||||
public import Init.Internal
|
||||
public import Init.Try
|
||||
|
||||
@@ -30,13 +30,13 @@ simpMatchDiscrsOnly (match 0 with | 0 => true | _ => false) = true
|
||||
```
|
||||
using `eq_self`.
|
||||
-/
|
||||
def simpMatchDiscrsOnly {α : Sort u} (a : α) : α := a
|
||||
@[expose] def simpMatchDiscrsOnly {α : Sort u} (a : α) : α := a
|
||||
|
||||
/--
|
||||
Gadget for protecting lambda abstractions created by `abstractGroundMismatches?`
|
||||
from beta reduction during preprocessing. See `ProveEq.lean` for details.
|
||||
-/
|
||||
def abstractFn {α : Sort u} (a : α) : α := a
|
||||
@[expose] def abstractFn {α : Sort u} (a : α) : α := a
|
||||
|
||||
/-- Gadget for representing offsets `t+k` in patterns. -/
|
||||
def offset (a b : Nat) : Nat := a + b
|
||||
|
||||
@@ -624,6 +624,23 @@ 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.
|
||||
|
||||
64
src/Init/Repeat.lean
Normal file
64
src/Init/Repeat.lean
Normal file
@@ -0,0 +1,64 @@
|
||||
/-
|
||||
Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sebastian Graf
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Init.Core
|
||||
public import Init.Control.MonadAttach
|
||||
public import Init.WFExtrinsicFix
|
||||
import Init.While
|
||||
|
||||
set_option linter.missingDocs true
|
||||
|
||||
@[expose] public section
|
||||
|
||||
namespace Lean
|
||||
|
||||
/-!
|
||||
# Well-founded `Repeat` type for verified `repeat`/`while` loops
|
||||
|
||||
This module provides a `Repeat` type that serves as an alternative to `Loop` for `repeat`/`while`
|
||||
loops. Unlike `Loop`, which uses `partial` recursion, `Repeat` is implemented using
|
||||
`WellFounded.extrinsicFix` and `MonadAttach`, enabling verified reasoning about loop programs.
|
||||
-/
|
||||
|
||||
/-- A type for `repeat`/`while` loops that supports well-founded reasoning via `extrinsicFix`. -/
|
||||
inductive Repeat where
|
||||
/-- Creates a `Repeat` value. -/
|
||||
| mk
|
||||
|
||||
/--
|
||||
The step relation for well-founded recursion in `Repeat.forIn`.
|
||||
Relates `b'` to `b` when `f () b` can plausibly return `ForInStep.yield b'`,
|
||||
as witnessed by `MonadAttach.CanReturn`.
|
||||
-/
|
||||
def Repeat.IsPlausibleStep {β : Type u} {m : Type u → Type v} [Monad m] [MonadAttach m]
|
||||
(f : Unit → β → m (ForInStep β)) : β → β → Prop :=
|
||||
fun b' b => MonadAttach.CanReturn (f () b) (ForInStep.yield b')
|
||||
|
||||
/-- Iterates the body `f` using well-founded recursion via `extrinsicFix`. -/
|
||||
@[inline]
|
||||
def Repeat.forIn {β : Type u} {m : Type u → Type v} [Monad m] [MonadAttach m]
|
||||
(_ : Repeat) (init : β) (f : Unit → β → m (ForInStep β)) : m β :=
|
||||
haveI : Nonempty β := ⟨init⟩
|
||||
WellFounded.extrinsicFix (Repeat.IsPlausibleStep f) (a := init) fun b recur => do
|
||||
match ← MonadAttach.attach (f () b) with
|
||||
| ⟨ForInStep.done b, _⟩ => pure b
|
||||
| ⟨ForInStep.yield b, h⟩ => recur b h
|
||||
|
||||
instance [Monad m] [MonadAttach m] : ForIn m Repeat Unit where
|
||||
forIn := Repeat.forIn
|
||||
|
||||
/-- Override the bootstrapping `repeat` macro from `Init.While` to use `Repeat.mk` instead of
|
||||
`Loop.mk`. When the builtin do-element elaborator for `repeat` is available (`backward.do.while`
|
||||
option dispatch), this macro defers to it by throwing `unsupportedSyntax`. -/
|
||||
macro_rules
|
||||
| `(doElem| repeat $seq) => do
|
||||
if ← Macro.hasDecl `Lean.Elab.Do.elabDoRepeat then
|
||||
Lean.Macro.throwUnsupported
|
||||
`(doElem| for _ in Repeat.mk do $seq)
|
||||
|
||||
end Lean
|
||||
@@ -32,8 +32,11 @@ partial def Loop.forIn {β : Type u} {m : Type u → Type v} [Monad m] (_ : Loop
|
||||
instance [Monad m] : ForIn m Loop Unit where
|
||||
forIn := Loop.forIn
|
||||
|
||||
syntax "repeat " doSeq : doElem
|
||||
syntax (name := doRepeat) "repeat " doSeq : doElem
|
||||
|
||||
/-- Bootstrapping fallback macro for `repeat`.
|
||||
Expands to `for _ in Loop.mk do ...`. Overridden by the macro in `Init.Repeat` after
|
||||
bootstrapping. -/
|
||||
macro_rules
|
||||
| `(doElem| repeat $seq) => `(doElem| for _ in Loop.mk do $seq)
|
||||
|
||||
|
||||
@@ -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 similiar argument to
|
||||
value is guaranteed to stay alive until at least the last `dec` anyway so a similar 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` occuring in the tail of `ds`.
|
||||
Return the updated `ds` and mask contianing the `FVarId`s whose `inc` was removed.
|
||||
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.
|
||||
-/
|
||||
partial def eraseProjIncFor (nFields : Nat) (targetId : FVarId) (ds : Array (CodeDecl .impure)) :
|
||||
CompilerM (Array (CodeDecl .impure) × Mask) := do
|
||||
|
||||
@@ -39,6 +39,7 @@ 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,6 +11,7 @@ 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
|
||||
@@ -88,6 +89,38 @@ 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)
|
||||
@@ -238,6 +271,23 @@ 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
|
||||
@@ -756,13 +806,16 @@ mutual
|
||||
let binderName := fType.bindingName!
|
||||
let binfo := fType.bindingInfo!
|
||||
let s ← get
|
||||
match findBinderName? s.namedArgs binderName with
|
||||
let namedArg? ← match findBinderName? s.namedArgs binderName with
|
||||
| some namedArg => pure (some namedArg)
|
||||
| none => findDeprecatedBinderName? s.namedArgs s.f binderName
|
||||
match namedArg? with
|
||||
| some namedArg =>
|
||||
propagateExpectedType namedArg.val
|
||||
eraseNamedArg binderName
|
||||
eraseNamedArg namedArg.name
|
||||
elabAndAddNewArg binderName namedArg.val
|
||||
main
|
||||
| none =>
|
||||
| none =>
|
||||
unless binderName.hasMacroScopes do
|
||||
pushFoundNamedArg binderName
|
||||
match binfo with
|
||||
|
||||
@@ -15,3 +15,4 @@ public import Lean.Elab.BuiltinDo.Jump
|
||||
public import Lean.Elab.BuiltinDo.Misc
|
||||
public import Lean.Elab.BuiltinDo.For
|
||||
public import Lean.Elab.BuiltinDo.TryCatch
|
||||
public import Lean.Elab.BuiltinDo.Repeat
|
||||
|
||||
@@ -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⟩):hole : $cond then $then_ else $else_)) mγ
|
||||
| `(_%$tk) => Term.elabTermEnsuringType (← `(if _%$tk : $cond then $then_ else $else_)) mγ
|
||||
| `($h:ident) => Term.elabTermEnsuringType (← `(if $h:ident : $cond then $then_ else $else_)) mγ
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
37
src/Lean/Elab/BuiltinDo/Repeat.lean
Normal file
37
src/Lean/Elab/BuiltinDo/Repeat.lean
Normal file
@@ -0,0 +1,37 @@
|
||||
/-
|
||||
Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sebastian Graf
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Lean.Elab.BuiltinDo.Basic
|
||||
meta import Lean.Parser.Do
|
||||
import Lean.Elab.BuiltinDo.For
|
||||
import Lean.Elab.Do.Switch
|
||||
|
||||
public section
|
||||
|
||||
namespace Lean.Elab.Do
|
||||
|
||||
open Lean.Parser.Term
|
||||
|
||||
/--
|
||||
Builtin do-element elaborator for `repeat` (syntax kind `Lean.doRepeat`).
|
||||
|
||||
When `backward.do.while` is `true`, expands to `for _ in Loop.mk do ...` (legacy behavior).
|
||||
When `backward.do.while` is `false` (default), expands to `for _ in Repeat.mk do ...`
|
||||
(well-founded behavior).
|
||||
-/
|
||||
@[builtin_doElem_elab Lean.doRepeat] def elabDoRepeat : DoElab := fun stx dec => do
|
||||
let `(doElem| repeat $seq) := stx | throwUnsupportedSyntax
|
||||
let expanded ←
|
||||
if Term.backward.do.while.get (← getOptions) then
|
||||
`(doElem| for _ in Loop.mk do $seq)
|
||||
else
|
||||
`(doElem| for _ in Repeat.mk do $seq)
|
||||
Term.withMacroExpansion stx expanded <|
|
||||
withRef expanded <| elabDoElem ⟨expanded⟩ dec
|
||||
|
||||
end Lean.Elab.Do
|
||||
@@ -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 auxillary piece of
|
||||
we do not set the syntax references to track those declarations (as this is auxiliary 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 occurence of the coinductive predicate
|
||||
We intro all the indices and the occurrence 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 occurence of the coinductive predicate.
|
||||
The next argument is the occurrence 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 paramaters, as well as recursive calls
|
||||
form of the associated flat inductives and applying parameters, as well as recursive calls
|
||||
(with their parameters passed).
|
||||
-/
|
||||
let preDefVals ← forallBoundedTelescope infos[0]!.type originalNumParams fun params _ => do
|
||||
|
||||
97
src/Lean/Elab/DeprecatedArg.lean
Normal file
97
src/Lean/Elab/DeprecatedArg.lean
Normal file
@@ -0,0 +1,97 @@
|
||||
/-
|
||||
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
|
||||
@@ -1780,6 +1780,10 @@ mutual
|
||||
doIfToCode doElem doElems
|
||||
else if k == ``Parser.Term.doUnless then
|
||||
doUnlessToCode doElem doElems
|
||||
else if k == `Lean.doRepeat then
|
||||
let seq := doElem[1]
|
||||
let expanded ← `(doElem| for _ in Loop.mk do $seq)
|
||||
doSeqToCode (expanded :: doElems)
|
||||
else if k == ``Parser.Term.doFor then withFreshMacroScope do
|
||||
doForToCode doElem doElems
|
||||
else if k == ``Parser.Term.doMatch then
|
||||
|
||||
@@ -19,6 +19,11 @@ register_builtin_option backward.do.legacy : Bool := {
|
||||
descr := "Use the legacy `do` elaborator instead of the new, extensible implementation."
|
||||
}
|
||||
|
||||
register_builtin_option backward.do.while : Bool := {
|
||||
defValue := false
|
||||
descr := "Use the legacy partial `Loop` type for `repeat`/`while` loops instead of the well-founded `Repeat` type. Useful as a workaround when the monad lacks a `MonadAttach` instance."
|
||||
}
|
||||
|
||||
private def toDoElem (newKind : SyntaxNodeKind) : Macro := fun stx => do
|
||||
let stx := stx.setKind newKind
|
||||
withRef stx `(do $(⟨stx⟩):doElem)
|
||||
|
||||
@@ -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 occuring in `e` (once each), skipping instance arguments and proofs. -/
|
||||
/-- Collect the constants occurring 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 occuring in `e` (once each), skipping instance arguments and proofs. -/
|
||||
/-- Collect the constants occurring 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
|
||||
|
||||
@@ -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}\nsythesized value{indentExpr val}\nis not definitionally equal to{indentExpr x}"
|
||||
trace[Meta.Tactic.simp.discharge] "{← ppOrigin thmId}, failed to assign instance{indentExpr type}\nsynthesized 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 precendence -/
|
||||
/-- In case of overlap, higher-priority tokens will take precedence -/
|
||||
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 precendence -/
|
||||
/-- In case of overlap, higher-priority tokens will take precedence -/
|
||||
priority : Nat := 5
|
||||
deriving BEq, Hashable, FromJson, ToJson
|
||||
|
||||
|
||||
@@ -7,6 +7,7 @@ module
|
||||
|
||||
prelude
|
||||
public import Std.Do.SPred.Notation
|
||||
import Init.PropLemmas
|
||||
|
||||
@[expose] public section
|
||||
|
||||
@@ -157,3 +158,17 @@ theorem imp_curry {P Q : SVal.StateTuple σs → Prop} : (SVal.curry (fun t =>
|
||||
induction σs
|
||||
case nil => rfl
|
||||
case cons σ σs ih => intro s; simp only [imp_cons, SVal.curry_cons]; exact ih
|
||||
|
||||
/-! # Prop-indexed quantifiers -/
|
||||
|
||||
/-- Simplifies an existential over a true proposition. -/
|
||||
theorem exists_prop_of_true {p : Prop} (h : p) {P : p → SPred σs} : spred(∃ (h : p), P h) = P h := by
|
||||
induction σs with
|
||||
| nil => ext; exact _root_.exists_prop_of_true h
|
||||
| cons σ σs ih => ext; exact ih
|
||||
|
||||
/-- Simplifies a universal over a true proposition. -/
|
||||
theorem forall_prop_of_true {p : Prop} (h : p) {P : p → SPred σs} : spred(∀ (h : p), P h) = P h := by
|
||||
induction σs with
|
||||
| nil => ext; exact _root_.forall_prop_of_true h
|
||||
| cons σ σs ih => ext; exact ih
|
||||
|
||||
64
src/Std/Do/Triple/RepeatSpec.lean
Normal file
64
src/Std/Do/Triple/RepeatSpec.lean
Normal file
@@ -0,0 +1,64 @@
|
||||
/-
|
||||
Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sebastian Graf
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Std.Do.Triple.SpecLemmas
|
||||
import Std.Tactic.Do.Syntax
|
||||
|
||||
set_option linter.missingDocs true
|
||||
|
||||
@[expose] public section
|
||||
|
||||
namespace Std.Do
|
||||
|
||||
/-!
|
||||
# Specification theorem for `Repeat` loops
|
||||
|
||||
This file contains the `@[spec]` theorem for `forIn` over `Lean.Repeat`, which enables
|
||||
verified reasoning about `repeat`/`while` loops using `mvcgen`.
|
||||
-/
|
||||
|
||||
set_option mvcgen.warning false
|
||||
|
||||
section
|
||||
|
||||
variable {β : Type u} {m : Type u → Type v} {ps : PostShape.{u}}
|
||||
variable [Monad m] [MonadAttach m] [WeaklyLawfulMonadAttach m] [WPMonad m ps]
|
||||
|
||||
/--
|
||||
Specification for `forIn` over a `Lean.Repeat` value.
|
||||
Takes a variant (termination measure), an invariant, a proof that the variant decreases,
|
||||
and a proof that each step preserves the invariant.
|
||||
-/
|
||||
@[spec]
|
||||
theorem Spec.forIn_repeat
|
||||
{l : _root_.Lean.Repeat} {init : β} {f : Unit → β → m (ForInStep β)}
|
||||
(_variant : RepeatVariant β)
|
||||
(inv : RepeatInvariant β ps)
|
||||
(hwf : WellFounded (_root_.Lean.Repeat.IsPlausibleStep f))
|
||||
(step : ∀ b,
|
||||
Triple
|
||||
(f () b)
|
||||
(inv.1 (.repeat b))
|
||||
(fun r => match r with
|
||||
| .yield b' => inv.1 (.repeat b')
|
||||
| .done b' => inv.1 (.done b'), inv.2)) :
|
||||
Triple (forIn l init f) (inv.1 (.repeat init)) (fun b => inv.1 (.done b), inv.2) := by
|
||||
change Triple (_root_.Lean.Repeat.forIn l init f) _ _
|
||||
simp only [_root_.Lean.Repeat.forIn, WellFounded.extrinsicFix_eq_fix hwf]
|
||||
induction hwf.apply init with
|
||||
| intro b hacc ih =>
|
||||
rw [WellFounded.fix_eq]
|
||||
mvcgen [step, ih]
|
||||
rename_i stp
|
||||
apply SPred.forall_intro
|
||||
intro _
|
||||
cases stp <;> mvcgen [ih]
|
||||
|
||||
end
|
||||
|
||||
end Std.Do
|
||||
@@ -10,6 +10,8 @@ public import Std.Do.Triple.Basic
|
||||
public import Init.Data.Range.Polymorphic.Iterators
|
||||
import Init.Data.Range.Polymorphic
|
||||
public import Init.Data.Slice.Array
|
||||
public import Std.Do.WP.Adequacy
|
||||
public import Init.Repeat
|
||||
|
||||
-- This public import is a workaround for #10652.
|
||||
-- Without it, adding the `spec` attribute for `instMonadLiftTOfMonadLift` will fail.
|
||||
@@ -2188,3 +2190,90 @@ theorem Spec.forIn_stringSlice
|
||||
next => apply Triple.pure; simp
|
||||
next b => simp [ih _ _ hsp.next]
|
||||
| endPos => simpa using Triple.pure _ (by simp)
|
||||
|
||||
/-!
|
||||
# Repeat loop specification infrastructure
|
||||
-/
|
||||
|
||||
/--
|
||||
Cursor type for `Repeat` loop invariants.
|
||||
Represents either a loop iteration in progress or a completed loop.
|
||||
-/
|
||||
inductive RepeatCursor (β : Type u) where
|
||||
/-- The loop is in progress with the current accumulator state `s`. -/
|
||||
| «repeat» (s : β) : RepeatCursor β
|
||||
/-- The loop has finished with the final accumulator state `s`. -/
|
||||
| done (s : β) : RepeatCursor β
|
||||
|
||||
/--
|
||||
An invariant for a `Repeat` loop. A postcondition over `RepeatCursor β` capturing both
|
||||
the in-progress and completed states.
|
||||
-/
|
||||
@[spec_invariant_type]
|
||||
abbrev RepeatInvariant (β : Type u) (ps : PostShape.{u}) := PostCond (RepeatCursor β) ps
|
||||
|
||||
/--
|
||||
A variant (termination measure) for a `Repeat` loop.
|
||||
Maps the accumulator state to a natural number that decreases with each iteration.
|
||||
-/
|
||||
@[spec_invariant_type]
|
||||
abbrev RepeatVariant (β : Type u) := β → Nat
|
||||
|
||||
section
|
||||
|
||||
variable {α : Type u₁} {m : Type u₁ → Type v} {ps : PostShape.{u₁}}
|
||||
variable [Monad m] [MonadAttach m] [WeaklyLawfulMonadAttach m] [WPMonad m ps]
|
||||
|
||||
/--
|
||||
Specification for `MonadAttach.attach`: the precondition is the weakest precondition of `x` with
|
||||
a postcondition that universally quantifies over the `CanReturn` proof.
|
||||
-/
|
||||
@[spec]
|
||||
theorem Spec.attach
|
||||
{x : m α} {Q : PostCond (Subtype (MonadAttach.CanReturn x)) ps} :
|
||||
⦃ wp⟦x⟧ ⟨fun a => spred(∀ (h : MonadAttach.CanReturn x a), Q.1 ⟨a, h⟩), Q.2⟩ ⦄ MonadAttach.attach x ⦃Q⦄ := by
|
||||
apply Triple.iff.mpr
|
||||
conv in wp x => rw [← WeaklyLawfulMonadAttach.map_attach (x := x)]
|
||||
simp only [WPMonad.wp_map]
|
||||
-- Goal: (Subtype.val <$> wp (attach x)).apply ⟨..., Q.2⟩ ⊢ₛ (wp (attach x)).apply Q
|
||||
-- Rewrite LHS using apply_Functor_map
|
||||
rw [PredTrans.apply_Functor_map]
|
||||
-- Now both sides have (wp (attach x)).apply, use mono
|
||||
apply (wp (MonadAttach.attach x)).mono
|
||||
constructor
|
||||
· intro ⟨a, h⟩
|
||||
dsimp only []
|
||||
rw [SPred.forall_prop_of_true h]
|
||||
· dsimp only []
|
||||
exact ExceptConds.entails.refl _
|
||||
|
||||
end
|
||||
|
||||
section
|
||||
|
||||
variable {β : Type u₁} {m : Type u₁ → Type v} {ps : PostShape.{u₁}}
|
||||
variable [Monad m] [MonadAttach m] [WPAdequacy m ps]
|
||||
|
||||
/--
|
||||
Derives well-foundedness of `_root_.Lean.Repeat.IsPlausibleStep f` from a WP proof that every
|
||||
step decreases a measure.
|
||||
-/
|
||||
theorem _root_.Lean.Repeat.IsPlausibleStep.wf_of_wp_measure {f : Unit → β → m (ForInStep β)}
|
||||
(measure : β → Nat)
|
||||
(h : ∀ b, ⦃⌜True⌝⦄ f () b ⦃⇓ step => ⌜∀ b', step = .yield b' → measure b' < measure b⌝⦄)
|
||||
: WellFounded (_root_.Lean.Repeat.IsPlausibleStep f) := by
|
||||
apply Subrelation.wf ?_ (_root_.measure measure).wf
|
||||
intro b' b hstep
|
||||
simp_wf
|
||||
simp [_root_.Lean.Repeat.IsPlausibleStep] at hstep
|
||||
have h' : ⊢ₛ wp⟦f () b⟧ (⇓? step => ⌜∀ b', step = .yield b' → measure b' < measure b⌝) := by
|
||||
apply SPred.entails.trans (Triple.iff.mp (h b))
|
||||
apply (wp (f () b)).mono
|
||||
simp [PostCond.entails]
|
||||
exact WPAdequacy.adequate
|
||||
(m := m) (ps := ps) (x := f () b)
|
||||
(P := fun step => ∀ b', step = .yield b' → measure b' < measure b)
|
||||
h' (.yield b') hstep b' rfl
|
||||
|
||||
end
|
||||
|
||||
|
||||
@@ -9,5 +9,6 @@ prelude
|
||||
public import Std.Do.WP.Basic
|
||||
public import Std.Do.WP.Monad
|
||||
public import Std.Do.WP.SimpLemmas
|
||||
public import Std.Do.WP.Adequacy
|
||||
|
||||
set_option linter.missingDocs true
|
||||
|
||||
85
src/Std/Do/WP/Adequacy.lean
Normal file
85
src/Std/Do/WP/Adequacy.lean
Normal file
@@ -0,0 +1,85 @@
|
||||
/-
|
||||
Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sebastian Graf
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Std.Do.WP.Monad
|
||||
import Init.Control.MonadAttach
|
||||
|
||||
@[expose] public section
|
||||
|
||||
set_option linter.missingDocs true
|
||||
|
||||
/-!
|
||||
# WP Adequacy
|
||||
|
||||
This module provides a small adequacy principle: a `mayThrow` postcondition is enough to recover
|
||||
facts about values that `MonadAttach` says can actually be returned.
|
||||
-/
|
||||
|
||||
namespace Std.Do
|
||||
|
||||
/-- A small adequacy principle: a `mayThrow` postcondition is enough to recover facts about
|
||||
values that `MonadAttach` says can actually be returned. -/
|
||||
class WPAdequacy (m : Type u → Type v) (ps : outParam PostShape.{u}) [Monad m] [MonadAttach m]
|
||||
extends WP m ps where
|
||||
/-- If the weakest precondition says that `P` holds for all return values, then `P` holds for
|
||||
any value that `MonadAttach.CanReturn` says can be returned. -/
|
||||
adequate {α : Type u} {x : m α} {P : α → Prop} :
|
||||
(⊢ₛ wp⟦x⟧ (⇓? a => ⌜P a⌝)) → ∀ a, MonadAttach.CanReturn x a → P a
|
||||
|
||||
instance : WPAdequacy Id .pure where
|
||||
adequate := by
|
||||
intro α x P hwp a hret
|
||||
have hx : P x.run := by
|
||||
simpa [WP.wp] using hwp
|
||||
simpa [MonadAttach.CanReturn] using (hret ▸ hx)
|
||||
|
||||
instance [Monad m] [MonadAttach m] [WPAdequacy m ps] :
|
||||
WPAdequacy (StateT σ m) (.arg σ ps) where
|
||||
adequate := by
|
||||
intro α x P hwp a hret
|
||||
rcases hret with ⟨s, s', hret⟩
|
||||
have hwp' : ⊢ₛ wp⟦x.run s⟧ (⇓? r => ⌜P r.1⌝) := hwp s
|
||||
exact WPAdequacy.adequate (m := m) (ps := ps) (x := x.run s) (P := fun r => P r.1) hwp' (a, s') hret
|
||||
|
||||
instance [Monad m] [MonadAttach m] [WPAdequacy m ps] :
|
||||
WPAdequacy (ReaderT ρ m) (.arg ρ ps) where
|
||||
adequate := by
|
||||
intro α x P hwp a hret
|
||||
rcases hret with ⟨r, hret⟩
|
||||
have hwp' : ⊢ₛ wp⟦x.run r⟧ (⇓? a => ⌜P a⌝) := hwp r
|
||||
exact WPAdequacy.adequate (m := m) (ps := ps) (x := x.run r) (P := P) hwp' a hret
|
||||
|
||||
instance [Monad m] [MonadAttach m] [WPAdequacy m .pure] :
|
||||
WPAdequacy (ExceptT ε m) (.except ε .pure) where
|
||||
adequate := by
|
||||
intro α x P hwp a hret
|
||||
have hwp0 := hwp
|
||||
simp only [WP.wp, PredTrans.apply_pushExcept, ExceptConds.fst_true, ExceptConds.snd_true] at hwp0
|
||||
have hwp' : ⊢ₛ wp⟦x.run⟧ (⇓? r => ⌜match r with | .ok a => P a | .error _ => True⌝) := by
|
||||
apply SPred.entails.trans hwp0
|
||||
apply (wp x.run).mono
|
||||
simp [PostCond.entails]
|
||||
intro r <;> cases r <;> simp
|
||||
exact WPAdequacy.adequate (m := m) (ps := .pure) (x := x.run)
|
||||
(P := fun r => match r with | .ok a => P a | .error _ => True) hwp' (.ok a) hret
|
||||
|
||||
instance [Monad m] [MonadAttach m] [WPAdequacy m .pure] :
|
||||
WPAdequacy (OptionT m) (.except PUnit .pure) where
|
||||
adequate := by
|
||||
intro α x P hwp a hret
|
||||
have hwp0 := hwp
|
||||
simp only [WP.wp, PredTrans.apply_pushOption, ExceptConds.fst_true, ExceptConds.snd_true] at hwp0
|
||||
have hwp' : ⊢ₛ wp⟦x.run⟧ (⇓? r => ⌜match r with | some a => P a | none => True⌝) := by
|
||||
apply SPred.entails.trans hwp0
|
||||
apply (wp x.run).mono
|
||||
simp [PostCond.entails]
|
||||
intro r <;> cases r <;> simp
|
||||
exact WPAdequacy.adequate (m := m) (ps := .pure) (x := x.run)
|
||||
(P := fun r => match r with | some a => P a | none => True) hwp' (some a) hret
|
||||
|
||||
end Std.Do
|
||||
@@ -487,6 +487,8 @@ instance : Monad BaseAsync where
|
||||
pure := BaseAsync.pure
|
||||
bind := BaseAsync.bind
|
||||
|
||||
instance : MonadAttach BaseAsync := .trivial
|
||||
|
||||
instance : MonadLift BaseIO BaseAsync where
|
||||
monadLift := BaseAsync.lift
|
||||
|
||||
@@ -707,6 +709,8 @@ instance : Monad (EAsync ε) where
|
||||
pure := EAsync.pure
|
||||
bind := EAsync.bind
|
||||
|
||||
instance : MonadAttach (EAsync ε) := .trivial
|
||||
|
||||
instance : MonadLift (EIO ε) (EAsync ε) where
|
||||
monadLift := EAsync.lift
|
||||
|
||||
|
||||
@@ -14,6 +14,7 @@ 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
|
||||
|
||||
24
src/Std/Internal/Http/Data/Body.lean
Normal file
24
src/Std/Internal/Http/Data/Body.lean
Normal file
@@ -0,0 +1,24 @@
|
||||
/-
|
||||
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`).
|
||||
-/
|
||||
83
src/Std/Internal/Http/Data/Body/Any.lean
Normal file
83
src/Std/Internal/Http/Data/Body/Any.lean
Normal file
@@ -0,0 +1,83 @@
|
||||
/-
|
||||
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
|
||||
102
src/Std/Internal/Http/Data/Body/Basic.lean
Normal file
102
src/Std/Internal/Http/Data/Body/Basic.lean
Normal file
@@ -0,0 +1,102 @@
|
||||
/-
|
||||
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
|
||||
116
src/Std/Internal/Http/Data/Body/Empty.lean
Normal file
116
src/Std/Internal/Http/Data/Body/Empty.lean
Normal file
@@ -0,0 +1,116 @@
|
||||
/-
|
||||
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
|
||||
232
src/Std/Internal/Http/Data/Body/Full.lean
Normal file
232
src/Std/Internal/Http/Data/Body/Full.lean
Normal file
@@ -0,0 +1,232 @@
|
||||
/-
|
||||
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
|
||||
60
src/Std/Internal/Http/Data/Body/Length.lean
Normal file
60
src/Std/Internal/Http/Data/Body/Length.lean
Normal file
@@ -0,0 +1,60 @@
|
||||
/-
|
||||
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
|
||||
650
src/Std/Internal/Http/Data/Body/Stream.lean
Normal file
650
src/Std/Internal/Http/Data/Body/Stream.lean
Normal file
@@ -0,0 +1,650 @@
|
||||
/-
|
||||
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,12 +124,6 @@ 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 empty : Builder := { }
|
||||
def new : 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 :=
|
||||
.empty |>.status .ok
|
||||
.new |>.status .ok
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the provided status.
|
||||
-/
|
||||
def withStatus (status : Status) : Builder :=
|
||||
.empty |>.status status
|
||||
.new |>.status status
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 404 status code.
|
||||
-/
|
||||
def notFound : Builder :=
|
||||
.empty |>.status .notFound
|
||||
.new |>.status .notFound
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 500 status code.
|
||||
-/
|
||||
def internalServerError : Builder :=
|
||||
.empty |>.status .internalServerError
|
||||
.new |>.status .internalServerError
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 400 status code.
|
||||
-/
|
||||
def badRequest : Builder :=
|
||||
.empty |>.status .badRequest
|
||||
.new |>.status .badRequest
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 201 status code.
|
||||
-/
|
||||
def created : Builder :=
|
||||
.empty |>.status .created
|
||||
.new |>.status .created
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 202 status code.
|
||||
-/
|
||||
def accepted : Builder :=
|
||||
.empty |>.status .accepted
|
||||
.new |>.status .accepted
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 401 status code.
|
||||
-/
|
||||
def unauthorized : Builder :=
|
||||
.empty |>.status .unauthorized
|
||||
.new |>.status .unauthorized
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 403 status code.
|
||||
-/
|
||||
def forbidden : Builder :=
|
||||
.empty |>.status .forbidden
|
||||
.new |>.status .forbidden
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 409 status code.
|
||||
-/
|
||||
def conflict : Builder :=
|
||||
.empty |>.status .conflict
|
||||
.new |>.status .conflict
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 503 status code.
|
||||
-/
|
||||
def serviceUnavailable : Builder :=
|
||||
.empty |>.status .serviceUnavailable
|
||||
.new |>.status .serviceUnavailable
|
||||
|
||||
end Response
|
||||
|
||||
@@ -94,4 +94,3 @@ def parseOrRoot (s : String) : Std.Http.URI.Path :=
|
||||
parse? s |>.getD { segments := #[], absolute := true }
|
||||
|
||||
end Std.Http.URI.Path
|
||||
|
||||
|
||||
@@ -8,6 +8,7 @@ module
|
||||
prelude
|
||||
public import Std.Tactic.Do.ProofMode
|
||||
public import Std.Tactic.Do.Syntax
|
||||
public import Std.Do.Triple.RepeatSpec
|
||||
|
||||
@[expose] public section
|
||||
|
||||
|
||||
@@ -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 specifed via the `--service` option.
|
||||
service. The cache service used can be specified 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 via be specified via `--service` option. If not specifed, Lake will used
|
||||
used can be specified via the `--service` option. If not specified, Lake will use
|
||||
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 enviroment variables)"
|
||||
via the Lake system configuration (not environment variables)"
|
||||
return .downloadService artifactEndpoint revisionEndpoint ws.lakeEnv.cacheService?
|
||||
| none, none =>
|
||||
return ws.defaultCacheService
|
||||
|
||||
@@ -765,12 +765,13 @@ where
|
||||
\n remote URL: {info.url}"
|
||||
match cfg.kind with
|
||||
| .get =>
|
||||
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}"
|
||||
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}"
|
||||
removeFileIfExists info.path
|
||||
| .put =>
|
||||
if let .ok size := out.getAs Nat "size_download" then
|
||||
@@ -787,7 +788,7 @@ private def transferArtifacts
|
||||
match cfg.kind with
|
||||
| .get =>
|
||||
cfg.infos.forM fun info => do
|
||||
h.putStrLn s!"url = {info.url}"
|
||||
h.putStrLn s!"url = {info.url.quote}"
|
||||
h.putStrLn s!"-o {info.path.toString.quote}"
|
||||
h.flush
|
||||
return #[
|
||||
@@ -798,7 +799,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}"
|
||||
h.putStrLn s!"url = {info.url.quote}"
|
||||
h.flush
|
||||
return #[
|
||||
"-Z", "-X", "PUT", "-L",
|
||||
@@ -827,6 +828,13 @@ 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)
|
||||
@@ -844,8 +852,68 @@ 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,24 +103,6 @@ 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,8 +6,9 @@ Authors: Mac Malone
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Init.Prelude
|
||||
import Init.Data.Array.Basic
|
||||
public import Lake.Util.JsonObject
|
||||
|
||||
open Lean
|
||||
|
||||
namespace Lake
|
||||
|
||||
@@ -15,3 +16,23 @@ 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?⟩
|
||||
|
||||
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
Normal file
BIN
stage0/stdlib/Std/Internal/Http/Data/Body.c
generated
Normal file
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Any.c
generated
Normal file
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Any.c
generated
Normal file
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Basic.c
generated
Normal file
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Basic.c
generated
Normal file
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Empty.c
generated
Normal file
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Empty.c
generated
Normal file
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Full.c
generated
Normal file
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Full.c
generated
Normal file
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Length.c
generated
Normal file
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Length.c
generated
Normal file
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Stream.c
generated
Normal file
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Stream.c
generated
Normal file
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,6 +6,7 @@ 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,11 +876,10 @@ 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 := Std.Queue.empty.enqueue goal
|
||||
let mut worklist := #[goal]
|
||||
repeat do
|
||||
let some (goal, worklist') := worklist.dequeue? | break
|
||||
let mut goal := goal
|
||||
worklist := worklist'
|
||||
let mut some goal := worklist.back? | break
|
||||
worklist := worklist.pop
|
||||
let res ← solve goal.mvarId
|
||||
match res with
|
||||
| .noEntailment .. | .noProgramFoundInTarget .. =>
|
||||
@@ -896,7 +895,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.enqueueAll (subgoals.map ({ goal with mvarId := · }))
|
||||
worklist := worklist ++ (subgoals |>.map ({ goal with mvarId := · }) |>.reverse)
|
||||
|
||||
public structure Result where
|
||||
invariants : Array MVarId
|
||||
|
||||
@@ -15,5 +15,7 @@ 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.
|
||||
#eval runBenchUsingTactic ``GetThrowSetGrind.Goal [``loop, ``step] `(tactic| mvcgen' with grind) `(tactic| fail)
|
||||
-- `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)
|
||||
[50, 100, 150]
|
||||
|
||||
725
tests/elab/async_http_body.lean
Normal file
725
tests/elab/async_http_body.lean
Normal file
@@ -0,0 +1,725 @@
|
||||
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
|
||||
330
tests/elab/deprecated_arg.lean
Normal file
330
tests/elab/deprecated_arg.lean
Normal file
@@ -0,0 +1,330 @@
|
||||
/-
|
||||
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)
|
||||
14
tests/elab/doDepIfAnon.lean
Normal file
14
tests/elab/doDepIfAnon.lean
Normal file
@@ -0,0 +1,14 @@
|
||||
-- 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"
|
||||
6
tests/elab/grind_13167.lean
Normal file
6
tests/elab/grind_13167.lean
Normal file
@@ -0,0 +1,6 @@
|
||||
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]
|
||||
89
tests/elab/repeat_extrinsic.lean
Normal file
89
tests/elab/repeat_extrinsic.lean
Normal file
@@ -0,0 +1,89 @@
|
||||
module
|
||||
|
||||
import Std
|
||||
|
||||
set_option mvcgen.warning false
|
||||
|
||||
open Std.Do
|
||||
|
||||
/-!
|
||||
# Tests for extrinsic `repeat`/`while` loops
|
||||
|
||||
These tests verify that the new `Repeat` type and its verification infrastructure work correctly.
|
||||
-/
|
||||
|
||||
/-- `sqrt n` computes the integer square root of `n` using a `while` loop. -/
|
||||
def sqrt (n : Nat) : Id Nat := do
|
||||
if n = 0 then
|
||||
return 0
|
||||
let mut i := 0
|
||||
while i * i ≤ n
|
||||
do
|
||||
i := i + 1
|
||||
return i - 1
|
||||
|
||||
/-- The `sqrt` function returns the correct integer square root. -/
|
||||
theorem sqrt_correct :
|
||||
⦃⌜True⌝⦄ sqrt n ⦃⇓ res => ⌜res * res ≤ n ∧ n < (res + 1) * (res+1)⌝⦄ := by
|
||||
mvcgen [sqrt]
|
||||
invariants
|
||||
| inv1 => fun i => (n + 2) - i
|
||||
| inv2 => ⇓ cursor => match cursor with
|
||||
| .repeat i => ⌜∀ j, j < i → j * j ≤ n⌝
|
||||
| .done i => ⌜(∀ j, j < i → j * j ≤ n) ∧ n < i * i⌝
|
||||
with (try grind)
|
||||
| vc2 =>
|
||||
apply Lean.Repeat.IsPlausibleStep.wf_of_wp_measure (fun i => (n + 2) - i)
|
||||
intro r
|
||||
mvcgen with try grind
|
||||
| vc1 hsqr =>
|
||||
have : r ≤ n := Nat.le_trans (Nat.le_mul_self r) hsqr
|
||||
grind
|
||||
| vc3 =>
|
||||
rename_i b hsqr _ hinv
|
||||
intro j hj
|
||||
rcases Nat.lt_or_eq_of_le (Nat.lt_succ_iff.mp hj) with hlt | rfl
|
||||
· exact hinv j hlt
|
||||
· exact hsqr
|
||||
| vc6 res h =>
|
||||
have : res - 1 < res := by grind
|
||||
grind
|
||||
|
||||
set_option backward.do.while true in
|
||||
/-- Test: `backward.do.while true` should expand to `Loop.mk`. -/
|
||||
def loopBackwardCompat (n : Nat) : Nat := Id.run do
|
||||
let mut i := 0
|
||||
repeat
|
||||
if i < n then
|
||||
i := i + 1
|
||||
else
|
||||
break
|
||||
return i
|
||||
|
||||
-- Verify the backward-compat loop computes correctly
|
||||
#guard loopBackwardCompat 5 == 5
|
||||
#guard loopBackwardCompat 0 == 0
|
||||
|
||||
/-- Test: default setting should expand to `Repeat.mk`. -/
|
||||
def loopDefault (n : Nat) : Nat := Id.run do
|
||||
let mut i := 0
|
||||
repeat
|
||||
if i < n then
|
||||
i := i + 1
|
||||
else
|
||||
break
|
||||
return i
|
||||
|
||||
-- Verify the default loop computes correctly
|
||||
#guard loopDefault 5 == 5
|
||||
#guard loopDefault 0 == 0
|
||||
|
||||
-- Verify sqrt computes correctly
|
||||
#guard Id.run (sqrt 0) == 0
|
||||
#guard Id.run (sqrt 1) == 1
|
||||
#guard Id.run (sqrt 4) == 2
|
||||
#guard Id.run (sqrt 8) == 2
|
||||
#guard Id.run (sqrt 9) == 3
|
||||
#guard Id.run (sqrt 15) == 3
|
||||
#guard Id.run (sqrt 16) == 4
|
||||
#guard Id.run (sqrt 100) == 10
|
||||
1
tests/pkg/deprecated_arg/DeprecatedArg.lean
Normal file
1
tests/pkg/deprecated_arg/DeprecatedArg.lean
Normal file
@@ -0,0 +1 @@
|
||||
import DeprecatedArg.Use
|
||||
5
tests/pkg/deprecated_arg/DeprecatedArg/Def.lean
Normal file
5
tests/pkg/deprecated_arg/DeprecatedArg/Def.lean
Normal file
@@ -0,0 +1,5 @@
|
||||
@[deprecated_arg arg foo (since := "2026-03-18")]
|
||||
def f (foo : Nat) : Nat := foo + 1
|
||||
|
||||
@[deprecated_arg old1 new1 (since := "2026-03-18"), deprecated_arg old2 new2 (since := "2026-03-18")]
|
||||
def g (new1 new2 : Nat) : Nat := new1 + new2
|
||||
55
tests/pkg/deprecated_arg/DeprecatedArg/Use.lean
Normal file
55
tests/pkg/deprecated_arg/DeprecatedArg/Use.lean
Normal file
@@ -0,0 +1,55 @@
|
||||
import DeprecatedArg.Def
|
||||
|
||||
-- Cross-file: old name produces warning
|
||||
/--
|
||||
warning: parameter `arg` of `f` has been deprecated, use `foo` instead
|
||||
|
||||
Hint: Rename this argument:
|
||||
a̵r̵g̵f̲o̲o̲
|
||||
---
|
||||
info: f 42 : Nat
|
||||
-/
|
||||
#guard_msgs in
|
||||
#check f (arg := 42)
|
||||
|
||||
-- Cross-file: new name produces no warning
|
||||
/--
|
||||
info: f 42 : Nat
|
||||
-/
|
||||
#guard_msgs in
|
||||
#check f (foo := 42)
|
||||
|
||||
-- Cross-file: positional arg produces no warning
|
||||
/--
|
||||
info: f 42 : Nat
|
||||
-/
|
||||
#guard_msgs in
|
||||
#check f 42
|
||||
|
||||
-- Cross-file: multiple renames
|
||||
/--
|
||||
warning: parameter `old1` of `g` has been deprecated, use `new1` instead
|
||||
|
||||
Hint: Rename this argument:
|
||||
o̵l̵d̵n̲e̲w̲1
|
||||
---
|
||||
warning: parameter `old2` of `g` has been deprecated, use `new2` instead
|
||||
|
||||
Hint: Rename this argument:
|
||||
o̵l̵d̵n̲e̲w̲2
|
||||
---
|
||||
info: g 1 2 : Nat
|
||||
-/
|
||||
#guard_msgs in
|
||||
#check g (old1 := 1) (old2 := 2)
|
||||
|
||||
-- Cross-file: disabling the linter rejects old names with a clean error
|
||||
/--
|
||||
error: Invalid argument name `arg` for function `f`
|
||||
|
||||
Hint: Perhaps you meant one of the following parameter names:
|
||||
• `foo`: a̵r̵g̵f̲o̲o̲
|
||||
-/
|
||||
#guard_msgs in
|
||||
set_option linter.deprecated.arg false in
|
||||
#check f (arg := 42)
|
||||
5
tests/pkg/deprecated_arg/lakefile.lean
Normal file
5
tests/pkg/deprecated_arg/lakefile.lean
Normal file
@@ -0,0 +1,5 @@
|
||||
import Lake
|
||||
open Lake DSL
|
||||
|
||||
package deprecated_arg
|
||||
@[default_target] lean_lib DeprecatedArg
|
||||
1
tests/pkg/deprecated_arg/lean-toolchain
Normal file
1
tests/pkg/deprecated_arg/lean-toolchain
Normal file
@@ -0,0 +1 @@
|
||||
../../../build/release/stage1
|
||||
2
tests/pkg/deprecated_arg/run_test.sh
Normal file
2
tests/pkg/deprecated_arg/run_test.sh
Normal file
@@ -0,0 +1,2 @@
|
||||
rm -rf .lake/build
|
||||
lake build
|
||||
@@ -1 +1,6 @@
|
||||
rm -rf work
|
||||
|
||||
# previous clean.sh, without it we would be copying old .git dirs and get a test failure
|
||||
rm -rf DiamondExample-*/.git
|
||||
rm -rf DiamondExample-*/.lake DiamondExample-*/lake-manifest.json
|
||||
rm -f DiamondExample-D/produced.out
|
||||
|
||||
Reference in New Issue
Block a user