mirror of
https://github.com/leanprover/lean4.git
synced 2026-04-11 06:34:08 +00:00
Compare commits
37 Commits
sofia/time
...
grind_none
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
f88263cdc9 | ||
|
|
8f1c18d9f4 | ||
|
|
097f3ebdbc | ||
|
|
861f722844 | ||
|
|
eac9315962 | ||
|
|
8b52f4e8f7 | ||
|
|
402a6096b9 | ||
|
|
978bde4a0f | ||
|
|
8aa0c21bf8 | ||
|
|
1aa860af33 | ||
|
|
cdd982a030 | ||
|
|
f11d137a30 | ||
|
|
fc0cf68539 | ||
|
|
46a0a0eb59 | ||
|
|
916004bd3c | ||
|
|
a145b9c11a | ||
|
|
67b6e815b9 | ||
|
|
33c3604b87 | ||
|
|
504e099c5d | ||
|
|
17795b02ee | ||
|
|
48800e438c | ||
|
|
f395593ffc | ||
|
|
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:
|
||||
|
||||
@@ -157,6 +157,16 @@ Note: `gh pr checks --watch` exits as soon as ALL checks complete (pass or fail)
|
||||
fail while others are still running, `--watch` will continue until everything settles, then exit
|
||||
with a non-zero code. So a background `--watch` finishing = all checks done; check which failed.
|
||||
|
||||
## Mathlib Bump Branches
|
||||
|
||||
Mathlib `bump/v4.X.0` branches live on the **fork** `leanprover-community/mathlib4-nightly-testing`,
|
||||
NOT on `leanprover-community/mathlib4`.
|
||||
|
||||
## Never Force-Update Remote Refs Without Confirmation
|
||||
|
||||
Never force-update an existing remote branch or tag via `git push --force` or the GitHub API
|
||||
without explicit user confirmation.
|
||||
|
||||
## Error Handling
|
||||
|
||||
**CRITICAL**: If something goes wrong or a command fails:
|
||||
|
||||
2
.github/workflows/ci.yml
vendored
2
.github/workflows/ci.yml
vendored
@@ -143,7 +143,7 @@ jobs:
|
||||
CMAKE_MAJOR=$(grep -E "^set\(LEAN_VERSION_MAJOR " src/CMakeLists.txt | grep -oE '[0-9]+')
|
||||
CMAKE_MINOR=$(grep -E "^set\(LEAN_VERSION_MINOR " src/CMakeLists.txt | grep -oE '[0-9]+')
|
||||
CMAKE_PATCH=$(grep -E "^set\(LEAN_VERSION_PATCH " src/CMakeLists.txt | grep -oE '[0-9]+')
|
||||
CMAKE_IS_RELEASE=$(grep -m 1 -E "^set\(LEAN_VERSION_IS_RELEASE " src/CMakeLists.txt | sed -nE 's/^set\(LEAN_VERSION_IS_RELEASE ([0-9]+)\).*/\1/p')
|
||||
CMAKE_IS_RELEASE=$(grep -m 1 -E "^set\(LEAN_VERSION_IS_RELEASE " src/CMakeLists.txt | grep -oE '[0-9]+' | head -1)
|
||||
|
||||
# Expected values from tag parsing
|
||||
TAG_MAJOR="${{ steps.set-release.outputs.LEAN_VERSION_MAJOR }}"
|
||||
|
||||
@@ -6,6 +6,6 @@ vscode:
|
||||
- leanprover.lean4
|
||||
|
||||
tasks:
|
||||
- name: Release build
|
||||
init: cmake --preset release
|
||||
- name: Build
|
||||
init: cmake --preset dev
|
||||
command: make -C build/release -j$(nproc || sysctl -n hw.logicalcpu)
|
||||
|
||||
@@ -1,4 +1,6 @@
|
||||
cmake_minimum_required(VERSION 3.21)
|
||||
include(ExternalProject)
|
||||
include(FetchContent)
|
||||
|
||||
if(NOT CMAKE_GENERATOR MATCHES "Makefiles")
|
||||
message(FATAL_ERROR "Only makefile generators are supported")
|
||||
@@ -34,7 +36,6 @@ foreach(var ${vars})
|
||||
endif()
|
||||
endforeach()
|
||||
|
||||
include(ExternalProject)
|
||||
project(LEAN CXX C)
|
||||
|
||||
if(NOT (DEFINED STAGE0_CMAKE_EXECUTABLE_SUFFIX))
|
||||
@@ -119,17 +120,16 @@ if(NOT CMAKE_SYSTEM_NAME MATCHES "Emscripten")
|
||||
endif()
|
||||
|
||||
if(USE_MIMALLOC)
|
||||
ExternalProject_Add(
|
||||
FetchContent_Declare(
|
||||
mimalloc
|
||||
PREFIX mimalloc
|
||||
GIT_REPOSITORY https://github.com/microsoft/mimalloc
|
||||
GIT_TAG v2.2.3
|
||||
# just download, we compile it as part of each stage as it is small
|
||||
CONFIGURE_COMMAND ""
|
||||
BUILD_COMMAND ""
|
||||
INSTALL_COMMAND ""
|
||||
# Unnecessarily deep directory structure, but it saves us from a complicated
|
||||
# stage0 update for now. If we ever update the other dependencies like
|
||||
# cadical, it might be worth reorganizing the directory structure.
|
||||
SOURCE_DIR "${CMAKE_BINARY_DIR}/mimalloc/src/mimalloc"
|
||||
)
|
||||
list(APPEND EXTRA_DEPENDS mimalloc)
|
||||
FetchContent_MakeAvailable(mimalloc)
|
||||
endif()
|
||||
|
||||
if(NOT STAGE1_PREV_STAGE)
|
||||
|
||||
@@ -8,16 +8,26 @@
|
||||
"configurePresets": [
|
||||
{
|
||||
"name": "release",
|
||||
"displayName": "Default development optimized build config",
|
||||
"displayName": "Release build config",
|
||||
"generator": "Unix Makefiles",
|
||||
"binaryDir": "${sourceDir}/build/release"
|
||||
},
|
||||
{
|
||||
"name": "dev",
|
||||
"displayName": "Default development optimized build config",
|
||||
"cacheVariables": {
|
||||
"STRIP_BINARIES": "OFF"
|
||||
},
|
||||
"generator": "Unix Makefiles",
|
||||
"binaryDir": "${sourceDir}/build/dev"
|
||||
},
|
||||
{
|
||||
"name": "debug",
|
||||
"displayName": "Debug build config",
|
||||
"cacheVariables": {
|
||||
"CMAKE_BUILD_TYPE": "Debug",
|
||||
"LEAN_EXTRA_CXX_FLAGS": "-DLEAN_DEFAULT_THREAD_STACK_SIZE=16*1024*1024",
|
||||
"CMAKE_BUILD_TYPE": "Debug"
|
||||
"STRIP_BINARIES": "OFF"
|
||||
},
|
||||
"generator": "Unix Makefiles",
|
||||
"binaryDir": "${sourceDir}/build/debug"
|
||||
@@ -26,7 +36,8 @@
|
||||
"name": "reldebug",
|
||||
"displayName": "Release with assertions enabled",
|
||||
"cacheVariables": {
|
||||
"CMAKE_BUILD_TYPE": "RelWithAssert"
|
||||
"CMAKE_BUILD_TYPE": "RelWithAssert",
|
||||
"STRIP_BINARIES": "OFF"
|
||||
},
|
||||
"generator": "Unix Makefiles",
|
||||
"binaryDir": "${sourceDir}/build/reldebug"
|
||||
@@ -38,6 +49,7 @@
|
||||
"LEAN_EXTRA_CXX_FLAGS": "-fsanitize=address,undefined -DLEAN_DEFAULT_THREAD_STACK_SIZE=16*1024*1024",
|
||||
"LEANC_EXTRA_CC_FLAGS": "-fsanitize=address,undefined",
|
||||
"LEAN_EXTRA_LINKER_FLAGS": "-fsanitize=address,undefined -fsanitize-link-c++-runtime",
|
||||
"STRIP_BINARIES": "OFF",
|
||||
"SMALL_ALLOCATOR": "OFF",
|
||||
"USE_MIMALLOC": "OFF",
|
||||
"BSYMBOLIC": "OFF",
|
||||
@@ -58,6 +70,10 @@
|
||||
"name": "release",
|
||||
"configurePreset": "release"
|
||||
},
|
||||
{
|
||||
"name": "dev",
|
||||
"configurePreset": "dev"
|
||||
},
|
||||
{
|
||||
"name": "debug",
|
||||
"configurePreset": "debug"
|
||||
@@ -81,6 +97,11 @@
|
||||
"configurePreset": "release",
|
||||
"output": {"outputOnFailure": true, "shortProgress": true}
|
||||
},
|
||||
{
|
||||
"name": "dev",
|
||||
"configurePreset": "dev",
|
||||
"output": {"outputOnFailure": true, "shortProgress": true}
|
||||
},
|
||||
{
|
||||
"name": "debug",
|
||||
"configurePreset": "debug",
|
||||
|
||||
@@ -30,6 +30,9 @@ cd lean4
|
||||
cmake --preset release
|
||||
make -C build/release -j$(nproc || sysctl -n hw.logicalcpu)
|
||||
```
|
||||
|
||||
For development, `cmake --preset dev` is recommended instead.
|
||||
|
||||
You can replace `$(nproc || sysctl -n hw.logicalcpu)` with the desired parallelism amount.
|
||||
|
||||
The above commands will compile the Lean library and binaries into the
|
||||
|
||||
@@ -311,16 +311,16 @@ def check_cmake_version(repo_url, branch, version_major, version_minor, github_t
|
||||
print(f" ❌ Could not retrieve {cmake_file_path} from {branch}")
|
||||
return False
|
||||
|
||||
expected_lines = [
|
||||
f"set(LEAN_VERSION_MAJOR {version_major})",
|
||||
f"set(LEAN_VERSION_MINOR {version_minor})",
|
||||
f"set(LEAN_VERSION_PATCH 0)",
|
||||
f"set(LEAN_VERSION_IS_RELEASE 1)"
|
||||
expected_patterns = [
|
||||
(f"LEAN_VERSION_MAJOR", rf"^set\(LEAN_VERSION_MAJOR\s+{version_major}[\s)]", f"set(LEAN_VERSION_MAJOR {version_major} ...)"),
|
||||
(f"LEAN_VERSION_MINOR", rf"^set\(LEAN_VERSION_MINOR\s+{version_minor}[\s)]", f"set(LEAN_VERSION_MINOR {version_minor} ...)"),
|
||||
(f"LEAN_VERSION_PATCH", rf"^set\(LEAN_VERSION_PATCH\s+0[\s)]", f"set(LEAN_VERSION_PATCH 0 ...)"),
|
||||
(f"LEAN_VERSION_IS_RELEASE", rf"^set\(LEAN_VERSION_IS_RELEASE\s+1[\s)]", f"set(LEAN_VERSION_IS_RELEASE 1 ...)"),
|
||||
]
|
||||
|
||||
for line in expected_lines:
|
||||
if not any(l.strip().startswith(line) for l in content.splitlines()):
|
||||
print(f" ❌ Missing or incorrect line in {cmake_file_path}: {line}")
|
||||
for name, pattern, display in expected_patterns:
|
||||
if not any(re.match(pattern, l.strip()) for l in content.splitlines()):
|
||||
print(f" ❌ Missing or incorrect line in {cmake_file_path}: {display}")
|
||||
return False
|
||||
|
||||
print(f" ✅ CMake version settings are correct in {cmake_file_path}")
|
||||
@@ -343,11 +343,11 @@ def check_stage0_version(repo_url, branch, version_major, version_minor, github_
|
||||
for line in content.splitlines():
|
||||
stripped = line.strip()
|
||||
if stripped.startswith("set(LEAN_VERSION_MAJOR "):
|
||||
actual = stripped.split()[-1].rstrip(")")
|
||||
actual = stripped.split()[1].rstrip(")")
|
||||
if actual != str(version_major):
|
||||
errors.append(f"LEAN_VERSION_MAJOR: expected {version_major}, found {actual}")
|
||||
elif stripped.startswith("set(LEAN_VERSION_MINOR "):
|
||||
actual = stripped.split()[-1].rstrip(")")
|
||||
actual = stripped.split()[1].rstrip(")")
|
||||
if actual != str(version_minor):
|
||||
errors.append(f"LEAN_VERSION_MINOR: expected {version_minor}, found {actual}")
|
||||
|
||||
|
||||
@@ -8,7 +8,7 @@ endif()
|
||||
include(ExternalProject)
|
||||
project(LEAN CXX C)
|
||||
set(LEAN_VERSION_MAJOR 4 CACHE STRING "")
|
||||
set(LEAN_VERSION_MINOR 30 CACHE STRING "")
|
||||
set(LEAN_VERSION_MINOR 31 CACHE STRING "")
|
||||
set(LEAN_VERSION_PATCH 0 CACHE STRING "")
|
||||
set(LEAN_VERSION_IS_RELEASE 0 CACHE STRING "") # This number is 1 in the release revision, and 0 otherwise.
|
||||
set(LEAN_SPECIAL_VERSION_DESC "" CACHE STRING "Additional version description like 'nightly-2018-03-11'")
|
||||
@@ -80,6 +80,7 @@ option(CCACHE "use ccache" ON)
|
||||
option(SPLIT_STACK "SPLIT_STACK" OFF)
|
||||
# When OFF we disable LLVM support
|
||||
option(LLVM "LLVM" OFF)
|
||||
option(STRIP_BINARIES "Strip produced binaries" ON)
|
||||
|
||||
# When ON we include githash in the version string
|
||||
option(USE_GITHASH "GIT_HASH" ON)
|
||||
@@ -614,6 +615,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 +830,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 +945,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
|
||||
|
||||
@@ -20,12 +20,20 @@ universe u
|
||||
|
||||
namespace ByteArray
|
||||
|
||||
deriving instance BEq for ByteArray
|
||||
@[extern "lean_sarray_dec_eq"]
|
||||
def beq (lhs rhs : @& ByteArray) : Bool :=
|
||||
lhs.data == rhs.data
|
||||
|
||||
instance : BEq ByteArray where
|
||||
beq := beq
|
||||
|
||||
attribute [ext] ByteArray
|
||||
|
||||
instance : DecidableEq ByteArray :=
|
||||
fun _ _ => decidable_of_decidable_of_iff ByteArray.ext_iff.symm
|
||||
@[extern "lean_sarray_dec_eq"]
|
||||
def decEq (lhs rhs : @& ByteArray) : Decidable (lhs = rhs) :=
|
||||
decidable_of_decidable_of_iff ByteArray.ext_iff.symm
|
||||
|
||||
instance : DecidableEq ByteArray := decEq
|
||||
|
||||
instance : Inhabited ByteArray where
|
||||
default := empty
|
||||
|
||||
@@ -9,7 +9,7 @@ prelude
|
||||
public import Init.Data.Order.Ord
|
||||
public import Init.Data.String.Basic
|
||||
import Init.Data.Char.Lemmas
|
||||
import Init.Data.String.Lemmas
|
||||
import Init.Data.String.Lemmas.StringOrder
|
||||
|
||||
public section
|
||||
|
||||
|
||||
@@ -17,6 +17,7 @@ namespace Std
|
||||
/--
|
||||
Appends all the elements in the iterator, in order.
|
||||
-/
|
||||
@[inline]
|
||||
public def Iter.joinString {α β : Type} [Iterator α Id β] [ToString β]
|
||||
(it : Std.Iter (α := α) β) : String :=
|
||||
(it.map toString).fold (init := "") (· ++ ·)
|
||||
|
||||
@@ -20,49 +20,4 @@ public import Init.Data.String.Lemmas.Intercalate
|
||||
public import Init.Data.String.Lemmas.Iter
|
||||
public import Init.Data.String.Lemmas.Hashable
|
||||
public import Init.Data.String.Lemmas.TakeDrop
|
||||
import Init.Data.Order.Lemmas
|
||||
public import Init.Data.String.Basic
|
||||
import Init.Data.Char.Lemmas
|
||||
import Init.Data.Char.Order
|
||||
import Init.Data.List.Lex
|
||||
|
||||
public section
|
||||
|
||||
open Std
|
||||
|
||||
namespace String
|
||||
|
||||
@[deprecated toList_inj (since := "2025-10-30")]
|
||||
protected theorem data_eq_of_eq {a b : String} (h : a = b) : a.toList = b.toList :=
|
||||
h ▸ rfl
|
||||
@[deprecated toList_inj (since := "2025-10-30")]
|
||||
protected theorem ne_of_data_ne {a b : String} (h : a.toList ≠ b.toList) : a ≠ b := by
|
||||
simpa [← toList_inj]
|
||||
|
||||
@[simp] protected theorem not_le {a b : String} : ¬ a ≤ b ↔ b < a := Decidable.not_not
|
||||
@[simp] protected theorem not_lt {a b : String} : ¬ a < b ↔ b ≤ a := Iff.rfl
|
||||
@[simp] protected theorem le_refl (a : String) : a ≤ a := List.le_refl _
|
||||
@[simp] protected theorem lt_irrefl (a : String) : ¬ a < a := List.lt_irrefl _
|
||||
|
||||
attribute [local instance] Char.notLTTrans Char.ltTrichotomous Char.ltAsymm
|
||||
|
||||
protected theorem le_trans {a b c : String} : a ≤ b → b ≤ c → a ≤ c := List.le_trans
|
||||
protected theorem lt_trans {a b c : String} : a < b → b < c → a < c := List.lt_trans
|
||||
protected theorem le_total (a b : String) : a ≤ b ∨ b ≤ a := List.le_total _ _
|
||||
protected theorem le_antisymm {a b : String} : a ≤ b → b ≤ a → a = b := fun h₁ h₂ => String.ext (List.le_antisymm (as := a.toList) (bs := b.toList) h₁ h₂)
|
||||
protected theorem lt_asymm {a b : String} (h : a < b) : ¬ b < a := List.lt_asymm h
|
||||
protected theorem ne_of_lt {a b : String} (h : a < b) : a ≠ b := by
|
||||
have := String.lt_irrefl a
|
||||
intro h; subst h; contradiction
|
||||
|
||||
instance instIsLinearOrder : IsLinearOrder String := by
|
||||
apply IsLinearOrder.of_le
|
||||
case le_antisymm => constructor; apply String.le_antisymm
|
||||
case le_trans => constructor; apply String.le_trans
|
||||
case le_total => constructor; apply String.le_total
|
||||
|
||||
instance : LawfulOrderLT String where
|
||||
lt_iff a b := by
|
||||
simp [← String.not_le, Decidable.imp_iff_not_or, Std.Total.total]
|
||||
|
||||
end String
|
||||
public import Init.Data.String.Lemmas.StringOrder
|
||||
|
||||
@@ -40,7 +40,7 @@ framework.
|
||||
/--
|
||||
This data-carrying typeclass is used to give semantics to a pattern type that implements
|
||||
{name}`ForwardPattern` and/or {name}`ToForwardSearcher` by providing an abstract, not necessarily
|
||||
decidable {name}`PatternModel.Matches` predicate that implementates of {name}`ForwardPattern`
|
||||
decidable {name}`PatternModel.Matches` predicate that implementations of {name}`ForwardPattern`
|
||||
and {name}`ToForwardSearcher` can be validated against.
|
||||
|
||||
Correctness results for generic functions relying on the pattern infrastructure, for example the
|
||||
@@ -151,7 +151,7 @@ theorem IsLongestMatch.le_of_isMatch {pat : ρ} [PatternModel pat] {s : Slice} {
|
||||
|
||||
/--
|
||||
Predicate stating that the region between the start of the slice {name}`s` and the position
|
||||
{name}`pos` matches the patten {name}`pat`, and that there is no longer match starting at the
|
||||
{name}`pos` matches the pattern {name}`pat`, and that there is no longer match starting at the
|
||||
beginning of the slice. This is what a correct matcher should match.
|
||||
|
||||
In some cases, being a match and being a longest match will coincide, see
|
||||
@@ -228,7 +228,7 @@ theorem isLongestRevMatch_iff_isRevMatch {ρ : Type} (pat : ρ) [PatternModel pa
|
||||
exact ht₅ (NoSuffixPatternModel.eq_empty _ _ ht₂ (ht₅'' ▸ ht₂'))
|
||||
|
||||
/--
|
||||
Predicate stating that the slice formed by {name}`startPos` and {name}`endPos` contains is a match
|
||||
Predicate stating that the slice formed by {name}`startPos` and {name}`endPos` contains a match
|
||||
of {name}`pat` in {name}`s` and it is longest among matches starting at {name}`startPos`.
|
||||
-/
|
||||
structure IsLongestMatchAt (pat : ρ) [PatternModel pat] {s : Slice} (startPos endPos : s.Pos) : Prop where
|
||||
@@ -411,7 +411,7 @@ theorem not_revMatchesAt_startPos {pat : ρ} [PatternModel pat] {s : Slice} :
|
||||
intro h
|
||||
simpa [← Pos.ofSliceTo_inj] using h.ne_endPos
|
||||
|
||||
theorem revMatchesAt_iff_revMatchesAt_ofSliceto {pat : ρ} [PatternModel pat] {s : Slice} {base : s.Pos}
|
||||
theorem revMatchesAt_iff_revMatchesAt_ofSliceTo {pat : ρ} [PatternModel pat] {s : Slice} {base : s.Pos}
|
||||
{pos : (s.sliceTo base).Pos} : RevMatchesAt pat pos ↔ RevMatchesAt pat (Pos.ofSliceTo pos) := by
|
||||
simp only [revMatchesAt_iff_exists_isLongestRevMatchAt]
|
||||
constructor
|
||||
@@ -505,8 +505,8 @@ theorem LawfulForwardPatternModel.skipPrefix?_eq_none_iff {ρ : Type} {pat : ρ}
|
||||
/--
|
||||
Predicate stating compatibility between {name}`PatternModel` and {name}`BackwardPattern`.
|
||||
|
||||
This extends {name}`LawfulForwardPattern`, but it is much stronger because it forces the
|
||||
{name}`ForwardPattern` to match the longest prefix of the given slice that matches the property
|
||||
This extends {name}`LawfulBackwardPattern`, but it is much stronger because it forces the
|
||||
{name}`BackwardPattern` to match the longest prefix of the given slice that matches the property
|
||||
supplied by the {name}`PatternModel` instance.
|
||||
-/
|
||||
class LawfulBackwardPatternModel {ρ : Type} (pat : ρ) [BackwardPattern pat]
|
||||
|
||||
@@ -65,7 +65,7 @@ theorem startsWith_prop_eq_head? {P : Char → Prop} [DecidablePred P] {s : Slic
|
||||
s.startsWith P = s.copy.toList.head?.any (decide <| P ·) := by
|
||||
simp [startsWith_prop_eq_startsWith_decide, startsWith_bool_eq_head?]
|
||||
|
||||
theorem eq_append_of_dropPrefix_prop_eq_some {P : Char → Prop} [DecidablePred P] {s res : Slice} (h : s.dropPrefix? P = some res) :
|
||||
theorem eq_append_of_dropPrefix?_prop_eq_some {P : Char → Prop} [DecidablePred P] {s res : Slice} (h : s.dropPrefix? P = some res) :
|
||||
∃ c, s.copy = singleton c ++ res.copy ∧ P c := by
|
||||
rw [dropPrefix?_prop_eq_dropPrefix?_decide] at h
|
||||
simpa using eq_append_of_dropPrefix?_bool_eq_some h
|
||||
@@ -162,7 +162,7 @@ theorem startsWith_prop_eq_head? {P : Char → Prop} [DecidablePred P] {s : Stri
|
||||
theorem eq_append_of_dropPrefix?_prop_eq_some {P : Char → Prop} [DecidablePred P] {s : String} {res : Slice}
|
||||
(h : s.dropPrefix? P = some res) : ∃ c, s = singleton c ++ res.copy ∧ P c := by
|
||||
rw [dropPrefix?_eq_dropPrefix?_toSlice] at h
|
||||
simpa using Slice.eq_append_of_dropPrefix_prop_eq_some h
|
||||
simpa using Slice.eq_append_of_dropPrefix?_prop_eq_some h
|
||||
|
||||
theorem skipSuffix?_bool_eq_some_iff {p : Char → Bool} {s : String} {pos : s.Pos} :
|
||||
s.skipSuffix? p = some pos ↔ ∃ h, pos = s.endPos.prev h ∧ p ((s.endPos.prev h).get (by simp)) = true := by
|
||||
|
||||
49
src/Init/Data/String/Lemmas/StringOrder.lean
Normal file
49
src/Init/Data/String/Lemmas/StringOrder.lean
Normal file
@@ -0,0 +1,49 @@
|
||||
/-
|
||||
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Init.Data.String.Basic
|
||||
public import Init.Data.Order.Classes
|
||||
import Init.Data.List.Lex
|
||||
import Init.Data.Char.Lemmas
|
||||
import Init.Data.Char.Order
|
||||
import Init.Data.Order.Factories
|
||||
import Init.Data.Order.Lemmas
|
||||
|
||||
public section
|
||||
|
||||
open Std
|
||||
|
||||
namespace String
|
||||
|
||||
@[simp] protected theorem not_le {a b : String} : ¬ a ≤ b ↔ b < a := Decidable.not_not
|
||||
@[simp] protected theorem not_lt {a b : String} : ¬ a < b ↔ b ≤ a := Iff.rfl
|
||||
@[simp] protected theorem le_refl (a : String) : a ≤ a := List.le_refl _
|
||||
@[simp] protected theorem lt_irrefl (a : String) : ¬ a < a := List.lt_irrefl _
|
||||
|
||||
attribute [local instance] Char.notLTTrans Char.ltTrichotomous Char.ltAsymm
|
||||
|
||||
protected theorem le_trans {a b c : String} : a ≤ b → b ≤ c → a ≤ c := List.le_trans
|
||||
protected theorem lt_trans {a b c : String} : a < b → b < c → a < c := List.lt_trans
|
||||
protected theorem le_total (a b : String) : a ≤ b ∨ b ≤ a := List.le_total _ _
|
||||
protected theorem le_antisymm {a b : String} : a ≤ b → b ≤ a → a = b := fun h₁ h₂ => String.ext (List.le_antisymm (as := a.toList) (bs := b.toList) h₁ h₂)
|
||||
protected theorem lt_asymm {a b : String} (h : a < b) : ¬ b < a := List.lt_asymm h
|
||||
protected theorem ne_of_lt {a b : String} (h : a < b) : a ≠ b := by
|
||||
have := String.lt_irrefl a
|
||||
intro h; subst h; contradiction
|
||||
|
||||
instance instIsLinearOrder : IsLinearOrder String := by
|
||||
apply IsLinearOrder.of_le
|
||||
case le_antisymm => constructor; apply String.le_antisymm
|
||||
case le_trans => constructor; apply String.le_trans
|
||||
case le_total => constructor; apply String.le_total
|
||||
|
||||
instance : LawfulOrderLT String where
|
||||
lt_iff a b := by
|
||||
simp [← String.not_le, Decidable.imp_iff_not_or, Std.Total.total]
|
||||
|
||||
end String
|
||||
@@ -706,14 +706,14 @@ Returns {name}`none` otherwise.
|
||||
This function is generic over all currently supported patterns.
|
||||
-/
|
||||
@[inline]
|
||||
def Pos.revSkip? {s : Slice} (pos : s.Pos) (pat : ρ) [ForwardPattern pat] : Option s.Pos :=
|
||||
((s.sliceFrom pos).skipPrefix? pat).map Pos.ofSliceFrom
|
||||
def Pos.revSkip? {s : Slice} (pos : s.Pos) (pat : ρ) [BackwardPattern pat] : Option s.Pos :=
|
||||
((s.sliceFrom pos).skipSuffix? pat).map Pos.ofSliceFrom
|
||||
|
||||
/--
|
||||
If {name}`pat` matches a suffix of {name}`s`, returns the remainder. Returns {name}`none` otherwise.
|
||||
|
||||
Use {name (scope := "Init.Data.String.Slice")}`String.Slice.dropSuffix` to return the slice
|
||||
unchanged when {name}`pat` does not match a prefix.
|
||||
unchanged when {name}`pat` does not match a suffix.
|
||||
|
||||
This function is generic over all currently supported patterns.
|
||||
|
||||
@@ -775,7 +775,7 @@ def Pos.revSkipWhile {s : Slice} (pos : s.Pos) (pat : ρ) [BackwardPattern pat]
|
||||
termination_by pos.down
|
||||
|
||||
/--
|
||||
Returns the position a the start of the longest suffix of {name}`s` for which {name}`pat` matches
|
||||
Returns the position at the start of the longest suffix of {name}`s` for which {name}`pat` matches
|
||||
(potentially repeatedly).
|
||||
-/
|
||||
@[inline]
|
||||
|
||||
@@ -314,7 +314,7 @@ Returns {name}`none` otherwise.
|
||||
This function is generic over all currently supported patterns.
|
||||
-/
|
||||
@[inline]
|
||||
def Pos.revSkip? {s : String} (pos : s.Pos) (pat : ρ) [ForwardPattern pat] : Option s.Pos :=
|
||||
def Pos.revSkip? {s : String} (pos : s.Pos) (pat : ρ) [BackwardPattern pat] : Option s.Pos :=
|
||||
(pos.toSlice.revSkip? pat).map Pos.ofToSlice
|
||||
|
||||
/--
|
||||
@@ -461,7 +461,7 @@ def dropPrefix? (s : String) (pat : ρ) [ForwardPattern pat] : Option String.Sli
|
||||
If {name}`pat` matches a suffix of {name}`s`, returns the remainder. Returns {name}`none` otherwise.
|
||||
|
||||
Use {name (scope := "Init.Data.String.TakeDrop")}`String.dropSuffix` to return the slice
|
||||
unchanged when {name}`pat` does not match a prefix.
|
||||
unchanged when {name}`pat` does not match a suffix.
|
||||
|
||||
This is a cheap operation because it does not allocate a new string to hold the result.
|
||||
To convert the result into a string, use {name}`String.Slice.copy`.
|
||||
|
||||
@@ -30,13 +30,13 @@ simpMatchDiscrsOnly (match 0 with | 0 => true | _ => false) = true
|
||||
```
|
||||
using `eq_self`.
|
||||
-/
|
||||
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.
|
||||
|
||||
@@ -36,9 +36,6 @@ private local instance : ToString Int where
|
||||
private local instance : Repr Int where
|
||||
reprPrec i prec := if i < 0 then Repr.addAppParen (toString i) prec else toString i
|
||||
|
||||
private local instance : Append String where
|
||||
append := String.Internal.append
|
||||
|
||||
/-- Internal representation of a linear combination of atoms, and a constant term. -/
|
||||
structure LinearCombo where
|
||||
/-- Constant term. -/
|
||||
|
||||
@@ -232,6 +232,7 @@ partial def checkCases (c : Cases .pure) : CheckM Unit := do
|
||||
withParams params do check k
|
||||
|
||||
partial def check (code : Code .pure) : CheckM Unit := do
|
||||
checkSystem "LCNF check"
|
||||
match code with
|
||||
| .let decl k => checkLetDecl decl; withFVarId decl.fvarId do check k
|
||||
| .fun decl k =>
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -188,6 +188,7 @@ where
|
||||
profileitM Exception profilerName (← getOptions) do
|
||||
let mut state : (pu : Purity) × Array (Decl pu) := ⟨inPhase, decls⟩
|
||||
for pass in passes do
|
||||
checkSystem "LCNF compiler"
|
||||
state ← withTraceNode `Compiler (fun _ => return m!"compiler phase: {pass.phase}, pass: {pass.name}") do
|
||||
let decls ← withPhase pass.phase do
|
||||
state.fst.withAssertPurity pass.phase.toPurity fun h => do
|
||||
|
||||
@@ -146,7 +146,7 @@ Similar to the default `Lean.withIncRecDepth`, but include the `inlineStack` in
|
||||
@[inline] def withIncRecDepth (x : SimpM α) : SimpM α := do
|
||||
let curr ← MonadRecDepth.getRecDepth
|
||||
let max ← MonadRecDepth.getMaxRecDepth
|
||||
if curr == max then
|
||||
if max != 0 && curr == max then
|
||||
throwMaxRecDepth
|
||||
else
|
||||
MonadRecDepth.withRecDepth (curr+1) x
|
||||
|
||||
@@ -453,6 +453,9 @@ Throws an internal interrupt exception if cancellation has been requested. The e
|
||||
caught by `try catch` but is intended to be caught by `Command.withLoggingExceptions` at the top
|
||||
level of elaboration. In particular, we want to skip producing further incremental snapshots after
|
||||
the exception has been thrown.
|
||||
|
||||
Like `checkSystem` but without the global heartbeat check, for callers that have their own
|
||||
heartbeat tracking (e.g. `SynthInstance`).
|
||||
-/
|
||||
@[inline] def checkInterrupted : CoreM Unit := do
|
||||
if let some tk := (← read).cancelTk? then
|
||||
|
||||
@@ -60,7 +60,7 @@ instance : EmptyCollection (Trie α) :=
|
||||
instance : Inhabited (Trie α) where
|
||||
default := empty
|
||||
|
||||
/-- Insert or update the value at a the given key `s`. -/
|
||||
/-- Insert or update the value at the given key `s`. -/
|
||||
partial def upsert (t : Trie α) (s : String) (f : Option α → α) : Trie α :=
|
||||
let rec insertEmpty (i : Nat) : Trie α :=
|
||||
if h : i < s.utf8ByteSize then
|
||||
@@ -100,7 +100,7 @@ partial def upsert (t : Trie α) (s : String) (f : Option α → α) : Trie α :
|
||||
node (f v) cs ts
|
||||
loop 0 t
|
||||
|
||||
/-- Inserts a value at a the given key `s`, overriding an existing value if present. -/
|
||||
/-- Inserts a value at the given key `s`, overriding an existing value if present. -/
|
||||
partial def insert (t : Trie α) (s : String) (val : α) : Trie α :=
|
||||
upsert t s (fun _ => val)
|
||||
|
||||
|
||||
45
src/Lean/DeprecatedModule.lean
Normal file
45
src/Lean/DeprecatedModule.lean
Normal file
@@ -0,0 +1,45 @@
|
||||
/-
|
||||
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.Compiler.ModPkgExt
|
||||
|
||||
public section
|
||||
|
||||
namespace Lean
|
||||
|
||||
structure DeprecatedModuleEntry where
|
||||
message? : Option String := none
|
||||
since? : Option String := none
|
||||
deriving Inhabited
|
||||
|
||||
register_builtin_option linter.deprecated.module : Bool := {
|
||||
defValue := true
|
||||
descr := "if true, generate warnings when importing deprecated modules"
|
||||
}
|
||||
|
||||
builtin_initialize deprecatedModuleExt : ModuleEnvExtension <| Option DeprecatedModuleEntry ←
|
||||
registerModuleEnvExtension <| pure none
|
||||
|
||||
def Environment.getDeprecatedModuleByIdx? (env : Environment) (idx : ModuleIdx) : Option DeprecatedModuleEntry :=
|
||||
deprecatedModuleExt.getStateByIdx? env idx |>.join
|
||||
|
||||
def Environment.setDeprecatedModule (entry : Option DeprecatedModuleEntry) (env : Environment) : Environment :=
|
||||
deprecatedModuleExt.setState env entry
|
||||
|
||||
def formatDeprecatedModuleWarning (env : Environment) (idx : ModuleIdx) (modName : Name)
|
||||
(entry : DeprecatedModuleEntry) : String :=
|
||||
let msg := entry.message?.getD ""
|
||||
let replacements := env.header.moduleData[idx.toNat]!.imports.filter fun imp =>
|
||||
imp.module != `Init
|
||||
let lines := replacements.foldl (init := "") fun acc imp =>
|
||||
acc ++ s!"import {imp.module}\n"
|
||||
s!"{msg}\n\
|
||||
'{modName}' has been deprecated: please replace this import by\n\n\
|
||||
{lines}"
|
||||
|
||||
end Lean
|
||||
@@ -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
|
||||
|
||||
@@ -9,10 +9,12 @@ prelude
|
||||
public import Lean.Meta.Reduce
|
||||
public import Lean.Elab.Eval
|
||||
public import Lean.Elab.Command
|
||||
import Lean.Elab.DeprecatedSyntax
|
||||
public import Lean.Elab.Open
|
||||
import Init.Data.Nat.Order
|
||||
import Init.Data.Order.Lemmas
|
||||
import Init.System.Platform
|
||||
import Lean.DeprecatedModule
|
||||
|
||||
public section
|
||||
|
||||
@@ -512,6 +514,15 @@ def failIfSucceeds (x : CommandElabM Unit) : CommandElabM Unit := do
|
||||
modify fun s => { s with maxRecDepth := maxRecDepth.get options }
|
||||
modifyScope fun scope => { scope with opts := options }
|
||||
|
||||
@[builtin_command_elab «unlock_limits»] def elabUnlockLimits : CommandElab := fun _ => do
|
||||
let opts ← getOptions
|
||||
let opts := maxHeartbeats.set opts 0
|
||||
let opts := maxRecDepth.set opts 0
|
||||
let opts := synthInstance.maxHeartbeats.set opts 0
|
||||
modifyScope ({ · with opts })
|
||||
-- update cached value as well
|
||||
modify ({ · with maxRecDepth := 0 })
|
||||
|
||||
open Lean.Parser.Command.InternalSyntax in
|
||||
@[builtin_macro Lean.Parser.Command.«in»] def expandInCmd : Macro
|
||||
| `($cmd₁ in%$tk $cmd₂) =>
|
||||
@@ -706,4 +717,54 @@ where
|
||||
let env ← getEnv
|
||||
IO.eprintln (← env.dbgFormatAsyncState)
|
||||
|
||||
/-- Elaborate `deprecated_module`, marking the current module as deprecated. -/
|
||||
@[builtin_command_elab Parser.Command.deprecated_module]
|
||||
def elabDeprecatedModule : CommandElab
|
||||
| `(Parser.Command.deprecated_module| deprecated_module $[$msg?]? $[(since := $since?)]?) => do
|
||||
let message? := msg?.map TSyntax.getString
|
||||
let since? := since?.map TSyntax.getString
|
||||
if (deprecatedModuleExt.getState (← getEnv)).isSome then
|
||||
logWarning "module is already marked as deprecated"
|
||||
if since?.isNone then
|
||||
logWarning "`deprecated_module` should specify the date or library version \
|
||||
at which the deprecation was introduced, using `(since := \"...\")`"
|
||||
modifyEnv fun env => env.setDeprecatedModule (some { message?, since? })
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
/-- Elaborate `#show_deprecated_modules`, displaying all deprecated modules. -/
|
||||
@[builtin_command_elab Parser.Command.showDeprecatedModules]
|
||||
def elabShowDeprecatedModules : CommandElab := fun _ => do
|
||||
let env ← getEnv
|
||||
let mut parts : Array String := #["Deprecated modules\n"]
|
||||
for h : idx in [:env.header.moduleNames.size] do
|
||||
if let some entry := env.getDeprecatedModuleByIdx? idx then
|
||||
let modName := env.header.moduleNames[idx]
|
||||
let msg := match entry.message? with
|
||||
| some str => s!"message '{str}'"
|
||||
| none => "no message"
|
||||
let replacements := env.header.moduleData[idx]!.imports.filter fun imp =>
|
||||
imp.module != `Init
|
||||
parts := parts.push s!"'{modName}' deprecates to\n{replacements.map (·.module)}\nwith {msg}\n"
|
||||
-- Also show the current module's deprecation if set.
|
||||
if let some entry := deprecatedModuleExt.getState env then
|
||||
let modName := env.mainModule
|
||||
let msg := match entry.message? with
|
||||
| some str => s!"message '{str}'"
|
||||
| none => "no message"
|
||||
let replacements := env.imports.filter fun imp =>
|
||||
imp.module != `Init
|
||||
parts := parts.push s!"'{modName}' deprecates to\n{replacements.map (·.module)}\nwith {msg}\n"
|
||||
logInfo (String.intercalate "\n" parts.toList)
|
||||
|
||||
@[builtin_command_elab Parser.Command.deprecatedSyntax] def elabDeprecatedSyntax : CommandElab := fun stx => do
|
||||
let id := stx[1]
|
||||
let kind ← liftCoreM <| checkSyntaxNodeKindAtNamespaces id.getId (← getCurrNamespace)
|
||||
let text? := if stx[2].isNone then none else stx[2][0].isStrLit?
|
||||
let since? := if stx[3].isNone then none else stx[3][3].isStrLit?
|
||||
if since?.isNone then
|
||||
logWarning "`deprecated_syntax` should specify the date or library version at which the \
|
||||
deprecation was introduced, using `(since := \"...\")`"
|
||||
modifyEnv fun env =>
|
||||
deprecatedSyntaxExt.addEntry env { kind, text?, since? }
|
||||
|
||||
end Lean.Elab.Command
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -10,6 +10,7 @@ public import Lean.Meta.Diagnostics
|
||||
public import Lean.Elab.Binders
|
||||
public import Lean.Elab.Command.Scope
|
||||
public import Lean.Elab.SetOption
|
||||
import Lean.Elab.DeprecatedSyntax
|
||||
public meta import Lean.Parser.Command
|
||||
|
||||
public section
|
||||
@@ -468,6 +469,7 @@ where go := do
|
||||
else withTraceNode `Elab.command (fun _ => return stx) (tag :=
|
||||
-- special case: show actual declaration kind for `declaration` commands
|
||||
(if stx.isOfKind ``Parser.Command.declaration then stx[1] else stx).getKind.toString) do
|
||||
checkDeprecatedSyntax stx (← read).macroStack
|
||||
let s ← get
|
||||
match (← liftMacroM <| expandMacroImpl? s.env stx) with
|
||||
| some (decl, stxNew?) =>
|
||||
|
||||
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
|
||||
71
src/Lean/Elab/DeprecatedSyntax.lean
Normal file
71
src/Lean/Elab/DeprecatedSyntax.lean
Normal file
@@ -0,0 +1,71 @@
|
||||
/-
|
||||
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.MonadEnv
|
||||
public import Lean.Linter.Basic
|
||||
public import Lean.Elab.Util
|
||||
|
||||
public section
|
||||
|
||||
namespace Lean.Linter
|
||||
|
||||
register_builtin_option linter.deprecated.syntax : Bool := {
|
||||
defValue := true
|
||||
descr := "if true, generate warnings when deprecated syntax is used"
|
||||
}
|
||||
|
||||
end Lean.Linter
|
||||
|
||||
namespace Lean.Elab
|
||||
|
||||
/-- Entry recording that a syntax kind has been deprecated. -/
|
||||
structure SyntaxDeprecationEntry where
|
||||
/-- The syntax node kind that is deprecated. -/
|
||||
kind : SyntaxNodeKind
|
||||
/-- Optional deprecation message. -/
|
||||
text? : Option String := none
|
||||
/-- Optional version or date at which the syntax was deprecated. -/
|
||||
since? : Option String := none
|
||||
|
||||
builtin_initialize deprecatedSyntaxExt :
|
||||
SimplePersistentEnvExtension SyntaxDeprecationEntry (NameMap SyntaxDeprecationEntry) ←
|
||||
registerSimplePersistentEnvExtension {
|
||||
addImportedFn := mkStateFromImportedEntries (fun m e => m.insert e.kind e) {}
|
||||
addEntryFn := fun m e => m.insert e.kind e
|
||||
}
|
||||
|
||||
/--
|
||||
Check whether `stx` is a deprecated syntax kind, and if so, emit a warning.
|
||||
|
||||
If `macroStack` is non-empty, the warning is attributed to the macro call site rather than the
|
||||
syntax itself.
|
||||
-/
|
||||
def checkDeprecatedSyntax [Monad m] [MonadEnv m] [MonadLog m] [MonadOptions m]
|
||||
[AddMessageContext m] [MonadRef m] (stx : Syntax) (macroStack : MacroStack) : m Unit := do
|
||||
let env ← getEnv
|
||||
let kind := stx.getKind
|
||||
if let some entry := (deprecatedSyntaxExt.getState env).find? kind then
|
||||
let extraMsg := match entry.text? with
|
||||
| some text => m!": {text}"
|
||||
| none => m!""
|
||||
match macroStack with
|
||||
| { before := macroStx, .. } :: { before := callerStx, .. } :: _ =>
|
||||
let expandedFrom :=
|
||||
if callerStx.getKind != macroStx.getKind then
|
||||
m!" (expanded from '{callerStx.getKind}')"
|
||||
else m!""
|
||||
Linter.logLintIf Linter.linter.deprecated.syntax macroStx
|
||||
m!"macro '{macroStx.getKind}'{expandedFrom} produces deprecated syntax '{kind}'{extraMsg}"
|
||||
| { before := macroStx, .. } :: [] =>
|
||||
Linter.logLintIf Linter.linter.deprecated.syntax macroStx
|
||||
m!"macro '{macroStx.getKind}' produces deprecated syntax '{kind}'{extraMsg}"
|
||||
| [] =>
|
||||
Linter.logLintIf Linter.linter.deprecated.syntax stx
|
||||
m!"syntax '{kind}' has been deprecated{extraMsg}"
|
||||
|
||||
end Lean.Elab
|
||||
@@ -85,6 +85,10 @@ structure State where
|
||||
-/
|
||||
lctx : LocalContext
|
||||
/--
|
||||
The local instances.
|
||||
|
||||
The `MonadLift TermElabM DocM` instance runs the lifted action with these instances, so elaboration
|
||||
commands that mutate this state cause it to take effect in subsequent commands.
|
||||
-/
|
||||
localInstances : LocalInstances
|
||||
/--
|
||||
|
||||
@@ -9,6 +9,7 @@ prelude
|
||||
public import Lean.Parser.Module
|
||||
meta import Lean.Parser.Module
|
||||
import Lean.Compiler.ModPkgExt
|
||||
public import Lean.DeprecatedModule
|
||||
|
||||
public section
|
||||
|
||||
@@ -42,12 +43,66 @@ def HeaderSyntax.toModuleHeader (stx : HeaderSyntax) : ModuleHeader where
|
||||
|
||||
abbrev headerToImports := @HeaderSyntax.imports
|
||||
|
||||
/--
|
||||
Check imported modules for deprecation and emit warnings.
|
||||
|
||||
The `-- deprecated_module: ignore` comment can be placed on the `module` keyword to suppress
|
||||
all warnings, or on individual `import` statements to suppress specific ones.
|
||||
This follows the same pattern as `-- shake: keep` in Lake shake.
|
||||
|
||||
The `headerStx?` parameter carries the header syntax used for checking trailing comments.
|
||||
When called from the Language Server, the main header syntax may have its trailing trivia
|
||||
stripped by `unsetTrailing` for caching purposes, so `origHeaderStx?` can supply the original
|
||||
(untrimmed) syntax to preserve `-- deprecated_module: ignore` annotations on the last import.
|
||||
-/
|
||||
def checkDeprecatedImports
|
||||
(env : Environment) (imports : Array Import) (opts : Options)
|
||||
(inputCtx : Parser.InputContext) (startPos : String.Pos.Raw) (messages : MessageLog)
|
||||
(headerStx? : Option HeaderSyntax := none)
|
||||
(origHeaderStx? : Option HeaderSyntax := none)
|
||||
: MessageLog := Id.run do
|
||||
let mut opts := opts
|
||||
let mut ignoreDeprecatedImports : NameSet := {}
|
||||
if let some headerStx := origHeaderStx? <|> headerStx? then
|
||||
match headerStx with
|
||||
| `(Parser.Module.header| $[module%$moduleTk]? $[prelude%$_]? $importsStx*) =>
|
||||
if moduleTk.any (·.getTrailing?.any (·.toString.contains "deprecated_module: ignore")) then
|
||||
opts := linter.deprecated.module.set opts false
|
||||
for impStx in importsStx do
|
||||
if impStx.raw.getTrailing?.any (·.toString.contains "deprecated_module: ignore") then
|
||||
match impStx with
|
||||
| `(Parser.Module.import| $[public%$_]? $[meta%$_]? import $[all%$_]? $n) =>
|
||||
ignoreDeprecatedImports := ignoreDeprecatedImports.insert n.getId
|
||||
| _ => pure ()
|
||||
| _ => pure ()
|
||||
if !linter.deprecated.module.get opts then
|
||||
return messages
|
||||
imports.foldl (init := messages) fun messages imp =>
|
||||
if ignoreDeprecatedImports.contains imp.module then
|
||||
messages
|
||||
else
|
||||
match env.getModuleIdx? imp.module with
|
||||
| some idx =>
|
||||
match env.getDeprecatedModuleByIdx? idx with
|
||||
| some entry =>
|
||||
let pos := inputCtx.fileMap.toPosition startPos
|
||||
messages.add {
|
||||
fileName := inputCtx.fileName
|
||||
pos := pos
|
||||
severity := .warning
|
||||
data := .tagged ``deprecatedModuleExt <| formatDeprecatedModuleWarning env idx imp.module entry
|
||||
}
|
||||
| none => messages
|
||||
| none => messages
|
||||
|
||||
def processHeaderCore
|
||||
(startPos : String.Pos.Raw) (imports : Array Import) (isModule : Bool)
|
||||
(opts : Options) (messages : MessageLog) (inputCtx : Parser.InputContext)
|
||||
(trustLevel : UInt32 := 0) (plugins : Array System.FilePath := #[]) (leakEnv := false)
|
||||
(mainModule := Name.anonymous) (package? : Option PkgId := none)
|
||||
(arts : NameMap ImportArtifacts := {})
|
||||
(headerStx? : Option HeaderSyntax := none)
|
||||
(origHeaderStx? : Option HeaderSyntax := none)
|
||||
: IO (Environment × MessageLog) := do
|
||||
let level := if isModule then
|
||||
if Elab.inServer.get opts then
|
||||
@@ -66,6 +121,7 @@ def processHeaderCore
|
||||
let pos := inputCtx.fileMap.toPosition startPos
|
||||
pure (env, messages.add { fileName := inputCtx.fileName, data := toString e, pos := pos })
|
||||
let env := env.setMainModule mainModule |>.setModulePackage package?
|
||||
let messages := checkDeprecatedImports env imports opts inputCtx startPos messages headerStx? origHeaderStx?
|
||||
return (env, messages)
|
||||
|
||||
/--
|
||||
@@ -82,6 +138,7 @@ backwards compatibility measure not compatible with the module system.
|
||||
: IO (Environment × MessageLog) := do
|
||||
processHeaderCore header.startPos header.imports header.isModule
|
||||
opts messages inputCtx trustLevel plugins leakEnv mainModule
|
||||
(headerStx? := header)
|
||||
|
||||
def parseImports (input : String) (fileName : Option String := none) : IO (Array Import × Position × MessageLog) := do
|
||||
let fileName := fileName.getD "<input>"
|
||||
|
||||
@@ -73,8 +73,9 @@ def splitMatchOrCasesOn (mvarId : MVarId) (e : Expr) (matcherInfo : MatcherInfo)
|
||||
if (← isMatcherApp e) then
|
||||
Split.splitMatch mvarId e
|
||||
else
|
||||
assert! matcherInfo.numDiscrs = 1
|
||||
let discr := e.getAppArgs[matcherInfo.numParams + 1]!
|
||||
-- For casesOn, the last discriminant is the major premise;
|
||||
-- `cases` will handle any index discriminants automatically.
|
||||
let discr := e.getAppArgs[matcherInfo.numParams + matcherInfo.numDiscrs]!
|
||||
assert! discr.isFVar
|
||||
let subgoals ← mvarId.cases discr.fvarId!
|
||||
return subgoals.map (·.mvarId) |>.toList
|
||||
|
||||
@@ -7,6 +7,7 @@ module
|
||||
|
||||
prelude
|
||||
public import Lean.Elab.Quotation.Util
|
||||
import Lean.Elab.DeprecatedSyntax
|
||||
|
||||
public section
|
||||
|
||||
@@ -56,6 +57,14 @@ unsafe builtin_initialize precheckAttribute : KeyedDeclsAttribute Precheck ←
|
||||
}
|
||||
|
||||
partial def precheck : Precheck := fun stx => do
|
||||
-- Check for deprecated syntax kinds in quotations
|
||||
if let some entry := (deprecatedSyntaxExt.getState (← getEnv)).find? stx.getKind then
|
||||
let extraMsg := match entry.text? with
|
||||
| some text => m!": {text}"
|
||||
| none => m!""
|
||||
withRef stx do
|
||||
Linter.logLintIf Linter.linter.deprecated.syntax stx
|
||||
m!"quotation uses deprecated syntax '{stx.getKind}'{extraMsg}"
|
||||
if let p::_ := precheckAttribute.getValues (← getEnv) stx.getKind then
|
||||
if ← catchInternalId unsupportedSyntaxExceptionId (do withRef stx <| p stx; pure true) (fun _ => pure false) then
|
||||
return
|
||||
|
||||
@@ -582,6 +582,7 @@ mutual
|
||||
-- We use `filterRevM` instead of `filterM` to make sure we process the synthetic metavariables using the order they were created.
|
||||
-- It would not be incorrect to use `filterM`.
|
||||
let remainingPendingMVars ← pendingMVars.filterRevM fun mvarId => do
|
||||
checkSystem "synthesize pending MVars"
|
||||
-- We use `traceM` because we want to make sure the metavar local context is used to trace the message
|
||||
traceM `Elab.postpone (mvarId.withContext do addMessageContext m!"resuming {mkMVar mvarId}")
|
||||
let succeeded ← synthesizeSyntheticMVar mvarId postponeOnError runTactics
|
||||
|
||||
@@ -8,6 +8,7 @@ module
|
||||
prelude
|
||||
public import Lean.Meta.Tactic.Util
|
||||
public import Lean.Elab.Term
|
||||
import Lean.Elab.DeprecatedSyntax
|
||||
import Init.Omega
|
||||
|
||||
public section
|
||||
@@ -192,6 +193,7 @@ partial def evalTactic (stx : Syntax) : TacticM Unit := do
|
||||
Term.withoutTacticIncrementality true <| withTacticInfoContext stx do
|
||||
stx.getArgs.forM evalTactic
|
||||
else withTraceNode `Elab.step (fun _ => return stx) (tag := stx.getKind.toString) do
|
||||
checkDeprecatedSyntax stx (← readThe Term.Context).macroStack
|
||||
let evalFns := tacticElabAttribute.getEntries (← getEnv) stx.getKind
|
||||
let macros := macroAttribute.getEntries (← getEnv) stx.getKind
|
||||
if evalFns.isEmpty && macros.isEmpty then
|
||||
|
||||
@@ -7,6 +7,8 @@ module
|
||||
prelude
|
||||
public import Lean.Elab.Tactic.Grind.Basic
|
||||
import Lean.Elab.Tactic.ConfigSetter
|
||||
import Lean.Elab.DeprecatedSyntax -- shake: skip (workaround for `mkConfigSetter` failing to interpret `deprecatedSyntaxExt`, to be fixed)
|
||||
|
||||
public section
|
||||
namespace Lean.Elab.Tactic.Grind
|
||||
|
||||
|
||||
@@ -9,6 +9,7 @@ prelude
|
||||
public import Lean.Meta.Coe
|
||||
public import Lean.Util.CollectLevelMVars
|
||||
public import Lean.Linter.Deprecated
|
||||
import Lean.Elab.DeprecatedSyntax
|
||||
public import Lean.Elab.Attributes
|
||||
public import Lean.Elab.Level
|
||||
public import Lean.Elab.PreDefinition.TerminationHint
|
||||
@@ -1794,6 +1795,7 @@ private partial def elabTermAux (expectedType? : Option Expr) (catchExPostpone :
|
||||
withTraceNode `Elab.step (fun _ => return m!"expected type: {expectedType?}, term\n{stx}")
|
||||
(tag := stx.getKind.toString) do
|
||||
checkSystem "elaborator"
|
||||
checkDeprecatedSyntax stx (← read).macroStack
|
||||
let env ← getEnv
|
||||
let result ← match (← liftMacroM (expandMacroImpl? env stx)) with
|
||||
| some (decl, stxNew?) =>
|
||||
|
||||
@@ -245,7 +245,7 @@ We use this combinator to prevent stack overflows.
|
||||
@[inline] def withIncRecDepth [Monad m] [MonadError m] [MonadRecDepth m] (x : m α) : m α := do
|
||||
let curr ← MonadRecDepth.getRecDepth
|
||||
let max ← MonadRecDepth.getMaxRecDepth
|
||||
if curr == max then
|
||||
if max != 0 && curr == max then
|
||||
throwMaxRecDepthAt (← getRef)
|
||||
else
|
||||
MonadRecDepth.withRecDepth (curr+1) x
|
||||
|
||||
@@ -478,11 +478,11 @@ where
|
||||
}
|
||||
result? := some {
|
||||
parserState
|
||||
processedSnap := (← processHeader ⟨trimmedStx⟩ parserState)
|
||||
processedSnap := (← processHeader ⟨trimmedStx⟩ stx parserState)
|
||||
}
|
||||
}
|
||||
|
||||
processHeader (stx : HeaderSyntax) (parserState : Parser.ModuleParserState) :
|
||||
processHeader (stx : HeaderSyntax) (origStx : HeaderSyntax) (parserState : Parser.ModuleParserState) :
|
||||
LeanProcessingM (SnapshotTask HeaderProcessedSnapshot) := do
|
||||
let ctx ← read
|
||||
SnapshotTask.ofIO none none (.some ⟨0, ctx.endPos⟩) <|
|
||||
@@ -498,6 +498,7 @@ where
|
||||
let (headerEnv, msgLog) ← Elab.processHeaderCore (leakEnv := true)
|
||||
stx.startPos setup.imports setup.isModule setup.opts .empty ctx.toInputContext
|
||||
setup.trustLevel setup.plugins setup.mainModuleName setup.package? setup.importArts
|
||||
(headerStx? := stx) (origHeaderStx? := origStx)
|
||||
let stopTime := (← IO.monoNanosNow).toFloat / 1000000000
|
||||
let diagnostics := (← Snapshot.Diagnostics.ofMessageLog msgLog)
|
||||
if msgLog.hasErrors then
|
||||
|
||||
@@ -441,18 +441,27 @@ def Result.imax : Result → Result → Result
|
||||
| f, Result.imaxNode Fs => Result.imaxNode (f::Fs)
|
||||
| f₁, f₂ => Result.imaxNode [f₁, f₂]
|
||||
|
||||
def toResult (l : Level) (mvars : Bool) : Result :=
|
||||
structure Context where
|
||||
mvars : Bool
|
||||
lIndex? : LMVarId → Option Nat
|
||||
|
||||
abbrev M := ReaderM Context
|
||||
|
||||
def toResult (l : Level) : M Result := do
|
||||
match l with
|
||||
| zero => Result.num 0
|
||||
| succ l => Result.succ (toResult l mvars)
|
||||
| max l₁ l₂ => Result.max (toResult l₁ mvars) (toResult l₂ mvars)
|
||||
| imax l₁ l₂ => Result.imax (toResult l₁ mvars) (toResult l₂ mvars)
|
||||
| param n => Result.leaf n
|
||||
| zero => return Result.num 0
|
||||
| succ l => return Result.succ (← toResult l)
|
||||
| max l₁ l₂ => return Result.max (← toResult l₁) (← toResult l₂)
|
||||
| imax l₁ l₂ => return Result.imax (← toResult l₁) (← toResult l₂)
|
||||
| param n => return Result.leaf n
|
||||
| mvar n =>
|
||||
if mvars then
|
||||
Result.leaf <| n.name.replacePrefix `_uniq (Name.mkSimple "?u")
|
||||
if !(← read).mvars then
|
||||
return Result.leaf `_
|
||||
else if let some i := (← read).lIndex? n then
|
||||
return Result.leaf <| Name.num (Name.mkSimple "?u") (i + 1)
|
||||
else
|
||||
Result.leaf `_
|
||||
-- Undefined mvar, use internal name
|
||||
return Result.leaf <| n.name.replacePrefix `_uniq (Name.mkSimple "?_mvar")
|
||||
|
||||
private def parenIfFalse : Format → Bool → Format
|
||||
| f, true => f
|
||||
@@ -469,7 +478,7 @@ mutual
|
||||
| Result.offset f 0, r => format f r
|
||||
| Result.offset f (k+1), r =>
|
||||
let f' := format f false;
|
||||
parenIfFalse (f' ++ "+" ++ Std.format (k+1)) r
|
||||
parenIfFalse (f' ++ " + " ++ Std.format (k+1)) r
|
||||
| Result.maxNode fs, r => parenIfFalse (Format.group <| "max" ++ formatLst fs) r
|
||||
| Result.imaxNode fs, r => parenIfFalse (Format.group <| "imax" ++ formatLst fs) r
|
||||
end
|
||||
@@ -487,20 +496,20 @@ protected partial def Result.quote (r : Result) (prec : Nat) : Syntax.Level :=
|
||||
|
||||
end PP
|
||||
|
||||
protected def format (u : Level) (mvars : Bool) : Format :=
|
||||
(PP.toResult u mvars).format true
|
||||
protected def format (u : Level) (mvars : Bool) (lIndex? : LMVarId → Option Nat) : Format :=
|
||||
(PP.toResult u) |>.run { mvars, lIndex? } |>.format true
|
||||
|
||||
instance : ToFormat Level where
|
||||
format u := Level.format u (mvars := true)
|
||||
format u := Level.format u (mvars := true) (lIndex? := fun _ => none)
|
||||
|
||||
instance : ToString Level where
|
||||
toString u := Format.pretty (format u)
|
||||
|
||||
protected def quote (u : Level) (prec : Nat := 0) (mvars : Bool := true) : Syntax.Level :=
|
||||
(PP.toResult u (mvars := mvars)).quote prec
|
||||
protected def quote (u : Level) (prec : Nat := 0) (mvars : Bool := true) (lIndex? : LMVarId → Option Nat) : Syntax.Level :=
|
||||
(PP.toResult u) |>.run { mvars, lIndex? } |>.quote prec
|
||||
|
||||
instance : Quote Level `level where
|
||||
quote := Level.quote
|
||||
quote := Level.quote (lIndex? := fun _ => none)
|
||||
|
||||
end Level
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -66,7 +66,11 @@ Helper function for running `MetaM` code during module export, when there is not
|
||||
Panics on errors.
|
||||
-/
|
||||
unsafe def _root_.Lean.Environment.unsafeRunMetaM [Inhabited α] (env : Environment) (x : MetaM α) : α :=
|
||||
match unsafeEIO ((((withoutExporting x).run' {} {}).run' { fileName := "symbolFrequency", fileMap := default } { env })) with
|
||||
match unsafeEIO ((((withoutExporting x).run' {} {}).run'
|
||||
{ fileName := "symbolFrequency", fileMap := default
|
||||
-- avoid triggering since limit cannot be raised here
|
||||
maxHeartbeats := 0 }
|
||||
{ env })) with
|
||||
| Except.ok a => a
|
||||
| Except.error ex => panic! match unsafeIO ex.toMessageData.toString with
|
||||
| Except.ok s => s
|
||||
|
||||
@@ -112,15 +112,37 @@ builtin_initialize
|
||||
def lint (stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
logLint linter.missingDocs stx m!"missing doc string for {msg}"
|
||||
|
||||
def lintEmpty (stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
logLint linter.missingDocs stx m!"empty doc string for {msg}"
|
||||
|
||||
def lintNamed (stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
lint stx s!"{msg} {stx.getId}"
|
||||
|
||||
def lintEmptyNamed (stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
lintEmpty stx s!"{msg} {stx.getId}"
|
||||
|
||||
def lintField (parent stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
lint stx s!"{msg} {parent.getId}.{stx.getId}"
|
||||
|
||||
def lintEmptyField (parent stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
lintEmpty stx s!"{msg} {parent.getId}.{stx.getId}"
|
||||
|
||||
def lintStructField (parent stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
lint stx s!"{msg} {parent.getId}.{stx.getId}"
|
||||
|
||||
private def isEmptyDocString (docOpt : Syntax) : CommandElabM Bool := do
|
||||
if docOpt.isNone then return false
|
||||
let docStx : TSyntax `Lean.Parser.Command.docComment := ⟨docOpt[0]⟩
|
||||
-- Verso doc comments with interpolated content cannot be extracted as plain text,
|
||||
-- but they are clearly not empty.
|
||||
if let .node _ `Lean.Parser.Command.versoCommentBody _ := docStx.raw[1] then
|
||||
if !docStx.raw[1][0].isAtom then return false
|
||||
let text ← getDocStringText docStx
|
||||
return text.trimAscii.isEmpty
|
||||
|
||||
def isMissingDoc (docOpt : Syntax) : CommandElabM Bool := do
|
||||
return docOpt.isNone || (← isEmptyDocString docOpt)
|
||||
|
||||
def hasInheritDoc (attrs : Syntax) : Bool :=
|
||||
attrs[0][1].getSepArgs.any fun attr =>
|
||||
attr[1].isOfKind ``Parser.Attr.simple &&
|
||||
@@ -130,38 +152,68 @@ def hasTacticAlt (attrs : Syntax) : Bool :=
|
||||
attrs[0][1].getSepArgs.any fun attr =>
|
||||
attr[1].isOfKind ``Parser.Attr.tactic_alt
|
||||
|
||||
def declModifiersPubNoDoc (mods : Syntax) : CommandElabM Bool := do
|
||||
def declModifiersDocStatus (mods : Syntax) : CommandElabM (Option Bool) := do
|
||||
let isPublic := if (← getEnv).header.isModule && !(← getScope).isPublic then
|
||||
mods[2][0].getKind == ``Command.public else
|
||||
mods[2][0].getKind != ``Command.private
|
||||
return isPublic && mods[0].isNone && !hasInheritDoc mods[1]
|
||||
if !isPublic || hasInheritDoc mods[1] then return none
|
||||
if mods[0].isNone then return some false
|
||||
if (← isEmptyDocString mods[0]) then return some true
|
||||
return none
|
||||
|
||||
def lintDeclHead (k : SyntaxNodeKind) (id : Syntax) : CommandElabM Unit := do
|
||||
if k == ``«abbrev» then lintNamed id "public abbrev"
|
||||
else if k == ``definition then lintNamed id "public def"
|
||||
else if k == ``«opaque» then lintNamed id "public opaque"
|
||||
else if k == ``«axiom» then lintNamed id "public axiom"
|
||||
else if k == ``«inductive» then lintNamed id "public inductive"
|
||||
else if k == ``classInductive then lintNamed id "public inductive"
|
||||
else if k == ``«structure» then lintNamed id "public structure"
|
||||
def declModifiersPubNoDoc (mods : Syntax) : CommandElabM Bool := do
|
||||
return (← declModifiersDocStatus mods).isSome
|
||||
|
||||
private def lintDocStatus (isEmpty : Bool) (stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
if isEmpty then lintEmpty stx msg else lint stx msg
|
||||
|
||||
private def lintDocStatusNamed (isEmpty : Bool) (stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
if isEmpty then lintEmptyNamed stx msg else lintNamed stx msg
|
||||
|
||||
private def lintDocStatusField (isEmpty : Bool) (parent stx : Syntax) (msg : String) :
|
||||
CommandElabM Unit :=
|
||||
if isEmpty then lintEmptyField parent stx msg else lintField parent stx msg
|
||||
|
||||
def lintDeclHead (k : SyntaxNodeKind) (id : Syntax) (isEmpty : Bool := false) :
|
||||
CommandElabM Unit := do
|
||||
if k == ``«abbrev» then lintDocStatusNamed isEmpty id "public abbrev"
|
||||
else if k == ``definition then lintDocStatusNamed isEmpty id "public def"
|
||||
else if k == ``«opaque» then lintDocStatusNamed isEmpty id "public opaque"
|
||||
else if k == ``«axiom» then lintDocStatusNamed isEmpty id "public axiom"
|
||||
else if k == ``«inductive» then lintDocStatusNamed isEmpty id "public inductive"
|
||||
else if k == ``classInductive then lintDocStatusNamed isEmpty id "public inductive"
|
||||
else if k == ``«structure» then lintDocStatusNamed isEmpty id "public structure"
|
||||
|
||||
private def docOptStatus (docOpt attrs : Syntax) (checkTacticAlt := false) :
|
||||
CommandElabM (Option Bool) := do
|
||||
if hasInheritDoc attrs then return none
|
||||
if checkTacticAlt && hasTacticAlt attrs then return none
|
||||
if docOpt.isNone then return some false
|
||||
if (← isEmptyDocString docOpt) then return some true
|
||||
return none
|
||||
|
||||
@[builtin_missing_docs_handler declaration]
|
||||
def checkDecl : SimpleHandler := fun stx => do
|
||||
let head := stx[0]; let rest := stx[1]
|
||||
if head[2][0].getKind == ``Command.private then return -- not private
|
||||
let k := rest.getKind
|
||||
if (← declModifiersPubNoDoc head) then -- no doc string
|
||||
lintDeclHead k rest[1][0]
|
||||
if let some isEmpty ← declModifiersDocStatus head then
|
||||
lintDeclHead k rest[1][0] isEmpty
|
||||
if k == ``«inductive» || k == ``classInductive then
|
||||
for stx in rest[4].getArgs do
|
||||
let head := stx[2]
|
||||
if stx[0].isNone && (← declModifiersPubNoDoc head) then
|
||||
lintField rest[1][0] stx[3] "public constructor"
|
||||
-- Constructor has two doc comment positions: the leading one before `|` (stx[0])
|
||||
-- and the one inside declModifiers (head[0]). If either is non-empty, skip.
|
||||
let leadingEmpty ← isEmptyDocString stx[0]
|
||||
if !stx[0].isNone && !leadingEmpty then
|
||||
pure () -- constructor has a non-empty leading doc comment
|
||||
else if let some modsEmpty ← declModifiersDocStatus head then
|
||||
lintDocStatusField (leadingEmpty || modsEmpty) rest[1][0] stx[3] "public constructor"
|
||||
unless rest[5].isNone do
|
||||
for stx in rest[5][0][1].getArgs do
|
||||
let head := stx[0]
|
||||
if (← declModifiersPubNoDoc head) then -- no doc string
|
||||
lintField rest[1][0] stx[1] "computed field"
|
||||
if let some isEmpty ← declModifiersDocStatus head then
|
||||
lintDocStatusField isEmpty rest[1][0] stx[1] "computed field"
|
||||
else if rest.getKind == ``«structure» then
|
||||
unless rest[4][2].isNone do
|
||||
let redecls : Std.HashSet String.Pos.Raw :=
|
||||
@@ -173,45 +225,52 @@ def checkDecl : SimpleHandler := fun stx => do
|
||||
else s
|
||||
else s
|
||||
let parent := rest[1][0]
|
||||
let lint1 stx := do
|
||||
let lint1 isEmpty stx := do
|
||||
if let some range := stx.getRange? then
|
||||
if redecls.contains range.start then return
|
||||
lintField parent stx "public field"
|
||||
lintDocStatusField isEmpty parent stx "public field"
|
||||
for stx in rest[4][2][0].getArgs do
|
||||
let head := stx[0]
|
||||
if (← declModifiersPubNoDoc head) then
|
||||
if let some isEmpty ← declModifiersDocStatus head then
|
||||
if stx.getKind == ``structSimpleBinder then
|
||||
lint1 stx[1]
|
||||
lint1 isEmpty stx[1]
|
||||
else
|
||||
for stx in stx[2].getArgs do
|
||||
lint1 stx
|
||||
lint1 isEmpty stx
|
||||
|
||||
@[builtin_missing_docs_handler «initialize»]
|
||||
def checkInit : SimpleHandler := fun stx => do
|
||||
if !stx[2].isNone && (← declModifiersPubNoDoc stx[0]) then
|
||||
lintNamed stx[2][0] "initializer"
|
||||
if !stx[2].isNone then
|
||||
if let some isEmpty ← declModifiersDocStatus stx[0] then
|
||||
lintDocStatusNamed isEmpty stx[2][0] "initializer"
|
||||
|
||||
@[builtin_missing_docs_handler «notation»]
|
||||
def checkNotation : SimpleHandler := fun stx => do
|
||||
if stx[0].isNone && stx[2][0][0].getKind != ``«local» && !hasInheritDoc stx[1] then
|
||||
if stx[5].isNone then lint stx[3] "notation"
|
||||
else lintNamed stx[5][0][3] "notation"
|
||||
if stx[2][0][0].getKind != ``«local» then
|
||||
if let some isEmpty ← docOptStatus stx[0] stx[1] then
|
||||
if stx[5].isNone then lintDocStatus isEmpty stx[3] "notation"
|
||||
else lintDocStatusNamed isEmpty stx[5][0][3] "notation"
|
||||
|
||||
@[builtin_missing_docs_handler «mixfix»]
|
||||
def checkMixfix : SimpleHandler := fun stx => do
|
||||
if stx[0].isNone && stx[2][0][0].getKind != ``«local» && !hasInheritDoc stx[1] then
|
||||
if stx[5].isNone then lint stx[3] stx[3][0].getAtomVal
|
||||
else lintNamed stx[5][0][3] stx[3][0].getAtomVal
|
||||
if stx[2][0][0].getKind != ``«local» then
|
||||
if let some isEmpty ← docOptStatus stx[0] stx[1] then
|
||||
if stx[5].isNone then lintDocStatus isEmpty stx[3] stx[3][0].getAtomVal
|
||||
else lintDocStatusNamed isEmpty stx[5][0][3] stx[3][0].getAtomVal
|
||||
|
||||
@[builtin_missing_docs_handler «syntax»]
|
||||
def checkSyntax : SimpleHandler := fun stx => do
|
||||
if stx[0].isNone && stx[2][0][0].getKind != ``«local» && !hasInheritDoc stx[1] && !hasTacticAlt stx[1] then
|
||||
if stx[5].isNone then lint stx[3] "syntax"
|
||||
else lintNamed stx[5][0][3] "syntax"
|
||||
if stx[2][0][0].getKind != ``«local» then
|
||||
if let some isEmpty ← docOptStatus stx[0] stx[1] (checkTacticAlt := true) then
|
||||
if stx[5].isNone then lintDocStatus isEmpty stx[3] "syntax"
|
||||
else lintDocStatusNamed isEmpty stx[5][0][3] "syntax"
|
||||
|
||||
def mkSimpleHandler (name : String) (declNameStxIdx := 2) : SimpleHandler := fun stx => do
|
||||
if stx[0].isNone then
|
||||
lintNamed stx[declNameStxIdx] name
|
||||
if (← isMissingDoc stx[0]) then
|
||||
if (← isEmptyDocString stx[0]) then
|
||||
lintEmptyNamed stx[declNameStxIdx] name
|
||||
else
|
||||
lintNamed stx[declNameStxIdx] name
|
||||
|
||||
@[builtin_missing_docs_handler syntaxAbbrev]
|
||||
def checkSyntaxAbbrev : SimpleHandler := mkSimpleHandler "syntax"
|
||||
@@ -221,20 +280,22 @@ def checkSyntaxCat : SimpleHandler := mkSimpleHandler "syntax category"
|
||||
|
||||
@[builtin_missing_docs_handler «macro»]
|
||||
def checkMacro : SimpleHandler := fun stx => do
|
||||
if stx[0].isNone && stx[2][0][0].getKind != ``«local» && !hasInheritDoc stx[1] && !hasTacticAlt stx[1] then
|
||||
if stx[5].isNone then lint stx[3] "macro"
|
||||
else lintNamed stx[5][0][3] "macro"
|
||||
if stx[2][0][0].getKind != ``«local» then
|
||||
if let some isEmpty ← docOptStatus stx[0] stx[1] (checkTacticAlt := true) then
|
||||
if stx[5].isNone then lintDocStatus isEmpty stx[3] "macro"
|
||||
else lintDocStatusNamed isEmpty stx[5][0][3] "macro"
|
||||
|
||||
@[builtin_missing_docs_handler «elab»]
|
||||
def checkElab : SimpleHandler := fun stx => do
|
||||
if stx[0].isNone && stx[2][0][0].getKind != ``«local» && !hasInheritDoc stx[1] && !hasTacticAlt stx[1] then
|
||||
if stx[5].isNone then lint stx[3] "elab"
|
||||
else lintNamed stx[5][0][3] "elab"
|
||||
if stx[2][0][0].getKind != ``«local» then
|
||||
if let some isEmpty ← docOptStatus stx[0] stx[1] (checkTacticAlt := true) then
|
||||
if stx[5].isNone then lintDocStatus isEmpty stx[3] "elab"
|
||||
else lintDocStatusNamed isEmpty stx[5][0][3] "elab"
|
||||
|
||||
@[builtin_missing_docs_handler classAbbrev]
|
||||
def checkClassAbbrev : SimpleHandler := fun stx => do
|
||||
if (← declModifiersPubNoDoc stx[0]) then
|
||||
lintNamed stx[3] "class abbrev"
|
||||
if let some isEmpty ← declModifiersDocStatus stx[0] then
|
||||
lintDocStatusNamed isEmpty stx[3] "class abbrev"
|
||||
|
||||
@[builtin_missing_docs_handler Parser.Tactic.declareSimpLikeTactic]
|
||||
def checkSimpLike : SimpleHandler := mkSimpleHandler "simp-like tactic"
|
||||
@@ -244,8 +305,8 @@ def checkRegisterBuiltinOption : SimpleHandler := mkSimpleHandler (declNameStxId
|
||||
|
||||
@[builtin_missing_docs_handler Option.registerOption]
|
||||
def checkRegisterOption : SimpleHandler := fun stx => do
|
||||
if (← declModifiersPubNoDoc stx[0]) then
|
||||
lintNamed stx[2] "option"
|
||||
if let some isEmpty ← declModifiersDocStatus stx[0] then
|
||||
lintDocStatusNamed isEmpty stx[2] "option"
|
||||
|
||||
@[builtin_missing_docs_handler registerSimpAttr]
|
||||
def checkRegisterSimpAttr : SimpleHandler := mkSimpleHandler "simp attr"
|
||||
|
||||
@@ -244,7 +244,7 @@ def ofLevel (l : Level) : MessageData :=
|
||||
.ofLazy
|
||||
(fun ctx? => do
|
||||
let msg ← ofFormat <$> match ctx? with
|
||||
| .none => pure (format l)
|
||||
| .none => pure (l.format true (fun _ => none))
|
||||
| .some ctx => ppLevel ctx l
|
||||
return Dynamic.mk msg)
|
||||
(fun _ => false)
|
||||
|
||||
@@ -6,6 +6,7 @@ Authors: Leonardo de Moura
|
||||
module
|
||||
prelude
|
||||
public import Lean.Meta.Basic
|
||||
public import Lean.Meta.HasAssignableMVar
|
||||
public import Lean.Meta.LevelDefEq
|
||||
public import Lean.Meta.WHNF
|
||||
public import Lean.Meta.InferType
|
||||
|
||||
@@ -70,6 +70,7 @@ structure Context where
|
||||
abbrev M := ReaderT Context $ MonadCacheT ExprStructEq Expr MetaM
|
||||
|
||||
partial def visit (e : Expr) : M Expr := do
|
||||
checkSystem "abstract nested proofs"
|
||||
if e.isAtomic then
|
||||
pure e
|
||||
else
|
||||
|
||||
@@ -8,6 +8,7 @@ prelude
|
||||
public import Lean.Meta.SynthInstance
|
||||
public import Lean.Meta.DecLevel
|
||||
import Lean.Meta.CtorRecognizer
|
||||
public import Lean.Meta.HasAssignableMVar
|
||||
import Lean.Structure
|
||||
import Init.Omega
|
||||
public section
|
||||
|
||||
54
src/Lean/Meta/HasAssignableMVar.lean
Normal file
54
src/Lean/Meta/HasAssignableMVar.lean
Normal file
@@ -0,0 +1,54 @@
|
||||
/-
|
||||
Copyright (c) 2019 Microsoft Corporation. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Lean.Meta.Basic
|
||||
|
||||
public section
|
||||
|
||||
open Lean
|
||||
|
||||
namespace Lean.Meta
|
||||
|
||||
def hasAssignableLevelMVar : Level → MetaM Bool
|
||||
| .succ lvl => pure lvl.hasMVar <&&> hasAssignableLevelMVar lvl
|
||||
| .max lvl₁ lvl₂ => (pure lvl₁.hasMVar <&&> hasAssignableLevelMVar lvl₁) <||> (pure lvl₂.hasMVar <&&> hasAssignableLevelMVar lvl₂)
|
||||
| .imax lvl₁ lvl₂ => (pure lvl₁.hasMVar <&&> hasAssignableLevelMVar lvl₁) <||> (pure lvl₂.hasMVar <&&> hasAssignableLevelMVar lvl₂)
|
||||
| .mvar mvarId => isLevelMVarAssignable mvarId
|
||||
| .zero => return false
|
||||
| .param _ => return false
|
||||
|
||||
/-- Return `true` iff expression contains a metavariable that can be assigned. -/
|
||||
partial def hasAssignableMVar (e : Expr) : MetaM Bool :=
|
||||
if !e.hasMVar then
|
||||
return false
|
||||
else
|
||||
go e |>.run' {}
|
||||
where
|
||||
go (e : Expr) : StateRefT ExprSet MetaM Bool :=
|
||||
match e with
|
||||
| .const _ lvls => lvls.anyM (liftM <| hasAssignableLevelMVar ·)
|
||||
| .sort lvl => liftM <| hasAssignableLevelMVar lvl
|
||||
| .app f a => do checkSystem "hasAssignableMVar"; visit f <||> visit a
|
||||
| .letE _ t v b _ => do checkSystem "hasAssignableMVar"; visit t <||> visit v <||> visit b
|
||||
| .forallE _ d b _ => do checkSystem "hasAssignableMVar"; visit d <||> visit b
|
||||
| .lam _ d b _ => do checkSystem "hasAssignableMVar"; visit d <||> visit b
|
||||
| .fvar _ => return false
|
||||
| .bvar _ => return false
|
||||
| .lit _ => return false
|
||||
| .mdata _ e => visit e
|
||||
| .proj _ _ e => visit e
|
||||
| .mvar mvarId => mvarId.isAssignable
|
||||
visit (e : Expr) : StateRefT ExprSet MetaM Bool := do
|
||||
if !e.hasMVar then return false
|
||||
if (← get).contains e then return false
|
||||
modify fun s => s.insert e
|
||||
go e
|
||||
|
||||
end Lean.Meta
|
||||
|
||||
end
|
||||
@@ -8,6 +8,7 @@ module
|
||||
prelude
|
||||
public import Lean.Util.CollectMVars
|
||||
public import Lean.Meta.DecLevel
|
||||
public import Lean.Meta.HasAssignableMVar
|
||||
|
||||
public section
|
||||
|
||||
|
||||
@@ -27,6 +27,10 @@ applications, foralls, lambdas, and let-bindings, classifying each argument as a
|
||||
implicit, or value using `shouldCanon`. Values are recursively visited but not normalized.
|
||||
Types and instances receive targeted reductions.
|
||||
|
||||
**Note about types:** `grind` is not built for reasoning about types that are not propositions.
|
||||
We assume that definitionally equal types will be structurally identical after we apply the
|
||||
canonicalizer. We also erase most of the subsingleton markers occurring inside types.
|
||||
|
||||
## Reductions (applied only in type positions)
|
||||
|
||||
- **Eta**: `fun x => f x` → `f`
|
||||
@@ -39,7 +43,19 @@ Types and instances receive targeted reductions.
|
||||
|
||||
Instances are re-synthesized via `synthInstance`. The instance type is first normalized
|
||||
using the type-level reductions above, so that `OfNat (Fin (2+1)) 0` and `OfNat (Fin 3) 0`
|
||||
produce the same canonical instance.
|
||||
produce the same canonical instance. Two special cases:
|
||||
|
||||
- **`Decidable` instances** (`Grind.nestedDecidable`): the proposition is recursively
|
||||
canonicalized, then the `Decidable` instance is re-synthesized. If resynthesis fails,
|
||||
the original instance is kept (users often provide these via `haveI`).
|
||||
A `checkDefEqInst` guard is required because structurally different `Decidable` instances
|
||||
are not necessarily definitionally equal.
|
||||
|
||||
- **Propositional instances** (`Grind.nestedProof`): the proposition is recursively
|
||||
canonicalized, then the proof is re-synthesized. If resynthesis fails, the original
|
||||
proof is kept. No definitional-equality check is needed thanks to proof irrelevance.
|
||||
|
||||
Inside types, both cases are strict: resynthesis failure is reported as an issue.
|
||||
|
||||
## Two caches
|
||||
|
||||
@@ -246,23 +262,81 @@ where
|
||||
else
|
||||
withReader (fun ctx => { ctx with insideType := true }) <| canon e
|
||||
|
||||
canonInst (e : Expr) : CanonM Expr := do
|
||||
if let some inst := (← get).canon.cacheInsts.get? e then
|
||||
checkDefEqInst e inst
|
||||
/--
|
||||
Canonicalize `e : type` where `e` is an instance by trying to resynthesize `type`.
|
||||
We report an issue if the instance cannot be resynthesized.
|
||||
-/
|
||||
canonInstCore (e : Expr) (type : Expr) : CanonM Expr := do
|
||||
let some inst ← Sym.synthInstance? type |
|
||||
reportIssue! "failed to canonicalize instance{indentExpr e}\nfailed to synthesize{indentExpr type}"
|
||||
return e
|
||||
checkDefEqInst e inst
|
||||
|
||||
/--
|
||||
Canonicalize an instance by trying to resynthesize it without caching.
|
||||
Recall that we have special support for `Decidable` and propositional instances.
|
||||
-/
|
||||
canonInst' (e : Expr) : CanonM Expr := do
|
||||
/-
|
||||
We normalize the type to make sure `OfNat (Fin (2+1)) 1` and `OfNat (Fin 3) 1` will produce
|
||||
the same instances.
|
||||
-/
|
||||
let type ← inferType e
|
||||
let type' ← canonInsideType' type
|
||||
canonInstCore e type'
|
||||
|
||||
/-- `withCaching` + `canonInst'` -/
|
||||
canonInst (e : Expr) : CanonM Expr := withCaching e do
|
||||
canonInst' e
|
||||
|
||||
/--
|
||||
Canonicalize a proposition that is also a term instance.
|
||||
Given a term `e` of the form `@Grind.nestedProof prop h`, where `g` is the constant `Grind.nestedProof`,
|
||||
we canonicalize it as follows:
|
||||
1- We recursively canonicalize the proposition `prop`.
|
||||
2- Try to resynthesize the instance, but keep the original one in case of failure since users often
|
||||
provide them using `haveI`.
|
||||
-/
|
||||
canonInstProp (g : Expr) (prop : Expr) (h : Expr) (e : Expr) : CanonM Expr := withCaching e do
|
||||
let prop' ← canon prop
|
||||
if (← read).insideType then
|
||||
canonInstCore h prop'
|
||||
else
|
||||
/-
|
||||
We normalize the type to make sure `OfNat (Fin (2+1)) 1` and `OfNat (Fin 3) 1` will produce
|
||||
the same instances.
|
||||
**Note**: We try to resynthesize the proposition, but if it fails we keep the current one.
|
||||
This may happen because propositional instances are often provided manually using `haveI`.
|
||||
-/
|
||||
let type ← inferType e
|
||||
let type' ← canonInsideType' type
|
||||
let some inst ← Sym.synthInstance? type' |
|
||||
reportIssue! "failed to canonicalize instance{indentExpr e}\nfailed to synthesize{indentExpr type'}"
|
||||
return e
|
||||
let inst ← checkDefEqInst e inst
|
||||
-- Remark: we cache result using the type **before** canonicalization.
|
||||
modify fun s => { s with canon.cacheInsts := s.canon.cacheInsts.insert e inst }
|
||||
return inst
|
||||
let h' := (← Sym.synthInstance? prop').getD h
|
||||
/- **Note**: We don't need to check whether `h` and `h'` are definitionally equal because of proof irrelevance. -/
|
||||
return if isSameExpr prop prop' && isSameExpr h h' then e else mkApp2 g prop' h'
|
||||
|
||||
/--
|
||||
Canonicalize a decidable instance without checking the cache.
|
||||
Given a term `e` of the form `@Grind.nestedDecidable prop inst`, where `g` is the constant `Grind.nestedDecidable`,
|
||||
we canonicalize it as follows:
|
||||
1- We recursively canonicalize the proposition `prop`.
|
||||
2- Try to resynthesize the instance, but keep the original one in case of failure since users often
|
||||
provide them using `haveI`.
|
||||
-/
|
||||
canonInstDec' (g : Expr) (prop : Expr) (inst : Expr) (e : Expr) : CanonM Expr := do
|
||||
let prop' ← canon prop
|
||||
let type := mkApp (mkConst ``Decidable) prop'
|
||||
if (← read).insideType then
|
||||
canonInstCore inst type
|
||||
else
|
||||
/-
|
||||
**Note**: We try to resynthesize the instance, but if it fails we keep the current one.
|
||||
We use `checkDefEqInst` here because two structurally different decidable instances are not necessarily
|
||||
definitionally equal.
|
||||
This may happen because propositional instances are often provided manually using `haveI`.
|
||||
-/
|
||||
let inst' := (← Sym.synthInstance? type).getD inst
|
||||
let inst' ← checkDefEqInst inst inst'
|
||||
return if isSameExpr prop prop' && isSameExpr inst inst' then e else mkApp2 g prop' inst'
|
||||
|
||||
/-- `withCaching` + `canonInstDec'` -/
|
||||
canonInstDec (g : Expr) (prop : Expr) (h : Expr) (e : Expr) : CanonM Expr := withCaching e do
|
||||
canonInstDec' g prop h e
|
||||
|
||||
canonLambda (e : Expr) : CanonM Expr := do
|
||||
if (← read).insideType then
|
||||
@@ -295,54 +369,50 @@ where
|
||||
mkLetFVars (generalizeNondepLet := false) fvars (← canon (e.instantiateRev fvars))
|
||||
|
||||
canonAppDefault (e : Expr) : CanonM Expr := e.withApp fun f args => do
|
||||
if f.isConstOf ``Grind.nestedProof && args.size == 2 then
|
||||
let prop := args[0]!
|
||||
let prop' ← canon prop
|
||||
let e' := if isSameExpr prop prop' then e else mkAppN f (args.set! 0 prop')
|
||||
return e'
|
||||
else if f.isConstOf ``Grind.nestedDecidable && args.size == 2 then
|
||||
let prop := args[0]!
|
||||
let prop' ← canon prop
|
||||
let e' := if isSameExpr prop prop' then e else mkAppN f (args.set! 0 prop')
|
||||
return e'
|
||||
if args.size == 2 then
|
||||
if f.isConstOf ``Grind.nestedProof then
|
||||
/- **Note**: We don't have special treatment if `e` inside a type. -/
|
||||
let prop := args[0]!
|
||||
let prop' ← canon prop
|
||||
let e' := if isSameExpr prop prop' then e else mkApp2 f prop' args[1]!
|
||||
return e'
|
||||
else if f.isConstOf ``Grind.nestedDecidable then
|
||||
return (← canonInstDec' f args[0]! args[1]! e)
|
||||
let mut modified := false
|
||||
let args ← if f.isConstOf ``OfNat.ofNat then
|
||||
let some args ← normOfNatArgs? args | pure args
|
||||
modified := true
|
||||
pure args
|
||||
else
|
||||
let mut modified := false
|
||||
let args ← if f.isConstOf ``OfNat.ofNat then
|
||||
let some args ← normOfNatArgs? args | pure args
|
||||
pure args
|
||||
let mut f := f
|
||||
let f' ← canon f
|
||||
unless isSameExpr f f' do
|
||||
f := f'
|
||||
modified := true
|
||||
let pinfos := (← getFunInfo f).paramInfo
|
||||
let mut args := args.toVector
|
||||
for h : i in *...args.size do
|
||||
let arg := args[i]
|
||||
trace[sym.debug.canon] "[{repr (← shouldCanon pinfos i arg)}]: {arg} : {← inferType arg}"
|
||||
let arg' ← match (← shouldCanon pinfos i arg) with
|
||||
| .canonType =>
|
||||
/-
|
||||
The type may have nested propositions and terms that may need to be canonicalized too.
|
||||
So, we must recurse over it. See issue #10232
|
||||
-/
|
||||
canonInsideType' arg
|
||||
| .canonImplicit => canon arg
|
||||
| .visit => canon arg
|
||||
| .canonInst =>
|
||||
match_expr arg with
|
||||
| g@Grind.nestedDecidable prop h => canonInstDec g prop h arg
|
||||
| g@Grind.nestedProof prop h => canonInstProp g prop h arg
|
||||
| _ => canonInst arg
|
||||
unless isSameExpr arg arg' do
|
||||
args := args.set i arg'
|
||||
modified := true
|
||||
pure args
|
||||
else
|
||||
pure args
|
||||
let mut f := f
|
||||
let f' ← canon f
|
||||
unless isSameExpr f f' do
|
||||
f := f'
|
||||
modified := true
|
||||
let pinfos := (← getFunInfo f).paramInfo
|
||||
let mut args := args.toVector
|
||||
for h : i in *...args.size do
|
||||
let arg := args[i]
|
||||
trace[sym.debug.canon] "[{repr (← shouldCanon pinfos i arg)}]: {arg} : {← inferType arg}"
|
||||
let arg' ← match (← shouldCanon pinfos i arg) with
|
||||
| .canonType =>
|
||||
/-
|
||||
The type may have nested propositions and terms that may need to be canonicalized too.
|
||||
So, we must recurse over it. See issue #10232
|
||||
-/
|
||||
canonInsideType' arg
|
||||
| .canonImplicit => canon arg
|
||||
| .visit => canon arg
|
||||
| .canonInst =>
|
||||
if arg.isAppOfArity ``Grind.nestedDecidable 2 then
|
||||
let prop := arg.appFn!.appArg!
|
||||
let prop' ← canon prop
|
||||
if isSameExpr prop prop' then pure arg else pure (mkApp2 arg.appFn!.appFn! prop' arg.appArg!)
|
||||
else
|
||||
canonInst arg
|
||||
unless isSameExpr arg arg' do
|
||||
args := args.set i arg'
|
||||
modified := true
|
||||
return if modified then mkAppN f args.toArray else e
|
||||
return if modified then mkAppN f args.toArray else e
|
||||
|
||||
canonIte (f : Expr) (α c inst a b : Expr) : CanonM Expr := do
|
||||
let c ← canon c
|
||||
@@ -412,7 +482,7 @@ where
|
||||
return e
|
||||
|
||||
/--
|
||||
Returns `true` if `shouldCannon pinfos i arg` is not `.visit`.
|
||||
Returns `true` if `shouldCanon pinfos i arg` is not `.visit`.
|
||||
This is a helper function used to implement mbtc.
|
||||
-/
|
||||
public def isSupport (pinfos : Array ParamInfo) (i : Nat) (arg : Expr) : MetaM Bool := do
|
||||
|
||||
@@ -18,6 +18,7 @@ import Lean.Meta.Sym.AlphaShareBuilder
|
||||
import Lean.Meta.Sym.Offset
|
||||
import Lean.Meta.Sym.Eta
|
||||
import Lean.Meta.Sym.Util
|
||||
import Lean.Meta.HasAssignableMVar
|
||||
import Init.Data.List.MapIdx
|
||||
import Init.Data.Nat.Linear
|
||||
import Std.Do.Triple.Basic
|
||||
|
||||
@@ -152,8 +152,6 @@ structure Canon.State where
|
||||
cache : Std.HashMap Expr Expr := {}
|
||||
/-- Cache for type-level canonicalization (reductions applied). -/
|
||||
cacheInType : Std.HashMap Expr Expr := {}
|
||||
/-- Cache mapping instances to their canonical synthesized instances. -/
|
||||
cacheInsts : Std.HashMap Expr Expr := {}
|
||||
|
||||
/-- Mutable state for the symbolic computation framework. -/
|
||||
structure State where
|
||||
|
||||
@@ -14,6 +14,7 @@ import Lean.Meta.Tactic.Grind.SynthInstance
|
||||
import Lean.Meta.Tactic.Grind.Simp
|
||||
import Init.Grind.Util
|
||||
import Init.Omega
|
||||
public import Lean.Meta.HasAssignableMVar
|
||||
public section
|
||||
namespace Lean.Meta.Grind
|
||||
namespace EMatch
|
||||
|
||||
@@ -714,7 +714,6 @@ where
|
||||
set_option compiler.ignoreBorrowAnnotation true in
|
||||
@[export lean_simp]
|
||||
def simpImpl (e : Expr) : SimpM Result := withIncRecDepth do
|
||||
checkSystem "simp"
|
||||
if (← isProof e) then
|
||||
return { expr := e }
|
||||
trace[Meta.Tactic.simp.heads] "{repr e.toHeadIndex}"
|
||||
|
||||
@@ -12,6 +12,7 @@ public import Lean.Meta.Tactic.Simp.Arith
|
||||
public import Lean.Meta.Tactic.Simp.Attr
|
||||
public import Lean.Meta.BinderNameHint
|
||||
import Lean.Meta.WHNF
|
||||
public import Lean.Meta.HasAssignableMVar
|
||||
public section
|
||||
namespace Lean.Meta.Simp
|
||||
/--
|
||||
@@ -99,7 +100,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}"
|
||||
@@ -218,6 +219,7 @@ where
|
||||
else
|
||||
let candidates := candidates.insertionSort fun e₁ e₂ => e₁.1.priority > e₂.1.priority
|
||||
for (thm, numExtraArgs) in candidates do
|
||||
checkSystem "simp"
|
||||
if inErasedSet thm then continue
|
||||
if rflOnly then
|
||||
unless thm.rfl do
|
||||
@@ -245,6 +247,7 @@ where
|
||||
else
|
||||
let candidates := candidates.insertionSort fun e₁ e₂ => e₁.priority > e₂.priority
|
||||
for thm in candidates do
|
||||
checkSystem "simp"
|
||||
unless inErasedSet thm || (rflOnly && !thm.rfl) do
|
||||
let result? ← withNewMCtxDepth do
|
||||
let val ← thm.getValue
|
||||
|
||||
@@ -722,6 +722,7 @@ def simpAppUsingCongr (e : Expr) : SimpM Result := do
|
||||
if i == 0 then
|
||||
simp f
|
||||
else
|
||||
checkSystem "simp"
|
||||
let i := i - 1
|
||||
let .app f a := e | unreachable!
|
||||
let fr ← visit f i
|
||||
|
||||
@@ -50,6 +50,7 @@ partial def transform {m} [Monad m] [MonadLiftT CoreM m] [MonadControlT CoreM m]
|
||||
let _ : MonadLiftT (ST IO.RealWorld) m := { monadLift := fun x => liftM (m := CoreM) (liftM (m := ST IO.RealWorld) x) }
|
||||
let rec visit (e : Expr) : MonadCacheT ExprStructEq Expr m Expr :=
|
||||
checkCache { val := e : ExprStructEq } fun _ => Core.withIncRecDepth do
|
||||
Core.checkSystem "transform"
|
||||
let rec visitPost (e : Expr) : MonadCacheT ExprStructEq Expr m Expr := do
|
||||
match (← post e) with
|
||||
| .done e => pure e
|
||||
@@ -107,6 +108,7 @@ partial def transformWithCache {m} [Monad m] [MonadLiftT MetaM m] [MonadControlT
|
||||
let _ : MonadLiftT (ST IO.RealWorld) m := { monadLift := fun x => liftM (m := MetaM) (liftM (m := ST IO.RealWorld) x) }
|
||||
let rec visit (e : Expr) : MonadCacheT ExprStructEq Expr m Expr :=
|
||||
checkCache { val := e : ExprStructEq } fun _ => Meta.withIncRecDepth do
|
||||
(Core.checkSystem "transform" : MetaM Unit)
|
||||
let rec visitPost (e : Expr) : MonadCacheT ExprStructEq Expr m Expr := do
|
||||
match (← post e) with
|
||||
| .done e => pure e
|
||||
|
||||
@@ -650,7 +650,7 @@ expand let-expressions, expand assigned meta-variables, unfold aux declarations.
|
||||
partial def whnfCore (e : Expr) : MetaM Expr :=
|
||||
go e
|
||||
where
|
||||
go (e : Expr) : MetaM Expr :=
|
||||
go (e : Expr) : MetaM Expr := do
|
||||
whnfEasyCases e fun e => do
|
||||
trace[Meta.whnf] e
|
||||
match e with
|
||||
|
||||
@@ -247,6 +247,18 @@ very simple unification and/or non-nested TC. So, if the "app builder" becomes a
|
||||
we may solve the issue by implementing `isDefEqCheap` that never invokes TC and uses tmp metavars.
|
||||
-/
|
||||
|
||||
structure LevelMetavarDecl where
|
||||
/-- The nesting depth of this metavariable. We do not want
|
||||
unification subproblems to influence the results of parent
|
||||
problems. The depth keeps track of this information and ensures
|
||||
that unification subproblems cannot leak information out, by unifying
|
||||
based on depth. -/
|
||||
depth : Nat
|
||||
/-- This field tracks how old a metavariable is. It is set using a counter at `MetavarContext`.
|
||||
We primarily use the index of a level metavariable for pretty printing. -/
|
||||
index : Nat
|
||||
deriving Inhabited
|
||||
|
||||
/--
|
||||
`LocalInstance` represents a local typeclass instance registered by and for
|
||||
the elaborator. It stores the name of the typeclass in `className`, and the
|
||||
@@ -309,7 +321,8 @@ structure MetavarDecl where
|
||||
kind : MetavarKind
|
||||
/-- See comment at `CheckAssignment` `Meta/ExprDefEq.lean` -/
|
||||
numScopeArgs : Nat := 0
|
||||
/-- We use this field to track how old a metavariable is. It is set using a counter at `MetavarContext` -/
|
||||
/-- We use this field to track how old a metavariable is. It is set using a counter at `MetavarContext`.
|
||||
We also use it for pretty printing anonymous metavariables. -/
|
||||
index : Nat
|
||||
deriving Inhabited
|
||||
|
||||
@@ -340,9 +353,12 @@ structure MetavarContext where
|
||||
depth : Nat := 0
|
||||
/-- At what depth level mvars can be assigned. -/
|
||||
levelAssignDepth : Nat := 0
|
||||
/-- Counter for setting the field `index` at `LevelMetavarDecl`. -/
|
||||
lmvarCounter : Nat := 0
|
||||
/-- Counter for setting the field `index` at `MetavarDecl` -/
|
||||
mvarCounter : Nat := 0
|
||||
lDepth : PersistentHashMap LMVarId Nat := {}
|
||||
/-- Level metavariable declarations. -/
|
||||
lDecls : PersistentHashMap LMVarId LevelMetavarDecl := {}
|
||||
/-- Metavariable declarations. -/
|
||||
decls : PersistentHashMap MVarId MetavarDecl := {}
|
||||
/-- Index mapping user-friendly names to ids. -/
|
||||
@@ -444,11 +460,21 @@ def _root_.Lean.MVarId.isAssignedOrDelayedAssigned [Monad m] [MonadMCtx m] (mvar
|
||||
let mctx ← getMCtx
|
||||
return mctx.eAssignment.contains mvarId || mctx.dAssignment.contains mvarId
|
||||
|
||||
def MetavarContext.findLevelDecl? (mctx : MetavarContext) (mvarId : LMVarId) : Option LevelMetavarDecl :=
|
||||
mctx.lDecls.find? mvarId
|
||||
|
||||
def MetavarContext.getLevelDecl (mctx : MetavarContext) (mvarId : LMVarId) : LevelMetavarDecl :=
|
||||
match mctx.lDecls.find? mvarId with
|
||||
| some decl => decl
|
||||
| none => panic! s!"unknown universe metavariable {mvarId.name}"
|
||||
|
||||
def isLevelMVarAssignable [Monad m] [MonadMCtx m] (mvarId : LMVarId) : m Bool := do
|
||||
let mctx ← getMCtx
|
||||
match mctx.lDepth.find? mvarId with
|
||||
| some d => return d >= mctx.levelAssignDepth
|
||||
| _ => panic! s!"unknown universe metavariable {mvarId.name}"
|
||||
let decl := mctx.getLevelDecl mvarId
|
||||
return decl.depth >= mctx.levelAssignDepth
|
||||
|
||||
def MetavarContext.findDecl? (mctx : MetavarContext) (mvarId : MVarId) : Option MetavarDecl :=
|
||||
mctx.decls.find? mvarId
|
||||
|
||||
def MetavarContext.getDecl (mctx : MetavarContext) (mvarId : MVarId) : MetavarDecl :=
|
||||
match mctx.decls.find? mvarId with
|
||||
@@ -484,30 +510,6 @@ def hasAssignedMVar [Monad m] [MonadMCtx m] : Expr → m Bool
|
||||
| .proj _ _ e => pure e.hasMVar <&&> hasAssignedMVar e
|
||||
| .mvar mvarId => mvarId.isAssigned <||> mvarId.isDelayedAssigned
|
||||
|
||||
/-- Return true iff the given level contains a metavariable that can be assigned. -/
|
||||
def hasAssignableLevelMVar [Monad m] [MonadMCtx m] : Level → m Bool
|
||||
| .succ lvl => pure lvl.hasMVar <&&> hasAssignableLevelMVar lvl
|
||||
| .max lvl₁ lvl₂ => (pure lvl₁.hasMVar <&&> hasAssignableLevelMVar lvl₁) <||> (pure lvl₂.hasMVar <&&> hasAssignableLevelMVar lvl₂)
|
||||
| .imax lvl₁ lvl₂ => (pure lvl₁.hasMVar <&&> hasAssignableLevelMVar lvl₁) <||> (pure lvl₂.hasMVar <&&> hasAssignableLevelMVar lvl₂)
|
||||
| .mvar mvarId => isLevelMVarAssignable mvarId
|
||||
| .zero => return false
|
||||
| .param _ => return false
|
||||
|
||||
/-- Return `true` iff expression contains a metavariable that can be assigned. -/
|
||||
def hasAssignableMVar [Monad m] [MonadMCtx m] : Expr → m Bool
|
||||
| .const _ lvls => lvls.anyM hasAssignableLevelMVar
|
||||
| .sort lvl => hasAssignableLevelMVar lvl
|
||||
| .app f a => (pure f.hasMVar <&&> hasAssignableMVar f) <||> (pure a.hasMVar <&&> hasAssignableMVar a)
|
||||
| .letE _ t v b _ => (pure t.hasMVar <&&> hasAssignableMVar t) <||> (pure v.hasMVar <&&> hasAssignableMVar v) <||> (pure b.hasMVar <&&> hasAssignableMVar b)
|
||||
| .forallE _ d b _ => (pure d.hasMVar <&&> hasAssignableMVar d) <||> (pure b.hasMVar <&&> hasAssignableMVar b)
|
||||
| .lam _ d b _ => (pure d.hasMVar <&&> hasAssignableMVar d) <||> (pure b.hasMVar <&&> hasAssignableMVar b)
|
||||
| .fvar _ => return false
|
||||
| .bvar _ => return false
|
||||
| .lit _ => return false
|
||||
| .mdata _ e => pure e.hasMVar <&&> hasAssignableMVar e
|
||||
| .proj _ _ e => pure e.hasMVar <&&> hasAssignableMVar e
|
||||
| .mvar mvarId => mvarId.isAssignable
|
||||
|
||||
/--
|
||||
Add `mvarId := u` to the universe metavariable assignment.
|
||||
This method does not check whether `mvarId` is already assigned, nor does it check whether
|
||||
@@ -826,10 +828,11 @@ def addExprMVarDeclExp (mctx : MetavarContext) (mvarId : MVarId) (userName : Nam
|
||||
It is used to implement actions in the monads `MetaM`, `ElabM` and `TacticM`.
|
||||
It should not be used directly since the argument `(mvarId : MVarId)` is assumed to be "unique". -/
|
||||
def addLevelMVarDecl (mctx : MetavarContext) (mvarId : LMVarId) : MetavarContext :=
|
||||
{ mctx with lDepth := mctx.lDepth.insert mvarId mctx.depth }
|
||||
|
||||
def findDecl? (mctx : MetavarContext) (mvarId : MVarId) : Option MetavarDecl :=
|
||||
mctx.decls.find? mvarId
|
||||
{ mctx with
|
||||
lmvarCounter := mctx.lmvarCounter + 1
|
||||
lDecls := mctx.lDecls.insert mvarId {
|
||||
depth := mctx.depth
|
||||
index := mctx.lmvarCounter } }
|
||||
|
||||
def findUserName? (mctx : MetavarContext) (userName : Name) : Option MVarId :=
|
||||
mctx.userNames.find? userName
|
||||
@@ -909,12 +912,13 @@ def setFVarBinderInfo (mctx : MetavarContext) (mvarId : MVarId)
|
||||
mctx.modifyExprMVarLCtx mvarId (·.setBinderInfo fvarId bi)
|
||||
|
||||
def findLevelDepth? (mctx : MetavarContext) (mvarId : LMVarId) : Option Nat :=
|
||||
mctx.lDepth.find? mvarId
|
||||
(mctx.findLevelDecl? mvarId).map LevelMetavarDecl.depth
|
||||
|
||||
def getLevelDepth (mctx : MetavarContext) (mvarId : LMVarId) : Nat :=
|
||||
match mctx.findLevelDepth? mvarId with
|
||||
| some d => d
|
||||
| none => panic! "unknown metavariable"
|
||||
(mctx.getLevelDecl mvarId).depth
|
||||
|
||||
def findLevelIndex? (mctx : MetavarContext) (mvarId : LMVarId) : Option Nat :=
|
||||
(mctx.findLevelDecl? mvarId).map LevelMetavarDecl.index
|
||||
|
||||
def isAnonymousMVar (mctx : MetavarContext) (mvarId : MVarId) : Bool :=
|
||||
match mctx.findDecl? mvarId with
|
||||
|
||||
@@ -622,6 +622,15 @@ declaration signatures.
|
||||
/-- Debugging command: Prints the result of `Environment.dumpAsyncEnvState`. -/
|
||||
@[builtin_command_parser] def dumpAsyncEnvState := leading_parser
|
||||
"#dump_async_env_state"
|
||||
/--
|
||||
Mark a syntax kind as deprecated. When this syntax is elaborated, a warning will be emitted.
|
||||
|
||||
```
|
||||
deprecated_syntax Lean.Parser.Term.let_fun "use `have` instead" (since := "2026-03-18")
|
||||
```
|
||||
-/
|
||||
@[builtin_command_parser] def deprecatedSyntax := leading_parser
|
||||
"deprecated_syntax " >> ident >> optional (ppSpace >> strLit) >> optional (" (" >> nonReservedSymbol "since" >> " := " >> strLit >> ")")
|
||||
@[builtin_command_parser] def «init_quot» := leading_parser
|
||||
"init_quot"
|
||||
/--
|
||||
@@ -629,6 +638,27 @@ An internal bootstrapping command that reinterprets a Markdown docstring as Vers
|
||||
-/
|
||||
@[builtin_command_parser] def «docs_to_verso» := leading_parser
|
||||
"docs_to_verso " >> sepBy1 ident ", "
|
||||
/--
|
||||
`deprecated_module` marks the current module as deprecated.
|
||||
When another module imports a deprecated module, a warning is emitted during elaboration.
|
||||
|
||||
```
|
||||
deprecated_module "use NewModule instead" (since := "2026-03-19")
|
||||
```
|
||||
|
||||
The warning message is optional but recommended.
|
||||
The warning can be disabled with `set_option linter.deprecated.module false` or
|
||||
`-Dlinter.deprecated.module=false`.
|
||||
-/
|
||||
@[builtin_command_parser] def «deprecated_module» := leading_parser
|
||||
"deprecated_module" >> optional (ppSpace >> strLit) >> optional (" (" >> nonReservedSymbol "since" >> " := " >> strLit >> ")")
|
||||
|
||||
/--
|
||||
`#show_deprecated_modules` displays all modules in the current environment that have been
|
||||
marked with `deprecated_module`.
|
||||
-/
|
||||
@[builtin_command_parser] def showDeprecatedModules := leading_parser
|
||||
"#show_deprecated_modules"
|
||||
|
||||
def optionValue := nonReservedSymbol "true" <|> nonReservedSymbol "false" <|> strLit <|> numLit
|
||||
/--
|
||||
@@ -648,6 +678,12 @@ only in a single term or tactic.
|
||||
-/
|
||||
@[builtin_command_parser] def «set_option» := leading_parser
|
||||
"set_option " >> identWithPartialTrailingDot >> ppSpace >> optionValue
|
||||
/--
|
||||
`unlock_limits` disables all built-in resource limit options (currently `maxRecDepth`,
|
||||
`maxHeartbeats`, and `synthInstance.maxHeartbeats`) in the current scope by setting them to 0.
|
||||
-/
|
||||
@[builtin_command_parser] def «unlock_limits» := leading_parser
|
||||
"unlock_limits"
|
||||
def eraseAttr := leading_parser
|
||||
"-" >> rawIdent
|
||||
@[builtin_command_parser] def «attribute» := leading_parser
|
||||
|
||||
@@ -469,6 +469,7 @@ def seq : FirstTokens → FirstTokens → FirstTokens
|
||||
| epsilon, tks => tks
|
||||
| optTokens s₁, optTokens s₂ => optTokens (s₁ ++ s₂)
|
||||
| optTokens s₁, tokens s₂ => tokens (s₁ ++ s₂)
|
||||
| optTokens _, unknown => unknown
|
||||
| tks, _ => tks
|
||||
|
||||
def toOptional : FirstTokens → FirstTokens
|
||||
|
||||
@@ -70,6 +70,9 @@ def ppExprLegacy (env : Environment) (mctx : MetavarContext) (lctx : LocalContex
|
||||
{ fileName := "<PrettyPrinter>", fileMap := default }
|
||||
{ env := env }
|
||||
|
||||
def ppLevel (l : Level) : MetaM Format := do
|
||||
ppCategory `level (← delabLevel l (prec := 0))
|
||||
|
||||
def ppTactic (stx : TSyntax `tactic) : CoreM Format := ppCategory `tactic stx
|
||||
|
||||
def ppCommand (stx : Syntax.Command) : CoreM Format := ppCategory `command stx
|
||||
@@ -110,7 +113,7 @@ builtin_initialize
|
||||
ppExprWithInfos := fun ctx e => ctx.runMetaM <| withoutContext <| ppExprWithInfos e
|
||||
ppConstNameWithInfos := fun ctx n => ctx.runMetaM <| withoutContext <| ppConstNameWithInfos n
|
||||
ppTerm := fun ctx stx => ctx.runCoreM <| withoutContext <| ppTerm stx
|
||||
ppLevel := fun ctx l => return l.format (mvars := getPPMVarsLevels ctx.opts)
|
||||
ppLevel := fun ctx l => ctx.runMetaM <| withoutContext <| ppLevel l
|
||||
ppGoal := fun ctx mvarId => ctx.runMetaM <| withoutContext <| Meta.ppGoal mvarId
|
||||
}
|
||||
|
||||
|
||||
@@ -450,6 +450,10 @@ partial def delab : Delab := do
|
||||
else
|
||||
return stx
|
||||
|
||||
def delabLevel (l : Level) (prec : Nat) : DelabM Syntax.Level := do
|
||||
let mvars ← getPPOption getPPMVarsLevels
|
||||
return Level.quote l prec (mvars := mvars) (lIndex? := (← getMCtx).findLevelIndex?)
|
||||
|
||||
/--
|
||||
Registers an unexpander for applications of a given constant.
|
||||
|
||||
@@ -477,7 +481,11 @@ unsafe builtin_initialize appUnexpanderAttribute : KeyedDeclsAttribute Unexpande
|
||||
end Delaborator
|
||||
|
||||
open SubExpr (Pos PosMap)
|
||||
open Delaborator (OptionsPerPos topDownAnalyze DelabM)
|
||||
open Delaborator (OptionsPerPos topDownAnalyze DelabM getPPOption)
|
||||
|
||||
def delabLevel (l : Level) (prec : Nat) : MetaM Syntax.Level := do
|
||||
let mvars := getPPMVarsLevels (← getOptions)
|
||||
return Level.quote l prec (mvars := mvars) (lIndex? := (← getMCtx).findLevelIndex?)
|
||||
|
||||
def delabCore (e : Expr) (optionsPerPos : OptionsPerPos := {}) (delab : DelabM α) :
|
||||
MetaM (α × PosMap Elab.Info) := do
|
||||
|
||||
@@ -91,10 +91,9 @@ def delabSort : Delab := do
|
||||
| Level.zero => `(Prop)
|
||||
| Level.succ .zero => `(Type)
|
||||
| _ =>
|
||||
let mvars ← getPPOption getPPMVarsLevels
|
||||
match l.dec with
|
||||
| some l' => `(Type $(Level.quote l' (prec := max_prec) (mvars := mvars)))
|
||||
| none => `(Sort $(Level.quote l (prec := max_prec) (mvars := mvars)))
|
||||
| some l' => `(Type $(← delabLevel l' (prec := max_prec)))
|
||||
| none => `(Sort $(← delabLevel l (prec := max_prec)))
|
||||
|
||||
/--
|
||||
Delaborator for `const` expressions.
|
||||
@@ -131,8 +130,8 @@ def delabConst : Delab := do
|
||||
|
||||
let stx ←
|
||||
if !ls.isEmpty && (← getPPOption getPPUniverses) then
|
||||
let mvars ← getPPOption getPPMVarsLevels
|
||||
`($(mkIdent c).{$[$(ls.toArray.map (Level.quote · (prec := 0) (mvars := mvars)))],*})
|
||||
let ls' ← ls.toArray.mapM fun l => delabLevel l (prec := 0)
|
||||
`($(mkIdent c).{$ls',*})
|
||||
else
|
||||
pure <| mkIdent c
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -90,11 +90,11 @@ where
|
||||
messageMethod? msg <|> (do pending.get? (← messageId? msg))
|
||||
|
||||
local instance : ToJson Std.Time.ZonedDateTime where
|
||||
toJson dt := Std.Time.Formats.iso8601.format dt
|
||||
toJson dt := dt.toISO8601String
|
||||
|
||||
local instance : FromJson Std.Time.ZonedDateTime where
|
||||
fromJson?
|
||||
| .str s => Std.Time.Formats.iso8601.parse s
|
||||
| .str s => Std.Time.ZonedDateTime.fromISO8601String s
|
||||
| _ => throw "Expected string when converting JSON to Std.Time.ZonedDateTime"
|
||||
|
||||
structure LogEntry where
|
||||
|
||||
@@ -52,7 +52,7 @@ structure PPFns where
|
||||
ppExprWithInfos : PPContext → Expr → IO FormatWithInfos
|
||||
ppConstNameWithInfos : PPContext → Name → IO FormatWithInfos
|
||||
ppTerm : PPContext → Term → IO Format
|
||||
ppLevel : PPContext → Level → BaseIO Format
|
||||
ppLevel : PPContext → Level → IO Format
|
||||
ppGoal : PPContext → MVarId → IO Format
|
||||
deriving Inhabited
|
||||
|
||||
@@ -67,7 +67,7 @@ builtin_initialize ppFnsRef : IO.Ref PPFns ←
|
||||
ppExprWithInfos := fun _ e => return format (toString e)
|
||||
ppConstNameWithInfos := fun _ n => return format n
|
||||
ppTerm := fun ctx stx => return formatRawTerm ctx stx
|
||||
ppLevel := fun _ l => return format l
|
||||
ppLevel := fun ctx l => return l.format true ctx.mctx.findLevelIndex?
|
||||
ppGoal := fun _ mvarId => return formatRawGoal mvarId
|
||||
}
|
||||
|
||||
@@ -108,8 +108,14 @@ def ppTerm (ctx : PPContext) (stx : Term) : BaseIO Format := do
|
||||
else
|
||||
pure f!"failed to pretty print term (use 'set_option pp.rawOnError true' for raw representation)"
|
||||
|
||||
def ppLevel (ctx : PPContext) (l : Level) : BaseIO Format :=
|
||||
ppExt.getState ctx.env |>.ppLevel ctx l
|
||||
def ppLevel (ctx : PPContext) (l : Level) : BaseIO Format := do
|
||||
match (← ppExt.getState ctx.env |>.ppLevel ctx l |>.toBaseIO) with
|
||||
| .ok fmt => return fmt
|
||||
| .error ex =>
|
||||
if pp.rawOnError.get ctx.opts then
|
||||
pure f!"[Error pretty printing level: {ex}. Falling back to raw printer.]{Format.line}{l.format true ctx.mctx.findLevelIndex?}"
|
||||
else
|
||||
pure f!"failed to pretty print level (use 'set_option pp.rawOnError true' for raw representation)"
|
||||
|
||||
def ppGoal (ctx : PPContext) (mvarId : MVarId) : BaseIO Format := do
|
||||
match (← ppExt.getState ctx.env |>.ppGoal ctx mvarId |>.toBaseIO) with
|
||||
|
||||
@@ -14,7 +14,7 @@ namespace Lean
|
||||
|
||||
register_builtin_option maxRecDepth : Nat := {
|
||||
defValue := defaultMaxRecDepth
|
||||
descr := "maximum recursion depth for many Lean procedures"
|
||||
descr := "maximum recursion depth for many Lean procedures, 0 means no limit"
|
||||
}
|
||||
|
||||
end Lean
|
||||
|
||||
@@ -183,7 +183,8 @@ public theorem toInt?_repr (a : Int) : a.repr.toInt? = some a := by
|
||||
rw [repr_eq_if]
|
||||
split <;> (simp; omega)
|
||||
|
||||
public theorem isInt?_repr (a : Int) : a.repr.isInt = true := by
|
||||
@[simp]
|
||||
public theorem isInt_repr (a : Int) : a.repr.isInt = true := by
|
||||
simp [← String.isSome_toInt?]
|
||||
|
||||
public theorem repr_injective {a b : Int} (h : Int.repr a = Int.repr b) : a = b := by
|
||||
|
||||
@@ -14,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
|
||||
|
||||
|
||||
@@ -174,19 +174,19 @@ opaque osEnviron : IO (Array (String × String))
|
||||
Gets the value of an environment variable.
|
||||
-/
|
||||
@[extern "lean_uv_os_getenv"]
|
||||
opaque osGetenv : String → IO (Option String)
|
||||
opaque osGetenv : @& String → IO (Option String)
|
||||
|
||||
/--
|
||||
Sets the value of an environment variable.
|
||||
-/
|
||||
@[extern "lean_uv_os_setenv"]
|
||||
opaque osSetenv : String → String → IO Unit
|
||||
opaque osSetenv : @& String → @& String → IO Unit
|
||||
|
||||
/--
|
||||
Unsets an environment variable.
|
||||
-/
|
||||
@[extern "lean_uv_os_unsetenv"]
|
||||
opaque osUnsetenv : String → IO Unit
|
||||
opaque osUnsetenv : @& String → IO Unit
|
||||
|
||||
/--
|
||||
Gets the hostname of the machine.
|
||||
|
||||
@@ -17,7 +17,8 @@ public import Std.Time.Zoned.Database
|
||||
|
||||
public section
|
||||
|
||||
namespace Std.Time
|
||||
namespace Std
|
||||
namespace Time
|
||||
|
||||
/-!
|
||||
# Time
|
||||
@@ -129,30 +130,23 @@ Represents spans of time and the difference between two points in time.
|
||||
# Formats
|
||||
|
||||
Format strings are used to convert between `String` representations and date/time types, like `yyyy-MM-dd'T'HH:mm:ss.sssZ`.
|
||||
The table below shows the available format specifiers. Repeating a pattern character may change the
|
||||
text style, minimum width, or offset/fraction form, depending on the field.
|
||||
The table below shows the available format specifiers. Some specifiers can be repeated to control truncation or offsets.
|
||||
When a character is repeated `n` times, it usually truncates the value to `n` characters.
|
||||
|
||||
The current Lean implementation follows Java's pattern language where practical, but it is not fully
|
||||
locale-sensitive. Text forms currently use English data, and localized weekday/week-of-month fields use
|
||||
the library's fixed Monday-first interpretation.
|
||||
|
||||
For numeric fields that accept both one- and two-letter forms, the single-letter form parses a
|
||||
non-padded number and the two-letter form parses a zero-padded width of two.
|
||||
The `number` type format specifiers, such as `h` and `K`, are parsed based on the number of repetitions.
|
||||
If the repetition count is one, the format allows values ranging from 1 up to the maximum capacity of
|
||||
the respective data type.
|
||||
|
||||
The supported formats include:
|
||||
- `G`: Represents the era, such as BCE (Before Common Era) or CE (Common Era).
|
||||
- `G`, `GG`, `GGG` (short): Displays the era in a short format (e.g., "CE").
|
||||
- `GGGG` (full): Displays the era in a full format (e.g., "Common Era").
|
||||
- `GGGGG` (narrow): Displays the era in a narrow format (e.g., "C").
|
||||
- `G`: Represents the era, such as AD (Anno Domini) or BC (Before Christ).
|
||||
- `G`, `GG`, `GGG` (short): Displays the era in a short format (e.g., "AD").
|
||||
- `GGGG` (full): Displays the era in a full format (e.g., "Anno Domini").
|
||||
- `GGGGG` (narrow): Displays the era in a narrow format (e.g., "A").
|
||||
- `y`: Represents the year of the era.
|
||||
- `y`: Represents the year in its full form, without a fixed length. It can handle years of any size, (e.g., "1", "2025", or "12345678").
|
||||
- `yy`: Displays the year in a two-digit format, showing the last two digits (e.g., "04" for 2004).
|
||||
- `yyyy`: Displays the year in a four-digit format (e.g., "2004").
|
||||
- `yyyy+`: Extended format for years with more than four digits.
|
||||
- `Y`: Represents the week-based year (ISO-like behavior around year boundaries).
|
||||
- `Y`, `YYY`, `YYYY`: Displays the week-based year (e.g., "2017").
|
||||
- `YY`: Displays the last two digits of the week-based year (e.g., "17").
|
||||
- `YYYYY+`: Extended format for week-based years with more than four digits.
|
||||
- `u`: Represents the year.
|
||||
- `u`: Represents the year in its full form, without a fixed length. It can handle years of any size, (e.g., "1", "2025", or "12345678").
|
||||
- `uu`: Two-digit year format, showing the last two digits (e.g., "04" for 2004).
|
||||
@@ -164,94 +158,69 @@ The supported formats include:
|
||||
- `MMM`: Displays the abbreviated month name (e.g., "Jul").
|
||||
- `MMMM`: Displays the full month name (e.g., "July").
|
||||
- `MMMMM`: Displays the month in a narrow form (e.g., "J" for July).
|
||||
- `L`: Represents the standalone month of the year.
|
||||
- Supports the same widths as `M`; in the current English data it formats the same values.
|
||||
- `d`: Represents the day of the month.
|
||||
- `Q`: Represents the quarter of the year.
|
||||
- `Q`, `QQ`: Displays the quarter as a number (e.g., "3", "03").
|
||||
- `QQQ` (short): Displays the quarter as an abbreviated text (e.g., "Q3").
|
||||
- `QQQQ` (full): Displays the full quarter text (e.g., "3rd quarter").
|
||||
- `QQQQQ` (narrow): Displays the quarter as a short number (e.g., "3").
|
||||
- `q`: Represents the standalone quarter of the year.
|
||||
- Supports the same widths as `Q`; in the current English data it formats the same values.
|
||||
- `w`: Represents the week of the week-based year, each week starts on Monday (e.g., "27").
|
||||
- `W`: Represents the week of the month using the library's fixed Monday-first week model (e.g., "2").
|
||||
- `W`: Represents the week of the month, each week starts on Monday (e.g., "4").
|
||||
- `E`: Represents the day of the week as text.
|
||||
- `E`, `EE`, `EEE`: Displays the abbreviated weekday name (e.g., "Tue").
|
||||
- `EEEE`: Displays the full day name (e.g., "Tuesday").
|
||||
- `EEEEE`: Displays the narrow day name (e.g., "T" for Tuesday).
|
||||
- `EEEEEE`: Displays the short two-letter weekday name (e.g., "Tu").
|
||||
- `e`: Represents the weekday as number or text.
|
||||
- `e`, `ee`: Displays the weekday as a number, starting from 1 (Monday) to 7 (Sunday).
|
||||
- `eee`, `eeee`, `eeeee`: Displays the weekday as text (same format as `E`).
|
||||
- `eeeeee`: Displays the short two-letter weekday name (e.g., "Tu").
|
||||
- `c`: Standalone weekday.
|
||||
- `c`: Displays the numeric weekday using the same Monday-to-Sunday numbering as `e`.
|
||||
- `ccc`, `cccc`, `ccccc`: Display standalone text (same values as `e` in the current English data).
|
||||
- `cccccc`: Displays the short two-letter weekday name (e.g., "Tu").
|
||||
- `F`: Represents the occurrence of the weekday within the month (e.g., the 2nd Sunday formats as `2`).
|
||||
- `F`: Represents the week of the month that the first week starts on the first day of the month (e.g., "3").
|
||||
- `a`: Represents the AM or PM designation of the day.
|
||||
- `a`, `aa`, `aaa`: Displays AM/PM (e.g., "PM").
|
||||
- `aaaa`: Displays the full form (e.g., "ante meridiem", "post meridiem").
|
||||
- `aaaaa`: Displays the narrow form (e.g., "a", "p").
|
||||
- `b`: Represents the day period, extending AM/PM with noon and midnight (TR35 §4, supported in Java 16+). The `B` symbol (flexible day periods) is not supported.
|
||||
- `b`, `bb`, `bbb`: Displays a short form (e.g., "AM", "PM", "noon", "midnight").
|
||||
- `bbbb`: Displays a full form (e.g., "ante meridiem", "post meridiem", "noon", "midnight"); unlike `a`, the AM/PM spellings are lowercase here.
|
||||
- `bbbbb`: Displays a narrow form (e.g., "a", "p", "n", "mi").
|
||||
- `a`, `aa`, `aaa`: Displays AM or PM in a concise format (e.g., "PM").
|
||||
- `aaaa`: Displays the full AM/PM designation (e.g., "Post Meridium").
|
||||
- `h`: Represents the hour of the AM/PM clock (1-12) (e.g., "12").
|
||||
- `h`, `hh` are supported, matching Java.
|
||||
- One or more repetitions of the character indicates the truncation of the value to the specified number of characters.
|
||||
- `K`: Represents the hour of the AM/PM clock (0-11) (e.g., "0").
|
||||
- `K`, `KK` are supported, matching Java.
|
||||
- One or more repetitions of the character indicates the truncation of the value to the specified number of characters.
|
||||
- `k`: Represents the hour of the day in a 1-24 format (e.g., "24").
|
||||
- `k`, `kk` are supported, matching Java.
|
||||
- One or more repetitions of the character indicates the truncation of the value to the specified number of characters.
|
||||
- `H`: Represents the hour of the day in a 0-23 format (e.g., "0").
|
||||
- `H`, `HH` are supported, matching Java.
|
||||
- One or more repetitions of the character indicates the truncation of the value to the specified number of characters.
|
||||
- `m`: Represents the minute of the hour (e.g., "30").
|
||||
- `m`, `mm` are supported, matching Java.
|
||||
- One or more repetitions of the character indicates the truncation of the value to the specified number of characters.
|
||||
- `s`: Represents the second of the minute (e.g., "55").
|
||||
- `s`, `ss` are supported, matching Java.
|
||||
- One or more repetitions of the character indicates the truncation of the value to the specified number of characters.
|
||||
- `S`: Represents a fraction of a second, typically displayed as a decimal number (e.g., "978" for milliseconds).
|
||||
- One or more repetitions of the character truncates to the specified number of most-significant digits; it does not round.
|
||||
- One or more repetitions of the character indicates the truncation of the value to the specified number of characters.
|
||||
- `A`: Represents the millisecond of the day (e.g., "1234").
|
||||
- One or more repetitions of the character indicates zero-padding to the specified number of characters (no truncation is applied).
|
||||
- `n`: Represents the nanosecond of the second (e.g., "987654321"). This is a Lean/Java extension, not a TR35 field.
|
||||
- One or more repetitions of the character sets a minimum width via zero-padding; the value is not truncated.
|
||||
- `N`: Represents the nanosecond of the day (e.g., "1234000000"). This is a Lean/Java extension, not a TR35 field.
|
||||
- One or more repetitions of the character sets a minimum width via zero-padding; the value is not truncated.
|
||||
- `V`: Time zone ID.
|
||||
- `VV`: Displays the zone identifier/name.
|
||||
- Other counts are unsupported, matching Java.
|
||||
- One or more repetitions of the character indicates the truncation of the value to the specified number of characters.
|
||||
- `n`: Represents the nanosecond of the second (e.g., "987654321").
|
||||
- One or more repetitions of the character indicates the truncation of the value to the specified number of characters.
|
||||
- `N`: Represents the nanosecond of the day (e.g., "1234000000").
|
||||
- One or more repetitions of the character indicates the truncation of the value to the specified number of characters.
|
||||
- `VV`: Represents the time zone ID, which could be a city-based zone (e.g., "America/Los_Angeles"), a UTC marker (`"Z"`), or a specific offset (e.g., "-08:30").
|
||||
- One or more repetitions of the character indicates the truncation of the value to the specified number of characters.
|
||||
- `z`: Represents the time zone name.
|
||||
- `z`, `zz`, `zzz`: Shows a short zone name; for offset-only zones this is the numeric offset (e.g., "+09:00"), for UTC this is "UTC", otherwise the abbreviation (e.g., "PST").
|
||||
- `zzzz`: Displays the full zone name; for offset-only zones this is the numeric offset (e.g., "+09:00"), for UTC this is "Coordinated Universal Time", otherwise the full zone name (e.g., "Pacific Standard Time").
|
||||
- `v`: Generic time zone name.
|
||||
- `v`: In the current Lean timezone data this displays the stored abbreviation; for offset-only zones this is the numeric offset (e.g., "+09:00"), and for UTC it is normalized to "UTC".
|
||||
- `vvvv`: In the current Lean timezone data this displays the stored zone name/ID; for offset-only zones this is the numeric offset (e.g., "+09:00"), and for UTC it is normalized to "Coordinated Universal Time".
|
||||
- `z`, `zz`, `zzz`: Shows an abbreviated time zone name (e.g., "PST" for Pacific Standard Time).
|
||||
- `zzzz`: Displays the full time zone name (e.g., "Pacific Standard Time").
|
||||
- `O`: Represents the localized zone offset in the format "GMT" followed by the time difference from UTC.
|
||||
- `O`: Displays the GMT offset in a short format (e.g., "GMT+8"), or "GMT" for UTC.
|
||||
- `OOOO`: Displays the full GMT offset with padded hour and minutes (e.g., "GMT+08:00"), or "GMT" for UTC.
|
||||
- `O`: Displays the GMT offset in a simple format (e.g., "GMT+8").
|
||||
- `OOOO`: Displays the full GMT offset, including hours and minutes (e.g., "GMT+08:00").
|
||||
- `X`: Represents the zone offset. It uses 'Z' for UTC and can represent any offset (positive or negative).
|
||||
- `X`: Displays hour and optional minute offset (e.g., "-08", "-0830", or "Z").
|
||||
- `X`: Displays the hour offset (e.g., "-08").
|
||||
- `XX`: Displays the hour and minute offset without a colon (e.g., "-0830").
|
||||
- `XXX`: Displays the hour and minute offset with a colon (e.g., "-08:30").
|
||||
- `XXXX`: Displays the hour and minute offset without a colon, with optional seconds (e.g., "-0830", "-083045").
|
||||
- `XXXXX`: Displays the hour and minute offset with a colon, with optional seconds (e.g., "-08:30", "-08:30:45").
|
||||
- `x`: Represents the zone offset. Similar to `X`, but never displays `'Z'` for UTC.
|
||||
- `x`: Displays hour and optional minute offset (e.g., "+00", "+0530").
|
||||
- `XXXX`: Displays the hour, minute, and second offset without a colon (e.g., "-083045").
|
||||
- `XXXXX`: Displays the hour, minute, and second offset with a colon (e.g., "-08:30:45").
|
||||
- `x`: Represents the zone offset. Similar to X, but does not display 'Z' for UTC and focuses only on positive offsets.
|
||||
- `x`: Displays the hour offset (e.g., "+08").
|
||||
- `xx`: Displays the hour and minute offset without a colon (e.g., "+0830").
|
||||
- `xxx`: Displays the hour and minute offset with a colon (e.g., "+08:30").
|
||||
- `xxxx`: Displays the hour and minute offset without a colon, with optional seconds (e.g., "+0830", "+083045").
|
||||
- `xxxxx`: Displays the hour and minute offset with a colon, with optional seconds (e.g., "+08:30", "+08:30:45").
|
||||
- `Z`: Represents the zone offset in RFC/CLDR `Z` forms.
|
||||
- `Z`, `ZZ`, `ZZZ`: Displays hour and minute offset without colon, with optional seconds (e.g., "+0800", "+083045").
|
||||
- `ZZZZ`: Displays localized GMT form (e.g., "GMT+08:00").
|
||||
- `ZZZZZ`: Displays hour and minute offset with a colon and optional seconds, and uses `"Z"` for UTC (e.g., "Z", "+08:30", "+08:30:45").
|
||||
# Runtime Parsing
|
||||
|
||||
- `ZonedDateTime.parse` parses common zoned date-time formats with explicit offsets, but does not resolve timezone identifiers like `[Europe/Paris]`.
|
||||
- `ZonedDateTime.parseIO` resolves identifier-based inputs via the default timezone database.
|
||||
- `ZonedDateTime.fromLeanDateTimeWithIdentifierString` is pure and does not perform timezone database resolution.
|
||||
- `ZonedDateTime.fromLeanDateTimeWithIdentifierStringIO` resolves identifiers using the default timezone database.
|
||||
- `xxxx`: Displays the hour, minute, and second offset without a colon (e.g., "+083045").
|
||||
- `xxxxx`: Displays the hour, minute, and second offset with a colon (e.g., "+08:30:45").
|
||||
- `Z`: Always includes an hour and minute offset and may use 'Z' for UTC, providing clear differentiation between UTC and other time zones.
|
||||
- `Z`: Displays the hour and minute offset without a colon (e.g., "+0800").
|
||||
- `ZZ`: Displays "GMT" followed by the time offset (e.g., "GMT+08:00" or "Z").
|
||||
- `ZZZ`: Displays the full hour, minute, and second offset with a colon (e.g., "+08:30:45" or "Z").
|
||||
|
||||
# Macros
|
||||
|
||||
@@ -265,10 +234,8 @@ The `.sssssssss` can be omitted in most cases.
|
||||
- **`offset("+HH:mm")`**: Represents a timezone offset in the format `+HH:mm`, where `+` or `-` indicates the direction from UTC.
|
||||
- **`timezone("NAME/ID ZZZ")`**: Specifies a timezone using a region-based name or ID, along with its associated offset.
|
||||
- **`datespec("FORMAT")`**: Defines a compile-time date format based on the provided string.
|
||||
- **`zoned("uuuu-MM-ddTHH:mm:ss.sssssssssZZZZZ")`**: Represents a `ZonedDateTime` with a fixed timezone and optional nanosecond precision.
|
||||
- **`zoned("uuuu-MM-ddTHH:mm:ss.sssssssssZZZ")`**: Represents a `ZonedDateTime` with a fixed timezone and optional nanosecond precision.
|
||||
- **`zoned("uuuu-MM-ddTHH:mm:ss.sssssssss[IDENTIFIER]")`**: Defines an `IO ZonedDateTime`, where the timezone identifier is dynamically retrieved from the default timezone database.
|
||||
- **`zoned("uuuu-MM-ddTHH:mm:ss.sssssssss, timezone")`**: Represents an `IO ZonedDateTime`, using a specified `timezone` term and allowing optional nanoseconds.
|
||||
|
||||
-/
|
||||
|
||||
end Std.Time
|
||||
|
||||
@@ -355,28 +355,6 @@ def weekOfYear (date : PlainDate) : Week.Ordinal :=
|
||||
let w := w.truncateBottom h |>.truncateTop (Int.le_trans h₁ y.weeks.property.right)
|
||||
w
|
||||
|
||||
/--
|
||||
Returns the week-based year for a given `PlainDate`.
|
||||
-/
|
||||
def weekBasedYear (date : PlainDate) : Year.Offset :=
|
||||
let year := date.year
|
||||
let doy := date.dayOfYear
|
||||
let dow := date.weekday.toOrdinal.sub 1
|
||||
|
||||
if doy.val ≤ 3 then
|
||||
if doy.val - dow.val < -2 then
|
||||
year - 1
|
||||
else
|
||||
year
|
||||
else if doy.val ≥ 363 then
|
||||
let leap := if date.inLeapYear then 1 else 0
|
||||
if (doy.val - 363 - leap) - dow.val ≥ 0 then
|
||||
year + 1
|
||||
else
|
||||
year
|
||||
else
|
||||
year
|
||||
|
||||
instance : HAdd PlainDate Day.Offset PlainDate where
|
||||
hAdd := addDays
|
||||
|
||||
|
||||
@@ -502,11 +502,6 @@ def weekOfMonth (date : PlainDateTime) : Bounded.LE 1 5 :=
|
||||
date.date.weekOfMonth
|
||||
|
||||
/--
|
||||
Returns the week-based year for a given `PlainDateTime`.
|
||||
-/
|
||||
def weekBasedYear (date : PlainDateTime) : Year.Offset :=
|
||||
date.date.weekBasedYear
|
||||
/--
|
||||
Determines the week of the month for the given `PlainDateTime`. The week of the month is calculated based
|
||||
on the day of the month and the weekday. Each week starts on Monday because the entire library is
|
||||
based on the Gregorian Calendar.
|
||||
|
||||
@@ -23,207 +23,144 @@ set_option linter.all true
|
||||
The ISO 8601 format, used for representing date and time in a standardized
|
||||
format. The format follows the pattern `uuuu-MM-dd'T'HH:mm:ssXXX`.
|
||||
-/
|
||||
def iso8601 : Format Awareness.any := datespec("uuuu-MM-dd'T'HH:mm:ssXXX")
|
||||
def iso8601 : GenericFormat .any := datespec("uuuu-MM-dd'T'HH:mm:ssXXX")
|
||||
|
||||
|
||||
/--
|
||||
The americanDate format, which follows the pattern `MM-dd-uuuu`.
|
||||
-/
|
||||
def americanDate : Format Awareness.any := datespec("MM-dd-uuuu")
|
||||
def americanDate : GenericFormat .any := datespec("MM-dd-uuuu")
|
||||
|
||||
/--
|
||||
The europeanDate format, which follows the pattern `dd-MM-uuuu`.
|
||||
-/
|
||||
def europeanDate : Format Awareness.any := datespec("dd-MM-uuuu")
|
||||
def europeanDate : GenericFormat .any := datespec("dd-MM-uuuu")
|
||||
|
||||
/--
|
||||
The time12Hour format, which follows the pattern `hh:mm:ss a` for representing time
|
||||
The time12Hour format, which follows the pattern `hh:mm:ss aa` for representing time
|
||||
in a 12-hour clock format with an upper case AM/PM marker.
|
||||
-/
|
||||
def time12Hour : Format Awareness.any := datespec("hh:mm:ss a")
|
||||
def time12Hour : GenericFormat .any := datespec("hh:mm:ss aa")
|
||||
|
||||
/--
|
||||
The Time24Hour format, which follows the pattern `HH:mm:ss` for representing time
|
||||
in a 24-hour clock format.
|
||||
-/
|
||||
def time24Hour : Format Awareness.any := datespec("HH:mm:ss")
|
||||
def time24Hour : GenericFormat .any := datespec("HH:mm:ss")
|
||||
|
||||
/--
|
||||
The DateTimeZone24Hour format, which follows the pattern `uuuu-MM-dd:HH:mm:ss.SSSSSSSSS` for
|
||||
representing date, time, and time zone.
|
||||
-/
|
||||
def dateTime24Hour : Format (.only .GMT) := datespec("uuuu-MM-dd:HH:mm:ss.SSSSSSSSS")
|
||||
def dateTime24Hour : GenericFormat (.only .GMT) := datespec("uuuu-MM-dd:HH:mm:ss.SSSSSSSSS")
|
||||
|
||||
/--
|
||||
The DateTimeWithZone format, which follows the pattern `uuuu-MM-dd'T'HH:mm:ss.SSSSSSSSSZZZ`
|
||||
for representing date, time, and time zone.
|
||||
-/
|
||||
def dateTimeWithZone : Format Awareness.any := datespec("uuuu-MM-dd'T'HH:mm:ss.SSSSSSSSSZZZ")
|
||||
def dateTimeWithZone : GenericFormat .any := datespec("uuuu-MM-dd'T'HH:mm:ss.SSSSSSSSSZZZ")
|
||||
|
||||
/--
|
||||
The leanTime24Hour format, which follows the pattern `HH:mm:ss.SSSSSSSSS` for representing time
|
||||
in a 24-hour clock format. It uses the default value that can be parsed with the
|
||||
notation of dates.
|
||||
-/
|
||||
def leanTime24Hour : Format Awareness.any := datespec("HH:mm:ss.SSSSSSSSS")
|
||||
def leanTime24Hour : GenericFormat .any := datespec("HH:mm:ss.SSSSSSSSS")
|
||||
|
||||
/--
|
||||
The leanTime24HourNoNanos format, which follows the pattern `HH:mm:ss` for representing time
|
||||
in a 24-hour clock format. It uses the default value that can be parsed with the
|
||||
notation of dates.
|
||||
-/
|
||||
def leanTime24HourNoNanos : Format Awareness.any := datespec("HH:mm:ss")
|
||||
def leanTime24HourNoNanos : GenericFormat .any := datespec("HH:mm:ss")
|
||||
|
||||
/--
|
||||
The leanDateTime24Hour format, which follows the pattern `uuuu-MM-dd'T'HH:mm:ss.SSSSSSSSS` for
|
||||
representing date, time, and time zone. It uses the default value that can be parsed with the
|
||||
notation of dates.
|
||||
-/
|
||||
def leanDateTime24Hour : Format (.only .GMT) := datespec("uuuu-MM-dd'T'HH:mm:ss.SSSSSSSSS")
|
||||
def leanDateTime24Hour : GenericFormat (.only .GMT) := datespec("uuuu-MM-dd'T'HH:mm:ss.SSSSSSSSS")
|
||||
|
||||
/--
|
||||
The leanDateTime24HourNoNanos format, which follows the pattern `uuuu-MM-dd'T'HH:mm:ss` for
|
||||
representing date, time, and time zone. It uses the default value that can be parsed with the
|
||||
notation of dates.
|
||||
-/
|
||||
def leanDateTime24HourNoNanos : Format (.only .GMT) := datespec("uuuu-MM-dd'T'HH:mm:ss")
|
||||
def leanDateTime24HourNoNanos : GenericFormat (.only .GMT) := datespec("uuuu-MM-dd'T'HH:mm:ss")
|
||||
|
||||
/--
|
||||
The leanDateTimeWithZone format, which follows the pattern `uuuu-MM-dd'T'HH:mm:ss.SSSSSSSSSZZZZZ`
|
||||
for representing date, time, and time zone. It uses the default value that can be parsed with the
|
||||
notation of dates.
|
||||
-/
|
||||
def leanDateTimeWithZone : Format Awareness.any := datespec("uuuu-MM-dd'T'HH:mm:ss.SSSSSSSSSZZZZZ")
|
||||
def leanDateTimeWithZone : GenericFormat .any := datespec("uuuu-MM-dd'T'HH:mm:ss.SSSSSSSSSZZZZZ")
|
||||
|
||||
/--
|
||||
The leanDateTimeWithZoneNoNanos format, which follows the pattern `uuuu-MM-dd'T'HH:mm:ssZZZZZ`
|
||||
for representing date, time, and time zone. It uses the default value that can be parsed with the
|
||||
notation of dates.
|
||||
-/
|
||||
def leanDateTimeWithZoneNoNanos : Format Awareness.any := datespec("uuuu-MM-dd'T'HH:mm:ssZZZZZ")
|
||||
def leanDateTimeWithZoneNoNanos : GenericFormat .any := datespec("uuuu-MM-dd'T'HH:mm:ssZZZZZ")
|
||||
|
||||
/--
|
||||
The leanDateTimeWithIdentifier format, which follows the pattern `uuuu-MM-dd'T'HH:mm:ss[z]`
|
||||
for representing date, time, and time zone. It uses the default value that can be parsed with the
|
||||
notation of dates.
|
||||
-/
|
||||
def leanDateTimeWithIdentifier : Format Awareness.any := datespec("uuuu-MM-dd'T'HH:mm:ss'['VV']'")
|
||||
def leanDateTimeWithIdentifier : GenericFormat .any := datespec("uuuu-MM-dd'T'HH:mm:ss'['zzzz']'")
|
||||
|
||||
/--
|
||||
The leanDateTimeWithIdentifierAndNanos format, which follows the pattern `uuuu-MM-dd'T'HH:mm:ss.SSSSSSSSS'[z]'`
|
||||
for representing date, time, and time zone. It uses the default value that can be parsed with the
|
||||
notation of dates.
|
||||
-/
|
||||
def leanDateTimeWithIdentifierAndNanos : Format Awareness.any := datespec("uuuu-MM-dd'T'HH:mm:ss.SSSSSSSSS'['VV']'")
|
||||
|
||||
/--
|
||||
The leanDateTimeWithZoneAndName format, which follows the pattern
|
||||
`uuuu-MM-dd'T'HH:mm:ss.SSSSSSSSSZZZZZ'['VV']'` for representing date, time, timezone offset,
|
||||
and timezone identifier. This is the canonical Lean format used in `repr` for named timezones.
|
||||
-/
|
||||
def leanDateTimeWithZoneAndName : Format Awareness.any := datespec("uuuu-MM-dd'T'HH:mm:ss.SSSSSSSSSZZZZZ'['VV']'")
|
||||
|
||||
/--
|
||||
The leanDateTimeWithZoneAndNameNoNanos format, which follows the pattern
|
||||
`uuuu-MM-dd'T'HH:mm:ssZZZZZ'['zzzz']'` for representing date, time, timezone offset, and timezone
|
||||
identifier without nanoseconds.
|
||||
-/
|
||||
def leanDateTimeWithZoneAndNameNoNanos : Format Awareness.any := datespec("uuuu-MM-dd'T'HH:mm:ssZZZZZ'['VV']'")
|
||||
def leanDateTimeWithIdentifierAndNanos : GenericFormat .any := datespec("uuuu-MM-dd'T'HH:mm:ss.SSSSSSSSS'['zzzz']'")
|
||||
|
||||
/--
|
||||
The Lean Date format, which follows the pattern `uuuu-MM-dd`. It uses the default value that can be parsed with the
|
||||
notation of dates.
|
||||
-/
|
||||
def leanDate : Format Awareness.any := datespec("uuuu-MM-dd")
|
||||
def leanDate : GenericFormat .any := datespec("uuuu-MM-dd")
|
||||
|
||||
/--
|
||||
The SQLDate format, which follows the pattern `uuuu-MM-dd` and is commonly used
|
||||
in SQL databases to represent dates.
|
||||
-/
|
||||
def sqlDate : Format Awareness.any := datespec("uuuu-MM-dd")
|
||||
def sqlDate : GenericFormat .any := datespec("uuuu-MM-dd")
|
||||
|
||||
/--
|
||||
The LongDateFormat, which follows the pattern `EEEE, MMMM d, uuuu HH:mm:ss` for
|
||||
representing a full date and time with the day of the week and month name.
|
||||
-/
|
||||
def longDateFormat : Format (.only .GMT) := datespec("EEEE, MMMM d, uuuu HH:mm:ss")
|
||||
def longDateFormat : GenericFormat (.only .GMT) := datespec("EEEE, MMMM d, uuuu HH:mm:ss")
|
||||
|
||||
/--
|
||||
The AscTime format, which follows the pattern `EEE MMM d HH:mm:ss uuuu`. This format
|
||||
is often used in older systems for logging and time-stamping events.
|
||||
-/
|
||||
def ascTime : Format (.only .GMT) := datespec("EEE MMM d HH:mm:ss uuuu")
|
||||
def ascTime : GenericFormat (.only .GMT) := datespec("EEE MMM d HH:mm:ss uuuu")
|
||||
|
||||
/--
|
||||
The RFC822 format, which follows the pattern `eee, dd MMM uuuu HH:mm:ss ZZZ`.
|
||||
This format is used in email headers and HTTP headers.
|
||||
-/
|
||||
def rfc822 : Format Awareness.any := datespec("eee, dd MMM uuuu HH:mm:ss ZZZ")
|
||||
def rfc822 : GenericFormat .any := datespec("eee, dd MMM uuuu HH:mm:ss ZZZ")
|
||||
|
||||
/--
|
||||
The RFC850 format, which follows the pattern `eee, dd-MMM-yy HH:mm:ss ZZZ`.
|
||||
The RFC850 format, which follows the pattern `eee, dd-MMM-YY HH:mm:ss ZZZ`.
|
||||
This format is an older standard for representing date and time in headers.
|
||||
-/
|
||||
def rfc850 : Format Awareness.any := datespec("eee, dd-MMM-yy HH:mm:ss ZZZ")
|
||||
|
||||
/--
|
||||
A `MultiFormat` that parses `leanDateTimeWithZone` with or without nanoseconds.
|
||||
-/
|
||||
def leanDateTimeWithZoneAlt : MultiFormat Awareness.any :=
|
||||
.new #[leanDateTimeWithZone, leanDateTimeWithZoneNoNanos]
|
||||
|
||||
/--
|
||||
A `MultiFormat` that parses `leanDateTimeWithZoneAndName` with or without nanoseconds.
|
||||
-/
|
||||
def leanDateTimeWithZoneAndNameAlt : MultiFormat Awareness.any :=
|
||||
.new #[leanDateTimeWithZoneAndName, leanDateTimeWithZoneAndNameNoNanos]
|
||||
|
||||
/--
|
||||
A `MultiFormat` that parses `leanDateTime24Hour` with or without nanoseconds.
|
||||
-/
|
||||
def leanDateTime24HourAlt : MultiFormat (.only .GMT) :=
|
||||
.new #[leanDateTime24Hour, leanDateTime24HourNoNanos]
|
||||
|
||||
/--
|
||||
A `MultiFormat` that parses `leanTime24Hour` with or without nanoseconds.
|
||||
-/
|
||||
def leanTime24HourAlt : MultiFormat Awareness.any :=
|
||||
.new #[leanTime24Hour, leanTime24HourNoNanos]
|
||||
|
||||
/--
|
||||
A `MultiFormat` that parses `leanDateTimeWithIdentifier` with or without nanoseconds.
|
||||
-/
|
||||
def leanDateTimeWithIdentifierAlt : MultiFormat Awareness.any :=
|
||||
.new #[leanDateTimeWithIdentifier, leanDateTimeWithIdentifierAndNanos]
|
||||
def rfc850 : GenericFormat .any := datespec("eee, dd-MM-uuuu HH:mm:ss ZZZ")
|
||||
|
||||
end Formats
|
||||
|
||||
namespace Format
|
||||
|
||||
/--
|
||||
Parses the input string, resolving any timezone identifier via the default timezone database.
|
||||
For formats with a timezone identifier specifier but no offset specifier (e.g.
|
||||
`uuuu-MM-dd'T'HH:mm:ss'['zzzz']'`), this performs a tzdb lookup to find the correct UTC offset.
|
||||
For all other formats this behaves identically to `parse`.
|
||||
-/
|
||||
def parseIO (format : Format Awareness.any) (input : String) : IO ZonedDateTime := do
|
||||
if format.hasIdentifierSpecifier && !format.hasOffsetSpecifier then
|
||||
match format.parseUnchecked input with
|
||||
| .error err => throw <| IO.userError err
|
||||
| .ok zdt =>
|
||||
let rules ← Database.defaultGetZoneRules zdt.timezone.name
|
||||
pure <| ZonedDateTime.ofPlainDateTime zdt.toPlainDateTime rules
|
||||
else
|
||||
IO.ofExcept (format.parse input)
|
||||
|
||||
end Format
|
||||
|
||||
namespace TimeZone
|
||||
|
||||
/--
|
||||
Parses a string into a `TimeZone` object. The input string must be in the format `"VV ZZZZZ"`.
|
||||
-/
|
||||
def fromTimeZone (input : String) : Except String TimeZone := do
|
||||
let spec : Format Awareness.any := datespec("VV ZZZZZ")
|
||||
let spec : GenericFormat .any := datespec("VV ZZZZZ")
|
||||
spec.parseBuilder (fun id off => some (TimeZone.mk off id (off.toIsoString true) false)) input
|
||||
|
||||
namespace Offset
|
||||
@@ -232,7 +169,7 @@ namespace Offset
|
||||
Parses a string representing an offset into an `Offset` object. The input string must follow the `"xxx"` format.
|
||||
-/
|
||||
def fromOffset (input : String) : Except String Offset := do
|
||||
let spec : Format Awareness.any := datespec("xxx")
|
||||
let spec : GenericFormat .any := datespec("xxx")
|
||||
spec.parseBuilder some input
|
||||
|
||||
end Offset
|
||||
@@ -244,44 +181,76 @@ namespace PlainDate
|
||||
Formats a `PlainDate` using a specific format.
|
||||
-/
|
||||
def format (date : PlainDate) (format : String) : String :=
|
||||
let format : Except String (Format Awareness.any) := Format.spec format
|
||||
let format : Except String (GenericFormat .any) := GenericFormat.spec format
|
||||
match format with
|
||||
| .error err => s!"error: {err}"
|
||||
| .ok res =>
|
||||
let res := res.formatGeneric fun
|
||||
| .G _ => some date.era
|
||||
| .y _ => some date.year
|
||||
| .Y _ => some date.weekBasedYear
|
||||
| .u _ => some date.year
|
||||
| .D _ => some (Sigma.mk date.year.isLeap date.dayOfYear)
|
||||
| .Q _ | .q _ => some date.quarter
|
||||
| .Qorq _ => some date.quarter
|
||||
| .w _ => some date.weekOfYear
|
||||
| .W _ => some date.weekOfMonth
|
||||
| .M _ | .L _ => some date.month
|
||||
| .W _ => some date.alignedWeekOfMonth
|
||||
| .MorL _ => some date.month
|
||||
| .d _ => some date.day
|
||||
| .E _ => some date.weekday
|
||||
| .e _ | .c _ => some date.weekday
|
||||
| .eorc _ => some date.weekday
|
||||
| .F _ => some date.weekOfMonth
|
||||
| _ => none
|
||||
match res with
|
||||
| some res => res
|
||||
| none => "invalid time"
|
||||
|
||||
/--
|
||||
Parses a date string in the American format (`MM-dd-uuuu`) and returns a `PlainDate`.
|
||||
-/
|
||||
def fromAmericanDateString (input : String) : Except String PlainDate := do
|
||||
Formats.americanDate.parseBuilder (fun m d y => PlainDate.ofYearMonthDay? y m d) input
|
||||
|
||||
/--
|
||||
Converts a date in the American format (`MM-dd-uuuu`) into a `String`.
|
||||
-/
|
||||
def toAmericanDateString (input : PlainDate) : String :=
|
||||
Formats.americanDate.formatBuilder input.month input.day input.year
|
||||
|
||||
/--
|
||||
Parses a date string in the SQL format (`uuuu-MM-dd`) and returns a `PlainDate`.
|
||||
-/
|
||||
def fromSQLDateString (input : String) : Except String PlainDate := do
|
||||
Formats.sqlDate.parseBuilder PlainDate.ofYearMonthDay? input
|
||||
|
||||
/--
|
||||
Converts a date in the SQL format (`uuuu-MM-dd`) into a `String`.
|
||||
-/
|
||||
def toSQLDateString (input : PlainDate) : String :=
|
||||
Formats.sqlDate.formatBuilder input.year input.month input.day
|
||||
|
||||
/--
|
||||
Parses a date string in the Lean format (`uuuu-MM-dd`) and returns a `PlainDate`.
|
||||
-/
|
||||
def fromLeanDateString (input : String) : Except String PlainDate := do
|
||||
Formats.leanDate.parseBuilder PlainDate.ofYearMonthDay? input
|
||||
|
||||
/--
|
||||
Converts a date in the Lean format (`uuuu-MM-dd`) into a `String`.
|
||||
-/
|
||||
def toLeanDateString (input : PlainDate) : String :=
|
||||
Formats.leanDate.formatBuilder input.year input.month input.day
|
||||
|
||||
/--
|
||||
Parses a `String` in the `AmericanDate` or `SQLDate` format and returns a `PlainDate`.
|
||||
-/
|
||||
def parse (input : String) : Except String PlainDate :=
|
||||
Formats.americanDate.parseBuilder (fun m d y => PlainDate.ofYearMonthDay? y m d) input
|
||||
<|> Formats.sqlDate.parseBuilder PlainDate.ofYearMonthDay? input
|
||||
|
||||
def leanDateString (d : PlainDate) : String :=
|
||||
Formats.leanDate.formatBuilder d.year d.month d.day
|
||||
fromAmericanDateString input
|
||||
<|> fromSQLDateString input
|
||||
|
||||
instance : ToString PlainDate where
|
||||
toString := leanDateString
|
||||
toString := toLeanDateString
|
||||
|
||||
instance : Repr PlainDate where
|
||||
reprPrec d := Repr.addAppParen ("date(\"" ++ leanDateString d ++ "\")")
|
||||
reprPrec data := Repr.addAppParen ("date(\"" ++ toLeanDateString data ++ "\")")
|
||||
|
||||
end PlainDate
|
||||
|
||||
@@ -291,7 +260,7 @@ namespace PlainTime
|
||||
Formats a `PlainTime` using a specific format.
|
||||
-/
|
||||
def format (time : PlainTime) (format : String) : String :=
|
||||
let format : Except String (Format Awareness.any) := Format.spec format
|
||||
let format : Except String (GenericFormat .any) := GenericFormat.spec format
|
||||
match format with
|
||||
| .error err => s!"error: {err}"
|
||||
| .ok res =>
|
||||
@@ -302,16 +271,6 @@ def format (time : PlainTime) (format : String) : String :=
|
||||
| .n _ => some time.nanosecond
|
||||
| .s _ => some time.second
|
||||
| .a _ => some (HourMarker.ofOrdinal time.hour)
|
||||
| .b _ =>
|
||||
let h := time.hour.val
|
||||
let m := time.minute.val
|
||||
let s := time.second.val
|
||||
let n := time.nanosecond.val
|
||||
some <|
|
||||
if h = 12 ∧ m = 0 ∧ s = 0 ∧ n = 0 then .noon
|
||||
else if h = 0 ∧ m = 0 ∧ s = 0 ∧ n = 0 then .midnight
|
||||
else if h < 12 then .am
|
||||
else .pm
|
||||
| .h _ => some time.hour.toRelative
|
||||
| .K _ => some (time.hour.emod 12 (by decide))
|
||||
| .S _ => some time.nanosecond
|
||||
@@ -323,24 +282,58 @@ def format (time : PlainTime) (format : String) : String :=
|
||||
| none => "invalid time"
|
||||
|
||||
/--
|
||||
Parses a `String` in the `Time12Hour`, `Time24Hour`, or lean time (with optional nanoseconds) format
|
||||
and returns a `PlainTime`.
|
||||
Parses a time string in the 24-hour format (`HH:mm:ss`) and returns a `PlainTime`.
|
||||
-/
|
||||
def fromTime24Hour (input : String) : Except String PlainTime :=
|
||||
Formats.time24Hour.parseBuilder (fun h m s => some (PlainTime.ofHourMinuteSeconds h m s)) input
|
||||
|
||||
/--
|
||||
Formats a `PlainTime` value into a 24-hour format string (`HH:mm:ss`).
|
||||
-/
|
||||
def toTime24Hour (input : PlainTime) : String :=
|
||||
Formats.time24Hour.formatBuilder input.hour input.minute input.second
|
||||
|
||||
/--
|
||||
Parses a time string in the lean 24-hour format (`HH:mm:ss.SSSSSSSSS` or `HH:mm:ss`) and returns a `PlainTime`.
|
||||
-/
|
||||
def fromLeanTime24Hour (input : String) : Except String PlainTime :=
|
||||
Formats.leanTime24Hour.parseBuilder (fun h m s n => some <| PlainTime.ofHourMinuteSecondsNano h m s n) input
|
||||
<|> Formats.leanTime24HourNoNanos.parseBuilder (fun h m s => some <| PlainTime.ofHourMinuteSecondsNano h m s 0) input
|
||||
|
||||
/--
|
||||
Formats a `PlainTime` value into a 24-hour format string (`HH:mm:ss.SSSSSSSSS`).
|
||||
-/
|
||||
def toLeanTime24Hour (input : PlainTime) : String :=
|
||||
Formats.leanTime24Hour.formatBuilder input.hour input.minute input.second input.nanosecond
|
||||
|
||||
/--
|
||||
Parses a time string in the 12-hour format (`hh:mm:ss aa`) and returns a `PlainTime`.
|
||||
-/
|
||||
def fromTime12Hour (input : String) : Except String PlainTime := do
|
||||
let builder h m s a : Option PlainTime := do
|
||||
let value ← Internal.Bounded.ofInt? h.val
|
||||
some <| PlainTime.ofHourMinuteSeconds (HourMarker.toAbsolute a value) m s
|
||||
|
||||
Formats.time12Hour.parseBuilder builder input
|
||||
|
||||
/--
|
||||
Formats a `PlainTime` value into a 12-hour format string (`hh:mm:ss aa`).
|
||||
-/
|
||||
def toTime12Hour (input : PlainTime) : String :=
|
||||
Formats.time12Hour.formatBuilder (input.hour.emod 12 (by decide) |>.add 1) input.minute input.second (if input.hour.val ≥ 12 then HourMarker.pm else HourMarker.am)
|
||||
|
||||
/--
|
||||
Parses a `String` in the `Time12Hour` or `Time24Hour` format and returns a `PlainTime`.
|
||||
-/
|
||||
def parse (input : String) : Except String PlainTime :=
|
||||
Formats.time12Hour.parseBuilder (fun h m s a => do
|
||||
let value ← Internal.Bounded.ofInt? h.val
|
||||
some <| PlainTime.ofHourMinuteSeconds (HourMarker.toAbsolute a value) m s) input
|
||||
<|> Formats.leanTime24Hour.parseBuilder (fun h m s n => some <| PlainTime.ofHourMinuteSecondsNano h m s n) input
|
||||
<|> Formats.time24Hour.parseBuilder (fun h m s => some (PlainTime.ofHourMinuteSeconds h m s)) input
|
||||
|
||||
def leanTimeString (t : PlainTime) : String :=
|
||||
Formats.leanTime24Hour.formatBuilder t.hour t.minute t.second t.nanosecond
|
||||
fromTime12Hour input
|
||||
<|> fromTime24Hour input
|
||||
|
||||
instance : ToString PlainTime where
|
||||
toString := leanTimeString
|
||||
toString := toLeanTime24Hour
|
||||
|
||||
instance : Repr PlainTime where
|
||||
reprPrec data := Repr.addAppParen ("time(\"" ++ leanTimeString data ++ "\")")
|
||||
reprPrec data := Repr.addAppParen ("time(\"" ++ toLeanTime24Hour data ++ "\")")
|
||||
|
||||
end PlainTime
|
||||
|
||||
@@ -350,60 +343,99 @@ namespace ZonedDateTime
|
||||
Formats a `ZonedDateTime` using a specific format.
|
||||
-/
|
||||
def format (data: ZonedDateTime) (format : String) : String :=
|
||||
let format : Except String (Format Awareness.any) := Format.spec format
|
||||
let format : Except String (GenericFormat .any) := GenericFormat.spec format
|
||||
match format with
|
||||
| .error err => s!"error: {err}"
|
||||
| .ok res => res.format data
|
||||
| .ok res => res.format data.toDateTime
|
||||
|
||||
/--
|
||||
Parses a `String` in common zoned date-time formats and returns a `ZonedDateTime`.
|
||||
This parser does not resolve timezone identifiers like `[Europe/Paris]`; use `parseIO` for that.
|
||||
Parses a `String` in the `ISO8601` format and returns a `ZonedDateTime`.
|
||||
-/
|
||||
-- Wraps Format.parse to fix type unification (Awareness.any.type vs ZonedDateTime).
|
||||
private def parseFormat (fmt : Format Awareness.any) (input : String) : Except String ZonedDateTime :=
|
||||
fmt.parse input
|
||||
def fromISO8601String (input : String) : Except String ZonedDateTime :=
|
||||
Formats.iso8601.parse input
|
||||
|
||||
/--
|
||||
Formats a `ZonedDateTime` value into an ISO8601 string.
|
||||
-/
|
||||
def toISO8601String (date : ZonedDateTime) : String :=
|
||||
Formats.iso8601.format date.toDateTime
|
||||
|
||||
/--
|
||||
Parses a `String` in the rfc822 format and returns a `ZonedDateTime`.
|
||||
-/
|
||||
def fromRFC822String (input : String) : Except String ZonedDateTime :=
|
||||
Formats.rfc822.parse input
|
||||
|
||||
/--
|
||||
Formats a `ZonedDateTime` value into an RFC822 format string.
|
||||
-/
|
||||
def toRFC822String (date : ZonedDateTime) : String :=
|
||||
Formats.rfc822.format date.toDateTime
|
||||
|
||||
/--
|
||||
Parses a `String` in the rfc850 format and returns a `ZonedDateTime`.
|
||||
-/
|
||||
def fromRFC850String (input : String) : Except String ZonedDateTime :=
|
||||
Formats.rfc850.parse input
|
||||
|
||||
/--
|
||||
Formats a `ZonedDateTime` value into an RFC850 format string.
|
||||
-/
|
||||
def toRFC850String (date : ZonedDateTime) : String :=
|
||||
Formats.rfc850.format date.toDateTime
|
||||
|
||||
/--
|
||||
Parses a `String` in the dateTimeWithZone format and returns a `ZonedDateTime` object in the GMT time zone.
|
||||
-/
|
||||
def fromDateTimeWithZoneString (input : String) : Except String ZonedDateTime :=
|
||||
Formats.dateTimeWithZone.parse input
|
||||
|
||||
/--
|
||||
Formats a `ZonedDateTime` value into a simple date time with timezone string.
|
||||
-/
|
||||
def toDateTimeWithZoneString (pdt : ZonedDateTime) : String :=
|
||||
Formats.dateTimeWithZone.format pdt.toDateTime
|
||||
|
||||
/--
|
||||
Parses a `String` in the lean date time format with timezone format and returns a `ZonedDateTime` object.
|
||||
-/
|
||||
def fromLeanDateTimeWithZoneString (input : String) : Except String ZonedDateTime :=
|
||||
Formats.leanDateTimeWithZone.parse input
|
||||
<|> Formats.leanDateTimeWithZoneNoNanos.parse input
|
||||
|
||||
/--
|
||||
Parses a `String` in the lean date time format with identifier and returns a `ZonedDateTime` object.
|
||||
-/
|
||||
def fromLeanDateTimeWithIdentifierString (input : String) : Except String ZonedDateTime :=
|
||||
Formats.leanDateTimeWithIdentifier.parse input
|
||||
<|> Formats.leanDateTimeWithIdentifierAndNanos.parse input
|
||||
|
||||
/--
|
||||
Formats a `DateTime` value into a simple date time with timezone string that can be parsed by the date% notation.
|
||||
-/
|
||||
def toLeanDateTimeWithZoneString (zdt : ZonedDateTime) : String :=
|
||||
Formats.leanDateTimeWithZone.formatBuilder zdt.year zdt.month zdt.day zdt.hour zdt.minute zdt.date.get.time.second zdt.nanosecond zdt.offset
|
||||
/--
|
||||
Formats a `DateTime` value into a simple date time with timezone string that can be parsed by the date% notation with the timezone identifier.
|
||||
-/
|
||||
def toLeanDateTimeWithIdentifierString (zdt : ZonedDateTime) : String :=
|
||||
Formats.leanDateTimeWithIdentifierAndNanos.formatBuilder zdt.year zdt.month zdt.day zdt.hour zdt.minute zdt.date.get.time.second zdt.nanosecond zdt.timezone.name
|
||||
|
||||
/--
|
||||
Parses a `String` in the `ISO8601`, `RFC822` or `RFC850` format and returns a `ZonedDateTime`.
|
||||
-/
|
||||
def parse (input : String) : Except String ZonedDateTime :=
|
||||
parseFormat Formats.iso8601 input
|
||||
<|> parseFormat Formats.rfc822 input
|
||||
<|> parseFormat Formats.rfc850 input
|
||||
<|> parseFormat Formats.leanDateTimeWithZone input
|
||||
<|> parseFormat Formats.leanDateTimeWithZoneNoNanos input
|
||||
<|> parseFormat Formats.leanDateTimeWithZoneAndName input
|
||||
<|> parseFormat Formats.leanDateTimeWithZoneAndNameNoNanos input
|
||||
<|> parseFormat Formats.dateTimeWithZone input
|
||||
<|> parseFormat Formats.leanDateTimeWithIdentifier input
|
||||
<|> parseFormat Formats.leanDateTimeWithIdentifierAndNanos input
|
||||
|
||||
/--
|
||||
Parses a `String` in common zoned date-time formats.
|
||||
If the input uses a timezone identifier (for example, `[Europe/Paris]`), it resolves it using the default timezone database.
|
||||
-/
|
||||
def parseIO (input : String) : IO ZonedDateTime := do
|
||||
match parse input with
|
||||
| .ok zdt => pure zdt
|
||||
| .error err =>
|
||||
let identParse : Except String ZonedDateTime :=
|
||||
Formats.leanDateTimeWithIdentifier.parseUnchecked input
|
||||
<|> Formats.leanDateTimeWithIdentifierAndNanos.parseUnchecked input
|
||||
match identParse with
|
||||
| .ok zdt =>
|
||||
let rules ← Database.defaultGetZoneRules zdt.timezone.name
|
||||
pure <| ZonedDateTime.ofPlainDateTime zdt.toPlainDateTime rules
|
||||
| .error _ => throw <| IO.userError err
|
||||
fromISO8601String input
|
||||
<|> fromRFC822String input
|
||||
<|> fromRFC850String input
|
||||
<|> fromDateTimeWithZoneString input
|
||||
<|> fromLeanDateTimeWithIdentifierString input
|
||||
|
||||
instance : ToString ZonedDateTime where
|
||||
toString data := Formats.leanDateTimeWithIdentifierAndNanos.format data
|
||||
toString := toLeanDateTimeWithIdentifierString
|
||||
|
||||
instance : Repr ZonedDateTime where
|
||||
reprPrec data :=
|
||||
let name := data.timezone.name
|
||||
let str :=
|
||||
if name == data.timezone.offset.toIsoString true then
|
||||
Formats.leanDateTimeWithZone.format data
|
||||
else
|
||||
Formats.leanDateTimeWithZoneAndName.format data
|
||||
Repr.addAppParen ("zoned(\"" ++ str ++ "\")")
|
||||
reprPrec data := Repr.addAppParen ("zoned(\"" ++ toLeanDateTimeWithZoneString data ++ "\")")
|
||||
|
||||
end ZonedDateTime
|
||||
|
||||
@@ -413,31 +445,22 @@ namespace PlainDateTime
|
||||
Formats a `PlainDateTime` using a specific format.
|
||||
-/
|
||||
def format (date : PlainDateTime) (format : String) : String :=
|
||||
let format : Except String (Format Awareness.any) := Format.spec format
|
||||
let format : Except String (GenericFormat .any) := GenericFormat.spec format
|
||||
match format with
|
||||
| .error err => s!"error: {err}"
|
||||
| .ok res =>
|
||||
let res := res.formatGeneric fun
|
||||
| .G _ => some date.era
|
||||
| .y _ => some date.year
|
||||
| .Y _ =>
|
||||
let week := date.weekOfYear
|
||||
some <|
|
||||
if date.month.val = 1 ∧ week.val ≥ 52 then
|
||||
date.year - 1
|
||||
else if date.month.val = 12 ∧ week.val = 1 then
|
||||
date.year + 1
|
||||
else
|
||||
date.year
|
||||
| .u _ => some date.year
|
||||
| .D _ => some (Sigma.mk date.year.isLeap date.dayOfYear)
|
||||
| .Q _ | .q _ => some date.quarter
|
||||
| .Qorq _ => some date.quarter
|
||||
| .w _ => some date.weekOfYear
|
||||
| .W _ => some date.weekOfMonth
|
||||
| .M _ | .L _ => some date.month
|
||||
| .W _ => some date.alignedWeekOfMonth
|
||||
| .MorL _ => some date.month
|
||||
| .d _ => some date.day
|
||||
| .E _ => some date.weekday
|
||||
| .e _ | .c _ => some date.weekday
|
||||
| .eorc _ => some date.weekday
|
||||
| .F _ => some date.weekOfMonth
|
||||
| .H _ => some date.hour
|
||||
| .k _ => some date.hour.shiftTo1BasedHour
|
||||
@@ -456,22 +479,71 @@ def format (date : PlainDateTime) (format : String) : String :=
|
||||
| none => "invalid time"
|
||||
|
||||
/--
|
||||
Parses a `String` in the `AscTime`, `LongDate`, `DateTime`, or `LeanDateTime` format and returns a `PlainDateTime`.
|
||||
Parses a `String` in the `AscTime` format and returns a `PlainDateTime` object in the GMT time zone.
|
||||
-/
|
||||
def fromAscTimeString (input : String) : Except String PlainDateTime :=
|
||||
Formats.ascTime.parse input
|
||||
|>.map DateTime.toPlainDateTime
|
||||
|
||||
/--
|
||||
Formats a `PlainDateTime` value into an AscTime format string.
|
||||
-/
|
||||
def toAscTimeString (pdt : PlainDateTime) : String :=
|
||||
Formats.ascTime.format (DateTime.ofPlainDateTimeAssumingUTC pdt .UTC)
|
||||
|
||||
/--
|
||||
Parses a `String` in the `LongDateFormat` and returns a `PlainDateTime` object in the GMT time zone.
|
||||
-/
|
||||
def fromLongDateFormatString (input : String) : Except String PlainDateTime :=
|
||||
Formats.longDateFormat.parse input
|
||||
|>.map DateTime.toPlainDateTime
|
||||
|
||||
/--
|
||||
Formats a `PlainDateTime` value into a LongDateFormat string.
|
||||
-/
|
||||
def toLongDateFormatString (pdt : PlainDateTime) : String :=
|
||||
Formats.longDateFormat.format (DateTime.ofPlainDateTimeAssumingUTC pdt .UTC)
|
||||
|
||||
/--
|
||||
Parses a `String` in the `DateTime` format and returns a `PlainDateTime`.
|
||||
-/
|
||||
def fromDateTimeString (input : String) : Except String PlainDateTime :=
|
||||
Formats.dateTime24Hour.parse input
|
||||
|>.map DateTime.toPlainDateTime
|
||||
|
||||
/--
|
||||
Formats a `PlainDateTime` value into a `DateTime` format string.
|
||||
-/
|
||||
def toDateTimeString (pdt : PlainDateTime) : String :=
|
||||
Formats.dateTime24Hour.formatBuilder pdt.year pdt.month pdt.day pdt.hour pdt.minute pdt.time.second pdt.nanosecond
|
||||
|
||||
/--
|
||||
Parses a `String` in the `DateTime` format and returns a `PlainDateTime`.
|
||||
-/
|
||||
def fromLeanDateTimeString (input : String) : Except String PlainDateTime :=
|
||||
(Formats.leanDateTime24Hour.parse input <|> Formats.leanDateTime24HourNoNanos.parse input)
|
||||
|>.map DateTime.toPlainDateTime
|
||||
|
||||
/--
|
||||
Formats a `PlainDateTime` value into a `DateTime` format string.
|
||||
-/
|
||||
def toLeanDateTimeString (pdt : PlainDateTime) : String :=
|
||||
Formats.leanDateTime24Hour.formatBuilder pdt.year pdt.month pdt.day pdt.hour pdt.minute pdt.time.second pdt.nanosecond
|
||||
|
||||
/--
|
||||
Parses a `String` in the `AscTime` or `LongDate` format and returns a `PlainDateTime`.
|
||||
-/
|
||||
def parse (date : String) : Except String PlainDateTime :=
|
||||
(Formats.ascTime.parse date).map DateTime.toPlainDateTime
|
||||
<|> (Formats.longDateFormat.parse date).map DateTime.toPlainDateTime
|
||||
<|> (Formats.dateTime24Hour.parse date).map DateTime.toPlainDateTime
|
||||
<|> (Formats.leanDateTime24HourAlt.parse date).map DateTime.toPlainDateTime
|
||||
|
||||
def leanPlainDateTimeString (date : PlainDateTime) : String :=
|
||||
Formats.leanDateTime24Hour.formatBuilder date.year date.month date.day date.hour date.minute date.time.second date.nanosecond
|
||||
fromAscTimeString date
|
||||
<|> fromLongDateFormatString date
|
||||
<|> fromDateTimeString date
|
||||
<|> fromLeanDateTimeString date
|
||||
|
||||
instance : ToString PlainDateTime where
|
||||
toString := leanPlainDateTimeString
|
||||
toString := toLeanDateTimeString
|
||||
|
||||
instance : Repr PlainDateTime where
|
||||
reprPrec data := Repr.addAppParen ("datetime(\"" ++ leanPlainDateTimeString data ++ "\")")
|
||||
reprPrec data := Repr.addAppParen ("datetime(\"" ++ toLeanDateTimeString data ++ "\")")
|
||||
|
||||
end PlainDateTime
|
||||
|
||||
@@ -481,22 +553,76 @@ namespace DateTime
|
||||
Formats a `DateTime` using a specific format.
|
||||
-/
|
||||
def format (data: DateTime tz) (format : String) : String :=
|
||||
let format : Except String (Format Awareness.any) := Format.spec format
|
||||
let format : Except String (GenericFormat .any) := GenericFormat.spec format
|
||||
match format with
|
||||
| .error err => s!"error: {err}"
|
||||
| .ok res => res.format data
|
||||
|
||||
/--
|
||||
Parses a `String` in the `AscTime` format and returns a `DateTime` object in the GMT time zone.
|
||||
-/
|
||||
def fromAscTimeString (input : String) : Except String (DateTime .GMT) :=
|
||||
Formats.ascTime.parse input
|
||||
|
||||
/--
|
||||
Formats a `DateTime` value into an AscTime format string.
|
||||
-/
|
||||
def toAscTimeString (datetime : DateTime .GMT) : String :=
|
||||
Formats.ascTime.format datetime
|
||||
|
||||
/--
|
||||
Parses a `String` in the `LongDateFormat` and returns a `DateTime` object in the GMT time zone.
|
||||
-/
|
||||
def fromLongDateFormatString (input : String) : Except String (DateTime .GMT) :=
|
||||
Formats.longDateFormat.parse input
|
||||
|
||||
/--
|
||||
Formats a `DateTime` value into a LongDateFormat string.
|
||||
-/
|
||||
def toLongDateFormatString (datetime : DateTime .GMT) : String :=
|
||||
Formats.longDateFormat.format datetime
|
||||
|
||||
/--
|
||||
Formats a `DateTime` value into an ISO8601 string.
|
||||
-/
|
||||
def toISO8601String (date : DateTime tz) : String :=
|
||||
Formats.iso8601.format date
|
||||
|
||||
/--
|
||||
Formats a `DateTime` value into an RFC822 format string.
|
||||
-/
|
||||
def toRFC822String (date : DateTime tz) : String :=
|
||||
Formats.rfc822.format date
|
||||
|
||||
/--
|
||||
Formats a `DateTime` value into an RFC850 format string.
|
||||
-/
|
||||
def toRFC850String (date : DateTime tz) : String :=
|
||||
Formats.rfc850.format date
|
||||
|
||||
/--
|
||||
Formats a `DateTime` value into a `DateTimeWithZone` format string.
|
||||
-/
|
||||
def toDateTimeWithZoneString (pdt : DateTime tz) : String :=
|
||||
Formats.dateTimeWithZone.format pdt
|
||||
|
||||
/--
|
||||
Formats a `DateTime` value into a `DateTimeWithZone` format string that can be parsed by `date%`.
|
||||
-/
|
||||
def toLeanDateTimeWithZoneString (pdt : DateTime tz) : String :=
|
||||
Formats.leanDateTimeWithZone.format pdt
|
||||
|
||||
/--
|
||||
Parses a `String` in the `AscTime` or `LongDate` format and returns a `DateTime`.
|
||||
-/
|
||||
def parse (date : String) : Except String (DateTime .GMT) :=
|
||||
Formats.ascTime.parse date
|
||||
<|> Formats.longDateFormat.parse date
|
||||
fromAscTimeString date
|
||||
<|> fromLongDateFormatString date
|
||||
|
||||
instance : Repr (DateTime tz) where
|
||||
reprPrec data := Repr.addAppParen (Formats.leanDateTimeWithZone.format data)
|
||||
reprPrec data := Repr.addAppParen (toLeanDateTimeWithZoneString data)
|
||||
|
||||
instance : ToString (DateTime tz) where
|
||||
toString data := Formats.leanDateTimeWithZone.format data
|
||||
toString := toLeanDateTimeWithZoneString
|
||||
|
||||
end DateTime
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -239,7 +239,7 @@ def ofFin' {lo : Nat} (fin : Fin (Nat.succ hi)) (h : lo ≤ hi) : Bounded.LE lo
|
||||
else ofNat' lo (And.intro (Nat.le_refl lo) h)
|
||||
|
||||
/--
|
||||
Creates a new `Bounded.LE` using a the modulus of a number.
|
||||
Creates a new `Bounded.LE` using the modulus of a number.
|
||||
-/
|
||||
@[inline]
|
||||
def byEmod (b : Int) (i : Int) (hi : i > 0) : Bounded.LE 0 (i - 1) := by
|
||||
@@ -252,7 +252,7 @@ def byEmod (b : Int) (i : Int) (hi : i > 0) : Bounded.LE 0 (i - 1) := by
|
||||
exact Int.emod_lt_of_pos b hi
|
||||
|
||||
/--
|
||||
Creates a new `Bounded.LE` using a the Truncating modulus of a number.
|
||||
Creates a new `Bounded.LE` using the Truncating modulus of a number.
|
||||
-/
|
||||
@[inline]
|
||||
def byMod (b : Int) (i : Int) (hi : 0 < i) : Bounded.LE (- (i - 1)) (i - 1) := by
|
||||
|
||||
@@ -21,7 +21,6 @@ private meta def convertText : Text → MacroM (TSyntax `term)
|
||||
| .short => `(Std.Time.Text.short)
|
||||
| .full => `(Std.Time.Text.full)
|
||||
| .narrow => `(Std.Time.Text.narrow)
|
||||
| .twoLetterShort => `(Std.Time.Text.twoLetterShort)
|
||||
|
||||
private meta def convertNumber : Number → MacroM (TSyntax `term)
|
||||
| ⟨padding⟩ => `(Std.Time.Number.mk $(quote padding))
|
||||
@@ -59,40 +58,26 @@ private meta def convertOffsetZ : OffsetZ → MacroM (TSyntax `term)
|
||||
private meta def convertModifier : Modifier → MacroM (TSyntax `term)
|
||||
| .G p => do `(Std.Time.Modifier.G $(← convertText p))
|
||||
| .y p => do `(Std.Time.Modifier.y $(← convertYear p))
|
||||
| .Y p => do `(Std.Time.Modifier.Y $(← convertYear p))
|
||||
| .u p => do `(Std.Time.Modifier.u $(← convertYear p))
|
||||
| .D p => do `(Std.Time.Modifier.D $(← convertNumber p))
|
||||
| .M p =>
|
||||
| .MorL p =>
|
||||
match p with
|
||||
| .inl num => do `(Std.Time.Modifier.M (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.M (.inr $(← convertText txt)))
|
||||
| .L p =>
|
||||
match p with
|
||||
| .inl num => do `(Std.Time.Modifier.L (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.L (.inr $(← convertText txt)))
|
||||
| .inl num => do `(Std.Time.Modifier.MorL (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.MorL (.inr $(← convertText txt)))
|
||||
| .d p => do `(Std.Time.Modifier.d $(← convertNumber p))
|
||||
| .Q p =>
|
||||
| .Qorq p =>
|
||||
match p with
|
||||
| .inl num => do `(Std.Time.Modifier.Q (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.Q (.inr $(← convertText txt)))
|
||||
| .q p =>
|
||||
match p with
|
||||
| .inl num => do `(Std.Time.Modifier.q (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.q (.inr $(← convertText txt)))
|
||||
| .inl num => do `(Std.Time.Modifier.Qorq (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.Qorq (.inr $(← convertText txt)))
|
||||
| .w p => do `(Std.Time.Modifier.w $(← convertNumber p))
|
||||
| .W p => do `(Std.Time.Modifier.W $(← convertNumber p))
|
||||
| .E p => do `(Std.Time.Modifier.E $(← convertText p))
|
||||
| .e p =>
|
||||
| .eorc p =>
|
||||
match p with
|
||||
| .inl num => do `(Std.Time.Modifier.e (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.e (.inr $(← convertText txt)))
|
||||
| .c p =>
|
||||
match p with
|
||||
| .inl num => do `(Std.Time.Modifier.c (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.c (.inr $(← convertText txt)))
|
||||
| .inl num => do `(Std.Time.Modifier.eorc (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.eorc (.inr $(← convertText txt)))
|
||||
| .F p => do `(Std.Time.Modifier.F $(← convertNumber p))
|
||||
| .a p => do `(Std.Time.Modifier.a $(← convertText p))
|
||||
| .b p => do `(Std.Time.Modifier.b $(← convertText p))
|
||||
| .h p => do `(Std.Time.Modifier.h $(← convertNumber p))
|
||||
| .K p => do `(Std.Time.Modifier.K $(← convertNumber p))
|
||||
| .k p => do `(Std.Time.Modifier.k $(← convertNumber p))
|
||||
@@ -103,9 +88,8 @@ private meta def convertModifier : Modifier → MacroM (TSyntax `term)
|
||||
| .A p => do `(Std.Time.Modifier.A $(← convertNumber p))
|
||||
| .n p => do `(Std.Time.Modifier.n $(← convertNumber p))
|
||||
| .N p => do `(Std.Time.Modifier.N $(← convertNumber p))
|
||||
| .V p => do `(Std.Time.Modifier.V $(← convertNumber p))
|
||||
| .V => `(Std.Time.Modifier.V)
|
||||
| .z p => do `(Std.Time.Modifier.z $(← convertZoneName p))
|
||||
| .v p => do `(Std.Time.Modifier.v $(← convertZoneName p))
|
||||
| .O p => do `(Std.Time.Modifier.O $(← convertOffsetO p))
|
||||
| .X p => do `(Std.Time.Modifier.X $(← convertOffsetX p))
|
||||
| .x p => do `(Std.Time.Modifier.x $(← convertOffsetX p))
|
||||
@@ -223,40 +207,33 @@ syntax "timezone(" str ")" : term
|
||||
|
||||
macro_rules
|
||||
| `(zoned( $date:str )) => do
|
||||
let s := date.getString
|
||||
match (Formats.leanDateTimeWithZoneAlt.parse s : Except String ZonedDateTime) with
|
||||
match ZonedDateTime.fromLeanDateTimeWithZoneString date.getString with
|
||||
| .ok res => do return ← convertZonedDateTime res
|
||||
| .error _ =>
|
||||
match (Formats.leanDateTimeWithZoneAndNameAlt.parse s : Except String ZonedDateTime) with
|
||||
| .ok res => do return ← convertZonedDateTime res
|
||||
| .error _ =>
|
||||
let identParse : Except String ZonedDateTime :=
|
||||
Formats.leanDateTimeWithIdentifier.parseUnchecked s
|
||||
<|> Formats.leanDateTimeWithIdentifierAndNanos.parseUnchecked s
|
||||
match identParse with
|
||||
| .ok res => do return ← convertZonedDateTime res (identifier := true)
|
||||
| .error res => Macro.throwErrorAt date s!"error: {res}"
|
||||
match ZonedDateTime.fromLeanDateTimeWithIdentifierString date.getString with
|
||||
| .ok res => do return ← convertZonedDateTime res (identifier := true)
|
||||
| .error res => Macro.throwErrorAt date s!"error: {res}"
|
||||
|
||||
| `(zoned( $date:str, $timezone )) => do
|
||||
match (Formats.leanDateTime24HourAlt.parse date.getString).map DateTime.toPlainDateTime with
|
||||
match PlainDateTime.fromLeanDateTimeString date.getString with
|
||||
| .ok res => do
|
||||
let plain ← convertPlainDateTime res
|
||||
`(Std.Time.ZonedDateTime.ofPlainDateTime $plain $timezone)
|
||||
| .error res => Macro.throwErrorAt date s!"error: {res}"
|
||||
|
||||
| `(datetime( $date:str )) => do
|
||||
match (Formats.leanDateTime24HourAlt.parse date.getString).map DateTime.toPlainDateTime with
|
||||
match PlainDateTime.fromLeanDateTimeString date.getString with
|
||||
| .ok res => do
|
||||
return ← convertPlainDateTime res
|
||||
| .error res => Macro.throwErrorAt date s!"error: {res}"
|
||||
|
||||
| `(date( $date:str )) => do
|
||||
match PlainDate.parse date.getString with
|
||||
match PlainDate.fromSQLDateString date.getString with
|
||||
| .ok res => return ← convertPlainDate res
|
||||
| .error res => Macro.throwErrorAt date s!"error: {res}"
|
||||
|
||||
| `(time( $time:str )) => do
|
||||
match PlainTime.parse time.getString with
|
||||
match PlainTime.fromLeanTime24Hour time.getString with
|
||||
| .ok res => return ← convertPlainTime res
|
||||
| .error res => Macro.throwErrorAt time s!"error: {res}"
|
||||
|
||||
|
||||
@@ -19,7 +19,6 @@ private meta def convertText : Text → MacroM (TSyntax `term)
|
||||
| .short => `(Std.Time.Text.short)
|
||||
| .full => `(Std.Time.Text.full)
|
||||
| .narrow => `(Std.Time.Text.narrow)
|
||||
| .twoLetterShort => `(Std.Time.Text.twoLetterShort)
|
||||
|
||||
private meta def convertNumber : Number → MacroM (TSyntax `term)
|
||||
| ⟨padding⟩ => `(Std.Time.Number.mk $(quote padding))
|
||||
@@ -57,40 +56,26 @@ private meta def convertOffsetZ : OffsetZ → MacroM (TSyntax `term)
|
||||
private meta def convertModifier : Modifier → MacroM (TSyntax `term)
|
||||
| .G p => do `(Std.Time.Modifier.G $(← convertText p))
|
||||
| .y p => do `(Std.Time.Modifier.y $(← convertYear p))
|
||||
| .Y p => do `(Std.Time.Modifier.Y $(← convertYear p))
|
||||
| .u p => do `(Std.Time.Modifier.u $(← convertYear p))
|
||||
| .D p => do `(Std.Time.Modifier.D $(← convertNumber p))
|
||||
| .M p =>
|
||||
| .MorL p =>
|
||||
match p with
|
||||
| .inl num => do `(Std.Time.Modifier.M (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.M (.inr $(← convertText txt)))
|
||||
| .L p =>
|
||||
match p with
|
||||
| .inl num => do `(Std.Time.Modifier.L (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.L (.inr $(← convertText txt)))
|
||||
| .inl num => do `(Std.Time.Modifier.MorL (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.MorL (.inr $(← convertText txt)))
|
||||
| .d p => do `(Std.Time.Modifier.d $(← convertNumber p))
|
||||
| .Q p =>
|
||||
| .Qorq p =>
|
||||
match p with
|
||||
| .inl num => do `(Std.Time.Modifier.Q (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.Q (.inr $(← convertText txt)))
|
||||
| .q p =>
|
||||
match p with
|
||||
| .inl num => do `(Std.Time.Modifier.q (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.q (.inr $(← convertText txt)))
|
||||
| .inl num => do `(Std.Time.Modifier.Qorq (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.Qorq (.inr $(← convertText txt)))
|
||||
| .w p => do `(Std.Time.Modifier.w $(← convertNumber p))
|
||||
| .W p => do `(Std.Time.Modifier.W $(← convertNumber p))
|
||||
| .E p => do `(Std.Time.Modifier.E $(← convertText p))
|
||||
| .e p =>
|
||||
| .eorc p =>
|
||||
match p with
|
||||
| .inl num => do `(Std.Time.Modifier.e (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.e (.inr $(← convertText txt)))
|
||||
| .c p =>
|
||||
match p with
|
||||
| .inl num => do `(Std.Time.Modifier.c (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.c (.inr $(← convertText txt)))
|
||||
| .inl num => do `(Std.Time.Modifier.eorc (.inl $(← convertNumber num)))
|
||||
| .inr txt => do `(Std.Time.Modifier.eorc (.inr $(← convertText txt)))
|
||||
| .F p => do `(Std.Time.Modifier.F $(← convertNumber p))
|
||||
| .a p => do `(Std.Time.Modifier.a $(← convertText p))
|
||||
| .b p => do `(Std.Time.Modifier.b $(← convertText p))
|
||||
| .h p => do `(Std.Time.Modifier.h $(← convertNumber p))
|
||||
| .K p => do `(Std.Time.Modifier.K $(← convertNumber p))
|
||||
| .k p => do `(Std.Time.Modifier.k $(← convertNumber p))
|
||||
@@ -101,9 +86,8 @@ private meta def convertModifier : Modifier → MacroM (TSyntax `term)
|
||||
| .A p => do `(Std.Time.Modifier.A $(← convertNumber p))
|
||||
| .n p => do `(Std.Time.Modifier.n $(← convertNumber p))
|
||||
| .N p => do `(Std.Time.Modifier.N $(← convertNumber p))
|
||||
| .V p => do `(Std.Time.Modifier.V $(← convertNumber p))
|
||||
| .V => `(Std.Time.Modifier.V)
|
||||
| .z p => do `(Std.Time.Modifier.z $(← convertZoneName p))
|
||||
| .v p => do `(Std.Time.Modifier.v $(← convertZoneName p))
|
||||
| .O p => do `(Std.Time.Modifier.O $(← convertOffsetO p))
|
||||
| .X p => do `(Std.Time.Modifier.X $(← convertOffsetX p))
|
||||
| .x p => do `(Std.Time.Modifier.x $(← convertOffsetX p))
|
||||
@@ -125,7 +109,7 @@ syntax "datespec(" str "," term ")" : term
|
||||
|
||||
private meta def formatStringToFormat (fmt : TSyntax `str) (config : Option (TSyntax `term)) : MacroM (TSyntax `term) := do
|
||||
let input := fmt.getString
|
||||
let format : Except String (Format .any) := Format.spec input
|
||||
let format : Except String (GenericFormat .any) := GenericFormat.spec input
|
||||
match format with
|
||||
| .ok res =>
|
||||
let alts ← res.string.mapM convertFormatPart
|
||||
|
||||
@@ -410,17 +410,9 @@ def weekday (dt : DateTime tz) : Weekday :=
|
||||
/--
|
||||
Determines the era of the given `DateTime` based on its year.
|
||||
-/
|
||||
@[inline]
|
||||
def era (date : DateTime tz) : Year.Era :=
|
||||
date.year.era
|
||||
|
||||
/--
|
||||
Returns the week-based year for a given `DateTime`.
|
||||
-/
|
||||
@[inline]
|
||||
def weekBasedYear (date : DateTime tz) : Year.Offset :=
|
||||
date.date.get.weekBasedYear
|
||||
|
||||
/--
|
||||
Sets the `DateTime` to the specified `desiredWeekday`.
|
||||
-/
|
||||
|
||||
@@ -15,7 +15,8 @@ public section
|
||||
namespace Std
|
||||
namespace Time
|
||||
|
||||
set_option linter.all true
|
||||
-- TODO (@kim-em): re-enable this once there is a mechanism to exclude `linter.indexVariables`.
|
||||
-- set_option linter.all true
|
||||
|
||||
/--
|
||||
Represents a date and time with timezone information.
|
||||
@@ -152,13 +153,6 @@ Getter for the `Year` inside of a `ZonedDateTime`
|
||||
def year (zdt : ZonedDateTime) : Year.Offset :=
|
||||
zdt.date.get.year
|
||||
|
||||
/--
|
||||
Returns the week-based year for a given `ZonedDateTime`.
|
||||
-/
|
||||
@[inline]
|
||||
def weekBasedYear (zdt : ZonedDateTime) : Year.Offset :=
|
||||
zdt.date.get.weekBasedYear
|
||||
|
||||
/--
|
||||
Getter for the `Month` inside of a `ZonedDateTime`
|
||||
-/
|
||||
|
||||
@@ -976,6 +976,13 @@ static inline void lean_sarray_set_size(u_lean_obj_arg o, size_t sz) {
|
||||
}
|
||||
static inline uint8_t* lean_sarray_cptr(lean_object * o) { return lean_to_sarray(o)->m_data; }
|
||||
|
||||
LEAN_EXPORT bool lean_sarray_eq_cold(b_lean_obj_arg a1, b_lean_obj_arg a2);
|
||||
static inline bool lean_sarray_eq(b_lean_obj_arg a1, b_lean_obj_arg a2) {
|
||||
assert(lean_sarray_elem_size(a1) == lean_sarray_elem_size(a2));
|
||||
return a1 == a2 || (lean_sarray_size(a1) == lean_sarray_size(a2) && lean_sarray_eq_cold(a1, a2));
|
||||
}
|
||||
static inline uint8_t lean_sarray_dec_eq(b_lean_obj_arg a1, b_lean_obj_arg a2) { return lean_sarray_eq(a1, a2); }
|
||||
|
||||
/* Remark: expand sarray API after we add better support in the compiler */
|
||||
|
||||
/* ByteArray (special case of Array of Scalars) */
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user