Compare commits

..

20 Commits

Author SHA1 Message Date
Leonardo de Moura
6d0bc1647f feat: add Float.toBits and Float.fromBits
This PR adds raw transmutation of floating-point numbers to and from `UInt64`. Floats and UInts share the same endianness across all supported platforms. The IEEE 754 standard precisely specifies the bit layout of floats. Note that `Float.toBits` is distinct from `Float.toUInt64`, which attempts to preserve the numeric value rather than the bitwise value.
2024-11-15 11:18:45 -08:00
Markus Himmel
688ee4c887 fix: constant folding for Nat.ble and Nat.blt (#6087)
This PR fixes a bug in the constant folding for the `Nat.ble` and
`Nat.blt` function in the old code generator, leading to a
miscompilation.

Closes #6086
2024-11-15 12:09:52 +00:00
Henrik Böving
9a3dd615e0 chore: bv_decide remove noop rewrites (#6080)
Merely removes rules that are actually just syntactic aliases but equal
at the `Expr` level.
2024-11-15 11:41:54 +00:00
Violeta Hernández
7e6363dc05 chore: join → flatten in docstring (#6040)
Update the docstring of `List.flatten`.
2024-11-15 10:11:42 +00:00
Kim Morrison
a074bd9a2b feat: implementation of Array.pmap (#6052)
This PR adds `Array.pmap`, as well as a `@[csimp]` lemma in terms of the
no-copy `Array.attachWith`.
2024-11-15 02:10:04 +00:00
Kyle Miller
498d41633b fix: pretty print .coeFun with terminfo of coercee (#6085)
This PR improves the term info for coercions marked with
`CoeFnType.coeFun` (such as `DFunLike.coe` in Mathlib), making "go to
definition" on the function name work. Hovering over such a coerced
function will show the coercee rather than the coercion expression. The
coercion expression can still be seen by hovering over the whitespace in
the function application.
2024-11-15 01:45:38 +00:00
Sofia Rodrigues
e0d7c3ac79 feat: add date and time functionality (#4904)
This PR introduces date and time functionality to the Lean 4 Std.

Breaking Changes:
- `Lean.Data.Rat` is now `Std.Internal.Rat` because it's used by the
DateTime library.

---------

Co-authored-by: Markus Himmel <markus@himmel-villmar.de>
Co-authored-by: Mac Malone <tydeu@hatpress.net>
2024-11-14 14:04:19 +00:00
Joachim Breitner
6a5b122b40 perf: use RArray in simp_arith meta code (#6068 part 2)
This PR makes `simp_arith` use `RArray` for the context of the
reflection proofs, which scales better when there are many variables.

On our synthetic benchmark:
```
simp_arith1               instructions    -25.1% (-4892.6 σ)
```

No effect on mathlib, though, guess it’s not used much on large goals there:
http://speed.lean-fro.org/mathlib4/compare/873b982b-2038-462a-9b68-0c0fc457f90d/to/56e66691-2f1f-4947-a922-37b80680315d
2024-11-14 14:08:48 +01:00
Joachim Breitner
bf9ddf2c74 chore: update stage0 2024-11-14 14:08:48 +01:00
Joachim Breitner
3f47871e73 perf: use RArray in simp_arith meta code (#6068 part 1)
This PR prepares #6068 by using the `RArray` data structure in
`simp_arith` the simp-arith meta code.

After the subsequent stage0 we can change the simp-arith theorems in
`Init`.
2024-11-14 14:08:48 +01:00
Joachim Breitner
85f25967ea feat: Lean.RArray (#6070)
This PR adds the Lean.RArray data structure.

This data structure is equivalent to `Fin n → α` or `Array α`, but
optimized for a fast kernel-reduction `get` operation.

It is not suitable as a general-purpose data structure. The primary
intended use case is the “denote” function of a typical proof by
reflection proof, where only the `get` operation is necessary, and where
using `List.get` unnecessarily slows down proofs with more than a
hand-full of atomic expressions.


There is no well-formedness invariant attached to this data structure,
to keep it concise; it's semantics is given through `RArray.get`. In
that way one can also view an `RArray` as a decision tree implementing
`Nat → α`.

In #6068 this data structure is used in `simp_arith`.
2024-11-14 10:56:50 +00:00
David Thrane Christiansen
8e1ddbc5aa fix: validate atoms modulo leading and trailing whitespace (#6012)
This PR improves the validation of new syntactic tokens. Previously, the
validation code had inconsistencies: some atoms would be accepted only
if they had a leading space as a pretty printer hint. Additionally,
atoms with internal whitespace are no longer allowed.

Closes #6011
2024-11-14 10:40:17 +00:00
Henrik Böving
e6e39f502f feat: add options to configure all of bv_decide's preprocessing (#6077)
This PR adds options to `bv_decide`'s configuration structure such that
all non mandatory preprocessing passes can be disabled.
2024-11-14 09:22:23 +00:00
Henrik Böving
debb82bc20 perf: make andFlattening work on deeply nested hyps in one pass (#6075)
No changelog as this PR improves performance of a feature that is not
yet released.
2024-11-14 09:09:25 +00:00
Violeta Hernández
9a85433477 refactor: allow Sort u in Squash (#6074)
Co-authored-by: Kim Morrison <kim@tqft.net>
2024-11-14 05:55:21 +00:00
Mac Malone
4616c0ac3e refactor: lake: avoid v! in builtin code (#6073)
Use of `v!` in Lake code can cause bootstrapping failures and is easily
avoided. It is perfectly safe in user code.
2024-11-14 05:00:02 +00:00
Leonardo de Moura
e55b681774 feat: add Context.setConfig (#6072)
This PR adds `Lean.Simp.Context.setConfig` function.
2024-11-14 00:32:13 +00:00
Kim Morrison
63132105ba feat: lemmas about for loops over Array (#6055)
This PR adds lemmas about for loops over `Array`, following the existing
lemmas for `List`.
2024-11-13 23:23:55 +00:00
Kim Morrison
350b36411c chore: upstream some NameMap functions (#6056) 2024-11-13 23:22:01 +00:00
Kim Morrison
1c30c76e72 chore: remove >6 month old deprecations (#6057) 2024-11-13 23:21:23 +00:00
187 changed files with 14443 additions and 185 deletions

View File

@@ -170,7 +170,7 @@ lib.warn "The Nix-based build is deprecated" rec {
ln -sf ${lean-all}/* .
'';
buildPhase = ''
ctest --output-junit test-results.xml --output-on-failure -E 'leancomptest_(doc_example|foreign)|leanlaketest_reverse-ffi' -j$NIX_BUILD_CORES
ctest --output-junit test-results.xml --output-on-failure -E 'leancomptest_(doc_example|foreign)|leanlaketest_reverse-ffi|leanruntest_timeIO' -j$NIX_BUILD_CORES
'';
installPhase = ''
mkdir $out

View File

@@ -1922,12 +1922,12 @@ represents an element of `Squash α` the same as `α` itself
`Squash.lift` will extract a value in any subsingleton `β` from a function on `α`,
while `Nonempty.rec` can only do the same when `β` is a proposition.
-/
def Squash (α : Type u) := Quot (fun (_ _ : α) => True)
def Squash (α : Sort u) := Quot (fun (_ _ : α) => True)
/-- The canonical quotient map into `Squash α`. -/
def Squash.mk {α : Type u} (x : α) : Squash α := Quot.mk _ x
def Squash.mk {α : Sort u} (x : α) : Squash α := Quot.mk _ x
theorem Squash.ind {α : Type u} {motive : Squash α Prop} (h : (a : α), motive (Squash.mk a)) : (q : Squash α), motive q :=
theorem Squash.ind {α : Sort u} {motive : Squash α Prop} (h : (a : α), motive (Squash.mk a)) : (q : Squash α), motive q :=
Quot.ind h
/-- If `β` is a subsingleton, then a function `α → β` lifts to `Squash α → β`. -/

View File

@@ -42,3 +42,4 @@ import Init.Data.PLift
import Init.Data.Zero
import Init.Data.NeZero
import Init.Data.Function
import Init.Data.RArray

View File

@@ -18,3 +18,4 @@ import Init.Data.Array.Bootstrap
import Init.Data.Array.GetLit
import Init.Data.Array.MapIdx
import Init.Data.Array.Set
import Init.Data.Array.Monadic

View File

@@ -10,6 +10,16 @@ import Init.Data.List.Attach
namespace Array
/-- `O(n)`. Partial map. If `f : Π a, P a → β` is a partial function defined on
`a : α` satisfying `P`, then `pmap f l h` is essentially the same as `map f l`
but is defined only when all members of `l` satisfy `P`, using the proof
to apply `f`.
We replace this at runtime with a more efficient version via
-/
def pmap {P : α Prop} (f : a, P a β) (l : Array α) (H : a l, P a) : Array β :=
(l.toList.pmap f (fun a m => H a (mem_def.mpr m))).toArray
/--
Unsafe implementation of `attachWith`, taking advantage of the fact that the representation of
`Array {x // P x}` is the same as the input `Array α`.
@@ -35,6 +45,10 @@ Unsafe implementation of `attachWith`, taking advantage of the fact that the rep
l.toArray.attach = (l.attachWith (· l.toArray) (by simp)).toArray := by
simp [attach]
@[simp] theorem _root_.List.pmap_toArray {l : List α} {P : α Prop} {f : a, P a β} {H : a l.toArray, P a} :
l.toArray.pmap f H = (l.pmap f (by simpa using H)).toArray := by
simp [pmap]
@[simp] theorem toList_attachWith {l : Array α} {P : α Prop} {H : x l, P x} :
(l.attachWith P H).toList = l.toList.attachWith P (by simpa [mem_toList] using H) := by
simp [attachWith]
@@ -43,6 +57,29 @@ Unsafe implementation of `attachWith`, taking advantage of the fact that the rep
l.attach.toList = l.toList.attachWith (· l) (by simp [mem_toList]) := by
simp [attach]
@[simp] theorem toList_pmap {l : Array α} {P : α Prop} {f : a, P a β} {H : a l, P a} :
(l.pmap f H).toList = l.toList.pmap f (fun a m => H a (mem_def.mpr m)) := by
simp [pmap]
/-- Implementation of `pmap` using the zero-copy version of `attach`. -/
@[inline] private def pmapImpl {P : α Prop} (f : a, P a β) (l : Array α) (H : a l, P a) :
Array β := (l.attachWith _ H).map fun x, h' => f x h'
@[csimp] private theorem pmap_eq_pmapImpl : @pmap = @pmapImpl := by
funext α β p f L h'
cases L
simp only [pmap, pmapImpl, List.attachWith_toArray, List.map_toArray, mk.injEq, List.map_attachWith]
apply List.pmap_congr_left
intro a m h₁ h₂
congr
@[simp] theorem _root_.List.attachWith_mem_toArray {l : List α} :
l.attachWith (fun x => x l.toArray) (fun x h => by simpa using h) =
l.attach.map fun x, h => x, by simpa using h := by
simp only [List.attachWith, List.attach, List.map_pmap]
apply List.pmap_congr_left
simp
/-! ## unattach
`Array.unattach` is the (one-sided) inverse of `Array.attach`. It is a synonym for `Array.map Subtype.val`.
@@ -83,7 +120,7 @@ def unattach {α : Type _} {p : α → Prop} (l : Array { x // p x }) := l.map (
@[simp] theorem unattach_attach {l : Array α} : l.attach.unattach = l := by
cases l
simp
simp only [List.attach_toArray, List.unattach_toArray, List.unattach_attachWith]
@[simp] theorem unattach_attachWith {p : α Prop} {l : Array α}
{H : a l, p a} :

View File

@@ -15,26 +15,26 @@ This file contains some theorems about `Array` and `List` needed for `Init.Data.
namespace Array
theorem foldlM_eq_foldlM_toList.aux [Monad m]
theorem foldlM_toList.aux [Monad m]
(f : β α m β) (arr : Array α) (i j) (H : arr.size i + j) (b) :
foldlM.loop f arr arr.size (Nat.le_refl _) i j b = (arr.toList.drop j).foldlM f b := by
unfold foldlM.loop
split; split
· cases Nat.not_le_of_gt _ (Nat.zero_add _ H)
· rename_i i; rw [Nat.succ_add] at H
simp [foldlM_eq_foldlM_toList.aux f arr i (j+1) H]
simp [foldlM_toList.aux f arr i (j+1) H]
rw (occs := .pos [2]) [ List.getElem_cons_drop_succ_eq_drop _]
rfl
· rw [List.drop_of_length_le (Nat.ge_of_not_lt _)]; rfl
theorem foldlM_eq_foldlM_toList [Monad m]
@[simp] theorem foldlM_toList [Monad m]
(f : β α m β) (init : β) (arr : Array α) :
arr.foldlM f init = arr.toList.foldlM f init := by
simp [foldlM, foldlM_eq_foldlM_toList.aux]
arr.toList.foldlM f init = arr.foldlM f init := by
simp [foldlM, foldlM_toList.aux]
theorem foldl_eq_foldl_toList (f : β α β) (init : β) (arr : Array α) :
arr.foldl f init = arr.toList.foldl f init :=
List.foldl_eq_foldlM .. foldlM_eq_foldlM_toList ..
@[simp] theorem foldl_toList (f : β α β) (init : β) (arr : Array α) :
arr.toList.foldl f init = arr.foldl f init :=
List.foldl_eq_foldlM .. foldlM_toList ..
theorem foldrM_eq_reverse_foldlM_toList.aux [Monad m]
(f : α β m β) (arr : Array α) (init : β) (i h) :
@@ -51,23 +51,23 @@ theorem foldrM_eq_reverse_foldlM_toList [Monad m] (f : α → β → m β) (init
match arr, this with | _, .inl rfl => rfl | arr, .inr h => ?_
simp [foldrM, h, foldrM_eq_reverse_foldlM_toList.aux, List.take_length]
theorem foldrM_eq_foldrM_toList [Monad m]
@[simp] theorem foldrM_toList [Monad m]
(f : α β m β) (init : β) (arr : Array α) :
arr.foldrM f init = arr.toList.foldrM f init := by
arr.toList.foldrM f init = arr.foldrM f init := by
rw [foldrM_eq_reverse_foldlM_toList, List.foldlM_reverse]
theorem foldr_eq_foldr_toList (f : α β β) (init : β) (arr : Array α) :
arr.foldr f init = arr.toList.foldr f init :=
List.foldr_eq_foldrM .. foldrM_eq_foldrM_toList ..
@[simp] theorem foldr_toList (f : α β β) (init : β) (arr : Array α) :
arr.toList.foldr f init = arr.foldr f init :=
List.foldr_eq_foldrM .. foldrM_toList ..
@[simp] theorem push_toList (arr : Array α) (a : α) : (arr.push a).toList = arr.toList ++ [a] := by
simp [push, List.concat_eq_append]
@[simp] theorem toListAppend_eq (arr : Array α) (l) : arr.toListAppend l = arr.toList ++ l := by
simp [toListAppend, foldr_eq_foldr_toList]
simp [toListAppend, foldr_toList]
@[simp] theorem toListImpl_eq (arr : Array α) : arr.toListImpl = arr.toList := by
simp [toListImpl, foldr_eq_foldr_toList]
simp [toListImpl, foldr_toList]
@[simp] theorem pop_toList (arr : Array α) : arr.pop.toList = arr.toList.dropLast := rfl
@@ -76,7 +76,7 @@ theorem foldr_eq_foldr_toList (f : α → β → β) (init : β) (arr : Array α
@[simp] theorem toList_append (arr arr' : Array α) :
(arr ++ arr').toList = arr.toList ++ arr'.toList := by
rw [ append_eq_append]; unfold Array.append
rw [foldl_eq_foldl_toList]
rw [ foldl_toList]
induction arr'.toList generalizing arr <;> simp [*]
@[simp] theorem toList_empty : (#[] : Array α).toList = [] := rfl
@@ -98,20 +98,44 @@ theorem foldr_eq_foldr_toList (f : α → β → β) (init : β) (arr : Array α
rw [ appendList_eq_append]; unfold Array.appendList
induction l generalizing arr <;> simp [*]
@[deprecated foldlM_eq_foldlM_toList (since := "2024-09-09")]
abbrev foldlM_eq_foldlM_data := @foldlM_eq_foldlM_toList
@[deprecated "Use the reverse direction of `foldrM_toList`." (since := "2024-11-13")]
theorem foldrM_eq_foldrM_toList [Monad m]
(f : α β m β) (init : β) (arr : Array α) :
arr.foldrM f init = arr.toList.foldrM f init := by
simp
@[deprecated foldl_eq_foldl_toList (since := "2024-09-09")]
abbrev foldl_eq_foldl_data := @foldl_eq_foldl_toList
@[deprecated "Use the reverse direction of `foldlM_toList`." (since := "2024-11-13")]
theorem foldlM_eq_foldlM_toList [Monad m]
(f : β α m β) (init : β) (arr : Array α) :
arr.foldlM f init = arr.toList.foldlM f init:= by
simp
@[deprecated "Use the reverse direction of `foldr_toList`." (since := "2024-11-13")]
theorem foldr_eq_foldr_toList
(f : α β β) (init : β) (arr : Array α) :
arr.foldr f init = arr.toList.foldr f init := by
simp
@[deprecated "Use the reverse direction of `foldl_toList`." (since := "2024-11-13")]
theorem foldl_eq_foldl_toList
(f : β α β) (init : β) (arr : Array α) :
arr.foldl f init = arr.toList.foldl f init:= by
simp
@[deprecated foldlM_toList (since := "2024-09-09")]
abbrev foldlM_eq_foldlM_data := @foldlM_toList
@[deprecated foldl_toList (since := "2024-09-09")]
abbrev foldl_eq_foldl_data := @foldl_toList
@[deprecated foldrM_eq_reverse_foldlM_toList (since := "2024-09-09")]
abbrev foldrM_eq_reverse_foldlM_data := @foldrM_eq_reverse_foldlM_toList
@[deprecated foldrM_eq_foldrM_toList (since := "2024-09-09")]
abbrev foldrM_eq_foldrM_data := @foldrM_eq_foldrM_toList
@[deprecated foldrM_toList (since := "2024-09-09")]
abbrev foldrM_eq_foldrM_data := @foldrM_toList
@[deprecated foldr_eq_foldr_toList (since := "2024-09-09")]
abbrev foldr_eq_foldr_data := @foldr_eq_foldr_toList
@[deprecated foldr_toList (since := "2024-09-09")]
abbrev foldr_eq_foldr_data := @foldr_toList
@[deprecated push_toList (since := "2024-09-09")]
abbrev push_data := @push_toList

View File

@@ -151,15 +151,15 @@ theorem foldrM_toArray [Monad m] (f : α → β → m β) (init : β) (l : List
theorem foldlM_toArray [Monad m] (f : β α m β) (init : β) (l : List α) :
l.toArray.foldlM f init = l.foldlM f init := by
rw [foldlM_eq_foldlM_toList]
rw [foldlM_toList]
theorem foldr_toArray (f : α β β) (init : β) (l : List α) :
l.toArray.foldr f init = l.foldr f init := by
rw [foldr_eq_foldr_toList]
rw [foldr_toList]
theorem foldl_toArray (f : β α β) (init : β) (l : List α) :
l.toArray.foldl f init = l.foldl f init := by
rw [foldl_eq_foldl_toList]
rw [foldl_toList]
/-- Variant of `foldrM_toArray` with a side condition for the `start` argument. -/
@[simp] theorem foldrM_toArray' [Monad m] (f : α β m β) (init : β) (l : List α)
@@ -174,21 +174,21 @@ theorem foldl_toArray (f : β → α → β) (init : β) (l : List α) :
(h : stop = l.toArray.size) :
l.toArray.foldlM f init 0 stop = l.foldlM f init := by
subst h
rw [foldlM_eq_foldlM_toList]
rw [foldlM_toList]
/-- Variant of `foldr_toArray` with a side condition for the `start` argument. -/
@[simp] theorem foldr_toArray' (f : α β β) (init : β) (l : List α)
(h : start = l.toArray.size) :
l.toArray.foldr f init start 0 = l.foldr f init := by
subst h
rw [foldr_eq_foldr_toList]
rw [foldr_toList]
/-- Variant of `foldl_toArray` with a side condition for the `stop` argument. -/
@[simp] theorem foldl_toArray' (f : β α β) (init : β) (l : List α)
(h : stop = l.toArray.size) :
l.toArray.foldl f init 0 stop = l.foldl f init := by
subst h
rw [foldl_eq_foldl_toList]
rw [foldl_toList]
@[simp] theorem append_toArray (l₁ l₂ : List α) :
l₁.toArray ++ l₂.toArray = (l₁ ++ l₂).toArray := by
@@ -202,6 +202,9 @@ theorem foldl_toArray (f : β → α → β) (init : β) (l : List α) :
@[simp] theorem foldl_push {l : List α} {as : Array α} : l.foldl Array.push as = as ++ l.toArray := by
induction l generalizing as <;> simp [*]
@[simp] theorem foldr_push {l : List α} {as : Array α} : l.foldr (fun a b => push b a) as = as ++ l.reverse.toArray := by
rw [foldr_eq_foldl_reverse, foldl_push]
@[simp] theorem findSomeM?_toArray [Monad m] [LawfulMonad m] (f : α m (Option β)) (l : List α) :
l.toArray.findSomeM? f = l.findSomeM? f := by
rw [Array.findSomeM?]
@@ -362,7 +365,8 @@ namespace Array
theorem foldrM_push [Monad m] (f : α β m β) (init : β) (arr : Array α) (a : α) :
(arr.push a).foldrM f init = f a init >>= arr.foldrM f := by
simp [foldrM_eq_reverse_foldlM_toList, -size_push]
simp only [foldrM_eq_reverse_foldlM_toList, push_toList, List.reverse_append, List.reverse_cons,
List.reverse_nil, List.nil_append, List.singleton_append, List.foldlM_cons, List.foldlM_reverse]
/--
Variant of `foldrM_push` with `h : start = arr.size + 1`
@@ -388,11 +392,11 @@ rather than `(arr.push a).size` as the argument.
@[inline] def toListRev (arr : Array α) : List α := arr.foldl (fun l t => t :: l) []
@[simp] theorem toListRev_eq (arr : Array α) : arr.toListRev = arr.toList.reverse := by
rw [toListRev, foldl_eq_foldl_toList, List.foldr_reverse, List.foldr_cons_nil]
rw [toListRev, foldl_toList, List.foldr_reverse, List.foldr_cons_nil]
theorem mapM_eq_foldlM [Monad m] [LawfulMonad m] (f : α m β) (arr : Array α) :
arr.mapM f = arr.foldlM (fun bs a => bs.push <$> f a) #[] := by
rw [mapM, aux, foldlM_eq_foldlM_toList]; rfl
rw [mapM, aux, foldlM_toList]; rfl
where
aux (i r) :
mapM.map f arr i r = (arr.toList.drop i).foldlM (fun bs a => bs.push <$> f a) r := by
@@ -407,7 +411,7 @@ where
@[simp] theorem toList_map (f : α β) (arr : Array α) : (arr.map f).toList = arr.toList.map f := by
rw [map, mapM_eq_foldlM]
apply congrArg toList (foldl_eq_foldl_toList (fun bs a => push bs (f a)) #[] arr) |>.trans
apply congrArg toList (foldl_toList (fun bs a => push bs (f a)) #[] arr).symm |>.trans
have H (l arr) : List.foldl (fun bs a => push bs (f a)) arr l = arr.toList ++ l.map f := by
induction l generalizing arr <;> simp [*]
simp [H]
@@ -1023,7 +1027,7 @@ theorem foldr_congr {as bs : Array α} (h₀ : as = bs) {f g : α → β → β}
theorem mapM_eq_mapM_toList [Monad m] [LawfulMonad m] (f : α m β) (arr : Array α) :
arr.mapM f = List.toArray <$> (arr.toList.mapM f) := by
rw [mapM_eq_foldlM, foldlM_eq_foldlM_toList, List.foldrM_reverse]
rw [mapM_eq_foldlM, foldlM_toList, List.foldrM_reverse]
conv => rhs; rw [ List.reverse_reverse arr.toList]
induction arr.toList.reverse with
| nil => simp
@@ -1148,7 +1152,7 @@ theorem getElem?_modify {as : Array α} {i : Nat} {f : αα} {j : Nat} :
@[simp] theorem toList_filter (p : α Bool) (l : Array α) :
(l.filter p).toList = l.toList.filter p := by
dsimp only [filter]
rw [foldl_eq_foldl_toList]
rw [ foldl_toList]
generalize l.toList = l
suffices a, (List.foldl (fun r a => if p a = true then push r a else r) a l).toList =
a.toList ++ List.filter p l by
@@ -1179,7 +1183,7 @@ theorem filter_congr {as bs : Array α} (h : as = bs)
@[simp] theorem toList_filterMap (f : α Option β) (l : Array α) :
(l.filterMap f).toList = l.toList.filterMap f := by
dsimp only [filterMap, filterMapM]
rw [foldlM_eq_foldlM_toList]
rw [ foldlM_toList]
generalize l.toList = l
have this : a : Array β, (Id.run (List.foldlM (m := Id) ?_ a l)).toList =
a.toList ++ List.filterMap f l := ?_
@@ -1258,7 +1262,7 @@ theorem getElem?_append {as bs : Array α} {n : Nat} :
@[simp] theorem toList_flatten {l : Array (Array α)} :
l.flatten.toList = (l.toList.map toList).flatten := by
dsimp [flatten]
simp only [foldl_eq_foldl_toList]
simp only [ foldl_toList]
generalize l.toList = l
have : a : Array α, (List.foldl ?_ a l).toList = a.toList ++ ?_ := ?_
exact this #[]

View File

@@ -0,0 +1,159 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Array.Lemmas
import Init.Data.Array.Attach
import Init.Data.List.Monadic
/-!
# Lemmas about `Array.forIn'` and `Array.forIn`.
-/
namespace Array
open Nat
/-! ## Monadic operations -/
/-! ### mapM -/
theorem mapM_eq_foldlM_push [Monad m] [LawfulMonad m] (f : α m β) (l : Array α) :
mapM f l = l.foldlM (fun acc a => return (acc.push ( f a))) #[] := by
rcases l with l
simp only [List.mapM_toArray, bind_pure_comp, size_toArray, List.foldlM_toArray']
rw [List.mapM_eq_reverse_foldlM_cons]
simp only [bind_pure_comp, Functor.map_map]
suffices (k), (fun a => a.reverse.toArray) <$> List.foldlM (fun acc a => (fun a => a :: acc) <$> f a) k l =
List.foldlM (fun acc a => acc.push <$> f a) k.reverse.toArray l by
exact this []
intro k
induction l generalizing k with
| nil => simp
| cons a as ih =>
simp [ih, List.foldlM_cons]
/-! ### foldlM and foldrM -/
theorem foldlM_map [Monad m] (f : β₁ β₂) (g : α β₂ m α) (l : Array β₁) (init : α) :
(l.map f).foldlM g init = l.foldlM (fun x y => g x (f y)) init := by
cases l
rw [List.map_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldlM_map]
theorem foldrM_map [Monad m] [LawfulMonad m] (f : β₁ β₂) (g : β₂ α m α) (l : Array β₁)
(init : α) : (l.map f).foldrM g init = l.foldrM (fun x y => g (f x) y) init := by
cases l
rw [List.map_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldrM_map]
theorem foldlM_filterMap [Monad m] [LawfulMonad m] (f : α Option β) (g : γ β m γ) (l : Array α) (init : γ) :
(l.filterMap f).foldlM g init =
l.foldlM (fun x y => match f y with | some b => g x b | none => pure x) init := by
cases l
rw [List.filterMap_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldlM_filterMap]
rfl
theorem foldrM_filterMap [Monad m] [LawfulMonad m] (f : α Option β) (g : β γ m γ) (l : Array α) (init : γ) :
(l.filterMap f).foldrM g init =
l.foldrM (fun x y => match f x with | some b => g b y | none => pure y) init := by
cases l
rw [List.filterMap_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldrM_filterMap]
rfl
theorem foldlM_filter [Monad m] [LawfulMonad m] (p : α Bool) (g : β α m β) (l : Array α) (init : β) :
(l.filter p).foldlM g init =
l.foldlM (fun x y => if p y then g x y else pure x) init := by
cases l
rw [List.filter_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldlM_filter]
theorem foldrM_filter [Monad m] [LawfulMonad m] (p : α Bool) (g : α β m β) (l : Array α) (init : β) :
(l.filter p).foldrM g init =
l.foldrM (fun x y => if p x then g x y else pure y) init := by
cases l
rw [List.filter_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldrM_filter]
/-! ### forIn' -/
/--
We can express a for loop over an array as a fold,
in which whenever we reach `.done b` we keep that value through the rest of the fold.
-/
theorem forIn'_eq_foldlM [Monad m] [LawfulMonad m]
(l : Array α) (f : (a : α) a l β m (ForInStep β)) (init : β) :
forIn' l init f = ForInStep.value <$>
l.attach.foldlM (fun b a, m => match b with
| .yield b => f a m b
| .done b => pure (.done b)) (ForInStep.yield init) := by
cases l
rw [List.attach_toArray] -- Why doesn't this fire via `simp`?
simp only [List.forIn'_toArray, List.forIn'_eq_foldlM, List.attachWith_mem_toArray, size_toArray,
List.length_map, List.length_attach, List.foldlM_toArray', List.foldlM_map]
congr
/-- We can express a for loop over an array which always yields as a fold. -/
@[simp] theorem forIn'_yield_eq_foldlM [Monad m] [LawfulMonad m]
(l : Array α) (f : (a : α) a l β m γ) (g : (a : α) a l β γ β) (init : β) :
forIn' l init (fun a m b => (fun c => .yield (g a m b c)) <$> f a m b) =
l.attach.foldlM (fun b a, m => g a m b <$> f a m b) init := by
cases l
rw [List.attach_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldlM_map]
theorem forIn'_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
(l : Array α) (f : (a : α) a l β β) (init : β) :
forIn' l init (fun a m b => pure (.yield (f a m b))) =
pure (f := m) (l.attach.foldl (fun b a, h => f a h b) init) := by
cases l
simp [List.forIn'_pure_yield_eq_foldl, List.foldl_map]
@[simp] theorem forIn'_yield_eq_foldl
(l : Array α) (f : (a : α) a l β β) (init : β) :
forIn' (m := Id) l init (fun a m b => .yield (f a m b)) =
l.attach.foldl (fun b a, h => f a h b) init := by
cases l
simp [List.foldl_map]
/--
We can express a for loop over an array as a fold,
in which whenever we reach `.done b` we keep that value through the rest of the fold.
-/
theorem forIn_eq_foldlM [Monad m] [LawfulMonad m]
(f : α β m (ForInStep β)) (init : β) (l : Array α) :
forIn l init f = ForInStep.value <$>
l.foldlM (fun b a => match b with
| .yield b => f a b
| .done b => pure (.done b)) (ForInStep.yield init) := by
cases l
simp only [List.forIn_toArray, List.forIn_eq_foldlM, size_toArray, List.foldlM_toArray']
congr
/-- We can express a for loop over an array which always yields as a fold. -/
@[simp] theorem forIn_yield_eq_foldlM [Monad m] [LawfulMonad m]
(l : Array α) (f : α β m γ) (g : α β γ β) (init : β) :
forIn l init (fun a b => (fun c => .yield (g a b c)) <$> f a b) =
l.foldlM (fun b a => g a b <$> f a b) init := by
cases l
simp [List.foldlM_map]
theorem forIn_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
(l : Array α) (f : α β β) (init : β) :
forIn l init (fun a b => pure (.yield (f a b))) =
pure (f := m) (l.foldl (fun b a => f a b) init) := by
cases l
simp [List.forIn_pure_yield_eq_foldl, List.foldl_map]
@[simp] theorem forIn_yield_eq_foldl
(l : Array α) (f : α β β) (init : β) :
forIn (m := Id) l init (fun a b => .yield (f a b)) =
l.foldl (fun b a => f a b) init := by
cases l
simp [List.foldl_map]
end Array

View File

@@ -15,15 +15,6 @@ structure Subarray (α : Type u) where
start_le_stop : start stop
stop_le_array_size : stop array.size
@[deprecated Subarray.array (since := "2024-04-13")]
abbrev Subarray.as (s : Subarray α) : Array α := s.array
@[deprecated Subarray.start_le_stop (since := "2024-04-13")]
theorem Subarray.h₁ (s : Subarray α) : s.start s.stop := s.start_le_stop
@[deprecated Subarray.stop_le_array_size (since := "2024-04-13")]
theorem Subarray.h₂ (s : Subarray α) : s.stop s.array.size := s.stop_le_array_size
namespace Subarray
def size (s : Subarray α) : Nat :=

View File

@@ -29,9 +29,6 @@ section Nat
instance natCastInst : NatCast (BitVec w) := BitVec.ofNat w
@[deprecated isLt (since := "2024-03-12")]
theorem toNat_lt (x : BitVec n) : x.toNat < 2^n := x.isLt
/-- Theorem for normalizing the bit vector literal representation. -/
-- TODO: This needs more usage data to assess which direction the simp should go.
@[simp, bv_toNat] theorem ofNat_eq_ofNat : @OfNat.ofNat (BitVec n) i _ = .ofNat n i := rfl

View File

@@ -47,6 +47,25 @@ def Float.lt : Float → Float → Prop := fun a b =>
def Float.le : Float Float Prop := fun a b =>
floatSpec.le a.val b.val
/--
Raw transmutation from `UInt64`.
Floats and UInts have the same endianness on all supported platforms.
IEEE 754 very precisely specifies the bit layout of floats.
-/
@[extern "lean_float_from_bits"] opaque Float.fromBits : UInt64 Float
/--
Raw transmutation to `UInt64`.
Floats and UInts have the same endianness on all supported platforms.
IEEE 754 very precisely specifies the bit layout of floats.
Note that this function is distinct from `Float.toUInt64`, which attempts
to preserve the numeric value, and not the bitwise value.
-/
@[extern "lean_float_to_bits"] opaque Float.toBits : Float UInt64
instance : Add Float := Float.add
instance : Sub Float := Float.sub
instance : Mul Float := Float.mul

View File

@@ -551,7 +551,7 @@ theorem reverseAux_eq_append (as bs : List α) : reverseAux as bs = reverseAux a
/-! ### flatten -/
/--
`O(|flatten L|)`. `join L` concatenates all the lists in `L` into one list.
`O(|flatten L|)`. `flatten L` concatenates all the lists in `L` into one list.
* `flatten [[a], [], [b, c], [d, e, f]] = [a, b, c, d, e, f]`
-/
def flatten : List (List α) List α

View File

@@ -91,7 +91,7 @@ The following operations are given `@[csimp]` replacements below:
@[specialize] def foldrTR (f : α β β) (init : β) (l : List α) : β := l.toArray.foldr f init
@[csimp] theorem foldr_eq_foldrTR : @foldr = @foldrTR := by
funext α β f init l; simp [foldrTR, Array.foldr_eq_foldr_toList, -Array.size_toArray]
funext α β f init l; simp [foldrTR, Array.foldr_toList, -Array.size_toArray]
/-! ### flatMap -/
@@ -331,7 +331,7 @@ def enumFromTR (n : Nat) (l : List α) : List (Nat × α) :=
| a::as, n => by
rw [ show _ + as.length = n + (a::as).length from Nat.succ_add .., foldr, go as]
simp [enumFrom, f]
rw [Array.foldr_eq_foldr_toList]
rw [ Array.foldr_toList]
simp [go]
/-! ## Other list operations -/

View File

@@ -6,6 +6,7 @@ Authors: Leonardo de Moura
prelude
import Init.ByCases
import Init.Data.Prod
import Init.Data.RArray
namespace Nat.Linear
@@ -15,7 +16,7 @@ namespace Nat.Linear
abbrev Var := Nat
abbrev Context := List Nat
abbrev Context := Lean.RArray Nat
/--
When encoding polynomials. We use `fixedVar` for encoding numerals.
@@ -23,12 +24,7 @@ abbrev Context := List Nat
def fixedVar := 100000000 -- Any big number should work here
def Var.denote (ctx : Context) (v : Var) : Nat :=
bif v == fixedVar then 1 else go ctx v
where
go : List Nat Nat Nat
| [], _ => 0
| a::_, 0 => a
| _::as, i+1 => go as i
bif v == fixedVar then 1 else ctx.get v
inductive Expr where
| num (v : Nat)

View File

@@ -16,10 +16,6 @@ def getM [Alternative m] : Option α → m α
| none => failure
| some a => pure a
@[deprecated getM (since := "2024-04-17")]
-- `[Monad m]` is not needed here.
def toMonad [Monad m] [Alternative m] : Option α m α := getM
/-- Returns `true` on `some x` and `false` on `none`. -/
@[inline] def isSome : Option α Bool
| some _ => true
@@ -28,8 +24,6 @@ def toMonad [Monad m] [Alternative m] : Option α → m α := getM
@[simp] theorem isSome_none : @isSome α none = false := rfl
@[simp] theorem isSome_some : isSome (some a) = true := rfl
@[deprecated isSome (since := "2024-04-17"), inline] def toBool : Option α Bool := isSome
/-- Returns `true` on `none` and `false` on `some x`. -/
@[inline] def isNone : Option α Bool
| some _ => false

69
src/Init/Data/RArray.lean Normal file
View File

@@ -0,0 +1,69 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joachim Breitner
-/
prelude
import Init.PropLemmas
namespace Lean
/--
A `RArray` can model `Fin n → α` or `Array α`, but is optimized for a fast kernel-reducible `get`
operation.
The primary intended use case is the “denote” function of a typical proof by reflection proof, where
only the `get` operation is necessary. It is not suitable as a general-purpose data structure.
There is no well-formedness invariant attached to this data structure, to keep it concise; it's
semantics is given through `RArray.get`. In that way one can also view an `RArray` as a decision
tree implementing `Nat → α`.
See `RArray.ofFn` and `RArray.ofArray` in module `Lean.Data.RArray` for functions that construct an
`RArray`.
It is not universe-polymorphic. ; smaller proof objects and no complication with the `ToExpr` type
class.
-/
inductive RArray (α : Type) : Type where
| leaf : α RArray α
| branch : Nat RArray α RArray α RArray α
variable {α : Type}
/-- The crucial operation, written with very little abstractional overhead -/
noncomputable def RArray.get (a : RArray α) (n : Nat) : α :=
RArray.rec (fun x => x) (fun p _ _ l r => (Nat.ble p n).rec l r) a
private theorem RArray.get_eq_def (a : RArray α) (n : Nat) :
a.get n = match a with
| .leaf x => x
| .branch p l r => (Nat.ble p n).rec (l.get n) (r.get n) := by
conv => lhs; unfold RArray.get
split <;> rfl
/-- `RArray.get`, implemented conventionally -/
def RArray.getImpl (a : RArray α) (n : Nat) : α :=
match a with
| .leaf x => x
| .branch p l r => if n < p then l.getImpl n else r.getImpl n
@[csimp]
theorem RArray.get_eq_getImpl : @RArray.get = @RArray.getImpl := by
funext α a n
induction a with
| leaf _ => rfl
| branch p l r ihl ihr =>
rw [RArray.getImpl, RArray.get_eq_def]
simp only [ihl, ihr, Nat.not_le, Nat.ble_eq, ite_not]
cases hnp : Nat.ble p n <;> rfl
instance : GetElem (RArray α) Nat α (fun _ _ => True) where
getElem a n _ := a.get n
def RArray.size : RArray α Nat
| leaf _ => 1
| branch _ l r => l.size + r.size
end Lean

View File

@@ -514,9 +514,6 @@ instance : Inhabited String := ⟨""⟩
instance : Append String := String.append
@[deprecated push (since := "2024-04-06")]
def str : String Char String := push
@[inline] def pushn (s : String) (c : Char) (n : Nat) : String :=
n.repeat (fun s => s.push c) s

View File

@@ -133,8 +133,8 @@ def foldNatBinBoolPred (fn : Nat → Nat → Bool) (a₁ a₂ : Expr) : Option E
return mkConst ``Bool.false
def foldNatBeq := fun _ : Bool => foldNatBinBoolPred (fun a b => a == b)
def foldNatBle := fun _ : Bool => foldNatBinBoolPred (fun a b => a < b)
def foldNatBlt := fun _ : Bool => foldNatBinBoolPred (fun a b => a b)
def foldNatBlt := fun _ : Bool => foldNatBinBoolPred (fun a b => a < b)
def foldNatBle := fun _ : Bool => foldNatBinBoolPred (fun a b => a b)
def natFoldFns : List (Name × BinFoldFn) :=
[(``Nat.add, foldNatAdd),

View File

@@ -29,4 +29,4 @@ import Lean.Data.Xml
import Lean.Data.NameTrie
import Lean.Data.RBTree
import Lean.Data.RBMap
import Lean.Data.Rat
import Lean.Data.RArray

View File

@@ -33,6 +33,16 @@ def find? (m : NameMap α) (n : Name) : Option α := RBMap.find? m n
instance : ForIn m (NameMap α) (Name × α) :=
inferInstanceAs (ForIn _ (RBMap ..) ..)
/-- `filter f m` returns the `NameMap` consisting of all
"`key`/`val`"-pairs in `m` where `f key val` returns `true`. -/
def filter (f : Name α Bool) (m : NameMap α) : NameMap α := RBMap.filter f m
/-- `filterMap f m` filters an `NameMap` and simultaneously modifies the filtered values.
It takes a function `f : Name → α → Option β` and applies `f name` to the value with key `name`.
The resulting entries with non-`none` value are collected to form the output `NameMap`. -/
def filterMap (f : Name α Option β) (m : NameMap α) : NameMap β := RBMap.filterMap f m
end NameMap
def NameSet := RBTree Name Name.quickCmp
@@ -53,6 +63,9 @@ def append (s t : NameSet) : NameSet :=
instance : Append NameSet where
append := NameSet.append
/-- `filter f s` returns the `NameSet` consisting of all `x` in `s` where `f x` returns `true`. -/
def filter (f : Name Bool) (s : NameSet) : NameSet := RBTree.filter f s
end NameSet
def NameSSet := SSet Name
@@ -73,6 +86,9 @@ instance : EmptyCollection NameHashSet := ⟨empty⟩
instance : Inhabited NameHashSet := {}
def insert (s : NameHashSet) (n : Name) := Std.HashSet.insert s n
def contains (s : NameHashSet) (n : Name) : Bool := Std.HashSet.contains s n
/-- `filter f s` returns the `NameHashSet` consisting of all `x` in `s` where `f x` returns `true`. -/
def filter (f : Name Bool) (s : NameHashSet) : NameHashSet := Std.HashSet.filter f s
end NameHashSet
def MacroScopesView.isPrefixOf (v₁ v₂ : MacroScopesView) : Bool :=

75
src/Lean/Data/RArray.lean Normal file
View File

@@ -0,0 +1,75 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joachim Breitner
-/
prelude
import Init.Data.RArray
import Lean.ToExpr
/-!
Auxillary definitions related to `Lean.RArray` that are typically only used in meta-code, in
particular the `ToExpr` instance.
-/
namespace Lean
-- This function could live in Init/Data/RArray.lean, but without omega it's tedious to implement
def RArray.ofFn {n : Nat} (f : Fin n α) (h : 0 < n) : RArray α :=
go 0 n h (Nat.le_refl _)
where
go (lb ub : Nat) (h1 : lb < ub) (h2 : ub n) : RArray α :=
if h : lb + 1 = ub then
.leaf (f lb, Nat.lt_of_lt_of_le h1 h2)
else
let mid := (lb + ub)/2
.branch mid (go lb mid (by omega) (by omega)) (go mid ub (by omega) h2)
def RArray.ofArray (xs : Array α) (h : 0 < xs.size) : RArray α :=
.ofFn (xs[·]) h
/-- The correctness theorem for `ofFn` -/
theorem RArray.get_ofFn {n : Nat} (f : Fin n α) (h : 0 < n) (i : Fin n) :
(ofFn f h).get i = f i :=
go 0 n h (Nat.le_refl _) (Nat.zero_le _) i.2
where
go lb ub h1 h2 (h3 : lb i.val) (h3 : i.val < ub) : (ofFn.go f lb ub h1 h2).get i = f i := by
induction lb, ub, h1, h2 using RArray.ofFn.go.induct (f := f) (n := n)
case case1 =>
simp [ofFn.go, RArray.get_eq_getImpl, RArray.getImpl]
congr
omega
case case2 ih1 ih2 hiu =>
rw [ofFn.go]; simp only [reduceDIte, *]
simp [RArray.get_eq_getImpl, RArray.getImpl] at *
split
· rw [ih1] <;> omega
· rw [ih2] <;> omega
@[simp]
theorem RArray.size_ofFn {n : Nat} (f : Fin n α) (h : 0 < n) :
(ofFn f h).size = n :=
go 0 n h (Nat.le_refl _)
where
go lb ub h1 h2 : (ofFn.go f lb ub h1 h2).size = ub - lb := by
induction lb, ub, h1, h2 using RArray.ofFn.go.induct (f := f) (n := n)
case case1 => simp [ofFn.go, size]; omega
case case2 ih1 ih2 hiu => rw [ofFn.go]; simp [size, *]; omega
section Meta
open Lean
def RArray.toExpr (ty : Expr) (f : α Expr) : RArray α Expr
| .leaf x =>
mkApp2 (mkConst ``RArray.leaf) ty (f x)
| .branch p l r =>
mkApp4 (mkConst ``RArray.branch) ty (mkRawNatLit p) (l.toExpr ty f) (r.toExpr ty f)
instance [ToExpr α] : ToExpr (RArray α) where
toTypeExpr := mkApp (mkConst ``RArray) (toTypeExpr α)
toExpr a := a.toExpr (toTypeExpr α) toExpr
end Meta
end Lean

View File

@@ -404,6 +404,24 @@ def intersectBy {γ : Type v₁} {δ : Type v₂} (mergeFn : α → β → γ
| some b₂ => acc.insert a <| mergeFn a b₁ b₂
| none => acc
/--
`filter f m` returns the `RBMap` consisting of all
"`key`/`val`"-pairs in `m` where `f key val` returns `true`.
-/
def filter (f : α β Bool) (m : RBMap α β cmp) : RBMap α β cmp :=
m.fold (fun r k v => if f k v then r.insert k v else r) {}
/--
`filterMap f m` filters an `RBMap` and simultaneously modifies the filtered values.
It takes a function `f : α → β → Option γ` and applies `f k v` to the value with key `k`.
The resulting entries with non-`none` value are collected to form the output `RBMap`.
-/
def filterMap (f : α β Option γ) (m : RBMap α β cmp) : RBMap α γ cmp :=
m.fold (fun r k v => match f k v with
| none => r
| some b => r.insert k b) {}
end RBMap
def rbmapOf {α : Type u} {β : Type v} (l : List (α × β)) (cmp : α α Ordering) : RBMap α β cmp :=

View File

@@ -114,6 +114,13 @@ def union (t₁ t₂ : RBTree α cmp) : RBTree α cmp :=
def diff (t₁ t₂ : RBTree α cmp) : RBTree α cmp :=
t₂.fold .erase t₁
/--
`filter f m` returns the `RBTree` consisting of all
`x` in `m` where `f x` returns `true`.
-/
def filter (f : α Bool) (m : RBTree α cmp) : RBTree α cmp :=
RBMap.filter (fun a _ => f a) m
end RBTree
def rbtreeOf {α : Type u} (l : List α) (cmp : α α Ordering) : RBTree α cmp :=

View File

@@ -233,11 +233,14 @@ where
return ( `((with_annotate_term $(stx[0]) @ParserDescr.sepBy1) $p $sep $psep $(quote allowTrailingSep)), 1)
isValidAtom (s : String) : Bool :=
-- Pretty-printing instructions shouldn't affect validity
let s := s.trim
!s.isEmpty &&
s.front != '\'' &&
(s.front != '\'' || s == "''") &&
s.front != '\"' &&
!(s.front == '`' && (s.endPos == ⟨1⟩ || isIdFirst (s.get ⟨1⟩) || isIdBeginEscape (s.get ⟨1⟩))) &&
!s.front.isDigit
!s.front.isDigit &&
!(s.any Char.isWhitespace)
processAtom (stx : Syntax) := do
match stx[0].isStrLit? with

View File

@@ -216,35 +216,23 @@ Flatten out ands. That is look for hypotheses of the form `h : (x && y) = true`
with `h.left : x = true` and `h.right : y = true`. This can enable more fine grained substitutions
in embedded constraint substitution.
-/
def andFlatteningPass : Pass where
partial def andFlatteningPass : Pass where
name := `andFlattening
run goal := do
goal.withContext do
let hyps goal.getNondepPropHyps
let mut newHyps := #[]
let mut oldHyps := #[]
for hyp in hyps do
let typ hyp.getType
let_expr Eq α eqLhs eqRhs := typ | continue
let_expr Bool.and lhs rhs := eqLhs | continue
let_expr Bool := α | continue
let_expr Bool.true := eqRhs | continue
let mkEqTrue (lhs : Expr) : Expr :=
mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) lhs (mkConst ``Bool.true)
let hypExpr := ( hyp.getDecl).toExpr
let leftHyp : Hypothesis := {
userName := ( hyp.getUserName) ++ `left,
type := mkEqTrue lhs,
value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_left) lhs rhs hypExpr
for fvar in hyps do
let hyp : Hypothesis := {
userName := ( fvar.getDecl).userName
type := fvar.getType
value := mkFVar fvar
}
let rightHyp : Hypothesis := {
userName := ( hyp.getUserName) ++ `right,
type := mkEqTrue rhs,
value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_right) lhs rhs hypExpr
}
newHyps := newHyps.push leftHyp
newHyps := newHyps.push rightHyp
oldHyps := oldHyps.push hyp
let sizeBefore := newHyps.size
newHyps splitAnds hyp newHyps
if newHyps.size > sizeBefore then
oldHyps := oldHyps.push fvar
if newHyps.size == 0 then
return goal
else
@@ -252,6 +240,38 @@ def andFlatteningPass : Pass where
-- Given that we collected the hypotheses in the correct order above the invariant is given
let goal goal.tryClearMany oldHyps
return goal
where
splitAnds (hyp : Hypothesis) (hyps : Array Hypothesis) (first : Bool := true) :
MetaM (Array Hypothesis) := do
match trySplit hyp with
| some (left, right) =>
let hyps splitAnds left hyps false
splitAnds right hyps false
| none =>
if first then
return hyps
else
return hyps.push hyp
trySplit (hyp : Hypothesis) : MetaM (Option (Hypothesis × Hypothesis)) := do
let typ := hyp.type
let_expr Eq α eqLhs eqRhs := typ | return none
let_expr Bool.and lhs rhs := eqLhs | return none
let_expr Bool.true := eqRhs | return none
let_expr Bool := α | return none
let mkEqTrue (lhs : Expr) : Expr :=
mkApp3 (mkConst ``Eq [1]) (mkConst ``Bool) lhs (mkConst ``Bool.true)
let leftHyp : Hypothesis := {
userName := hyp.userName,
type := mkEqTrue lhs,
value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_left) lhs rhs hyp.value
}
let rightHyp : Hypothesis := {
userName := hyp.userName,
type := mkEqTrue rhs,
value := mkApp3 (mkConst ``Std.Tactic.BVDecide.Normalize.Bool.and_right) lhs rhs hyp.value
}
return some (leftHyp, rightHyp)
/--
Substitute embedded constraints. That is look for hypotheses of the form `h : x = true` and use
@@ -308,22 +328,18 @@ def acNormalizePass : Pass where
return newGoal
/--
The normalization passes used by `bv_normalize` and thus `bv_decide`.
-/
def defaultPipeline (cfg : BVDecideConfig ): List Pass :=
[
rewriteRulesPass cfg.maxSteps,
andFlatteningPass,
embeddedConstraintPass cfg.maxSteps
]
def passPipeline (cfg : BVDecideConfig) : List Pass := Id.run do
let mut passPipeline := defaultPipeline cfg
let mut passPipeline := [rewriteRulesPass cfg.maxSteps]
if cfg.acNf then
passPipeline := passPipeline ++ [acNormalizePass]
if cfg.andFlattening then
passPipeline := passPipeline ++ [andFlatteningPass]
if cfg.embeddedConstraintSubst then
passPipeline := passPipeline ++ [embeddedConstraintPass cfg.maxSteps]
return passPipeline
end Pass

View File

@@ -254,10 +254,6 @@ Apply `And.intro` as much as possible to goal `mvarId`.
abbrev splitAnd (mvarId : MVarId) : MetaM (List MVarId) :=
splitAndCore mvarId
@[deprecated splitAnd (since := "2024-03-17")]
def _root_.Lean.Meta.splitAnd (mvarId : MVarId) : MetaM (List MVarId) :=
mvarId.splitAnd
def exfalso (mvarId : MVarId) : MetaM MVarId :=
mvarId.withContext do
mvarId.checkNotAssigned `exfalso

View File

@@ -8,6 +8,7 @@ import Lean.Meta.Check
import Lean.Meta.Offset
import Lean.Meta.AppBuilder
import Lean.Meta.KExprMap
import Lean.Data.RArray
namespace Lean.Meta.Linear.Nat
@@ -141,8 +142,11 @@ end ToLinear
export ToLinear (toLinearCnstr? toLinearExpr)
def toContextExpr (ctx : Array Expr) : MetaM Expr := do
mkListLit (mkConst ``Nat) ctx.toList
def toContextExpr (ctx : Array Expr) : Expr :=
if h : 0 < ctx.size then
RArray.toExpr (mkConst ``Nat) id (RArray.ofArray ctx h)
else
RArray.toExpr (mkConst ``Nat) id (RArray.leaf (mkNatLit 0))
def reflTrue : Expr :=
mkApp2 (mkConst ``Eq.refl [levelOne]) (mkConst ``Bool) (mkConst ``Bool.true)

View File

@@ -31,17 +31,17 @@ def simpCnstrPos? (e : Expr) : MetaM (Option (Expr × Expr)) := do
let c₂ := c₁.norm
if c₂.isUnsat then
let r := mkConst ``False
let p := mkApp3 (mkConst ``Nat.Linear.ExprCnstr.eq_false_of_isUnsat) ( toContextExpr ctx) (toExpr c) reflTrue
let p := mkApp3 (mkConst ``Nat.Linear.ExprCnstr.eq_false_of_isUnsat) (toContextExpr ctx) (toExpr c) reflTrue
return some (r, mkExpectedTypeHint p ( mkEq lhs r))
else if c₂.isValid then
let r := mkConst ``True
let p := mkApp3 (mkConst ``Nat.Linear.ExprCnstr.eq_true_of_isValid) ( toContextExpr ctx) (toExpr c) reflTrue
let p := mkApp3 (mkConst ``Nat.Linear.ExprCnstr.eq_true_of_isValid) (toContextExpr ctx) (toExpr c) reflTrue
return some (r, mkExpectedTypeHint p ( mkEq lhs r))
else
let c₂ : LinearCnstr := c₂.toExpr
let r c₂.toArith ctx
if r != lhs then
let p := mkApp4 (mkConst ``Nat.Linear.ExprCnstr.eq_of_toNormPoly_eq) ( toContextExpr ctx) (toExpr c) (toExpr c₂) reflTrue
let p := mkApp4 (mkConst ``Nat.Linear.ExprCnstr.eq_of_toNormPoly_eq) (toContextExpr ctx) (toExpr c) (toExpr c₂) reflTrue
return some (r, mkExpectedTypeHint p ( mkEq lhs r))
else
return none
@@ -81,7 +81,7 @@ def simpExpr? (e : Expr) : MetaM (Option (Expr × Expr)) := do
if p'.length < p.length then
-- We only return some if monomials were fused
let e' : LinearExpr := p'.toExpr
let p := mkApp4 (mkConst ``Nat.Linear.Expr.eq_of_toNormPoly_eq) ( toContextExpr ctx) (toExpr e) (toExpr e') reflTrue
let p := mkApp4 (mkConst ``Nat.Linear.Expr.eq_of_toNormPoly_eq) (toContextExpr ctx) (toExpr e) (toExpr e') reflTrue
let r e'.toArith ctx
return some (r, p)
else

View File

@@ -6,9 +6,10 @@ Authors: Leonardo de Moura
prelude
import Init.Data.Ord
import Init.Data.Array.DecidableEq
import Lean.Data.Rat
import Std.Internal.Rat
namespace Lean.Meta.Linear
open Std.Internal
structure Var where
id : Nat

View File

@@ -1092,19 +1092,29 @@ def coeDelaborator : Delab := whenPPOption getPPCoercions do
let e getExpr
let .const declName _ := e.getAppFn | failure
let some info Meta.getCoeFnInfo? declName | failure
let n := e.getAppNumArgs
guard <| n info.numArgs
if ( getPPOption getPPExplicit) && info.coercee != 0 then
-- Approximation: the only implicit arguments come before the coercee
failure
let n := e.getAppNumArgs
withOverApp info.numArgs do
match info.type with
| .coe => `($( withNaryArg info.coercee delab))
| .coeFun =>
if n = info.numArgs then
`($( withNaryArg info.coercee delab))
else
withNaryArg info.coercee delab
| .coeSort => `($( withNaryArg info.coercee delab))
if n == info.numArgs then
delabHead info 0 false
else
let nargs := n - info.numArgs
delabAppCore nargs (delabHead info nargs) (unexpand := false)
where
delabHead (info : CoeFnInfo) (nargs : Nat) (insertExplicit : Bool) : Delab := do
guard <| !insertExplicit
if info.type == .coeFun && nargs > 0 then
-- In the CoeFun case, annotate with the coercee itself.
-- We can still see the whole coercion expression by hovering over the whitespace between the arguments.
withNaryArg info.coercee <| withAnnotateTermInfo delab
else
withAnnotateTermInfo do
match info.type with
| .coe => `($( withNaryArg info.coercee delab))
| .coeFun => `($( withNaryArg info.coercee delab))
| .coeSort => `($( withNaryArg info.coercee delab))
@[builtin_delab app.dite]
def delabDIte : Delab := whenNotPPOption getPPExplicit <| whenPPOption getPPNotation <| withOverApp 5 do

View File

@@ -6,5 +6,6 @@ Authors: Sebastian Ullrich
prelude
import Std.Data
import Std.Sat
import Std.Time
import Std.Tactic
import Std.Internal

View File

@@ -38,7 +38,7 @@ theorem toListModel_mkArray_nil {c} :
@[simp]
theorem computeSize_eq {buckets : Array (AssocList α β)} :
computeSize buckets = (toListModel buckets).length := by
rw [computeSize, toListModel, List.flatMap_eq_foldl, Array.foldl_eq_foldl_toList]
rw [computeSize, toListModel, List.flatMap_eq_foldl, Array.foldl_toList]
suffices (l : List (AssocList α β)) (l' : List ((a : α) × β a)),
l.foldl (fun d b => d + b.toList.length) l'.length =
(l.foldl (fun acc a => acc ++ a.toList) l').length
@@ -61,13 +61,13 @@ theorem isEmpty_eq_isEmpty [BEq α] [Hashable α] {m : Raw α β} (h : Raw.WFImp
theorem fold_eq {l : Raw α β} {f : γ (a : α) β a γ} {init : γ} :
l.fold f init = l.buckets.foldl (fun acc l => l.foldl f acc) init := by
simp only [Raw.fold, Raw.foldM, Array.foldlM_eq_foldlM_toList, Array.foldl_eq_foldl_toList,
simp only [Raw.fold, Raw.foldM, Array.foldlM_toList, Array.foldl_toList,
List.foldl_eq_foldlM, Id.run, AssocList.foldl]
theorem fold_cons_apply {l : Raw α β} {acc : List γ} (f : (a : α) β a γ) :
l.fold (fun acc k v => f k v :: acc) acc =
((toListModel l.buckets).reverse.map (fun p => f p.1 p.2)) ++ acc := by
rw [fold_eq, Array.foldl_eq_foldl_toList, toListModel]
rw [fold_eq, Array.foldl_toList, toListModel]
generalize l.buckets.toList = l
induction l generalizing acc with
| nil => simp

View File

@@ -8,7 +8,8 @@ import Init.NotationExtra
import Init.Data.ToString.Macro
import Init.Data.Int.DivMod
import Init.Data.Nat.Gcd
namespace Lean
namespace Std
namespace Internal
/-!
Rational numbers for implementing decision procedures.
@@ -144,4 +145,5 @@ instance : Coe Int Rat where
coe num := { num }
end Rat
end Lean
end Internal
end Std

View File

@@ -61,7 +61,7 @@ theorem CNF.Clause.mem_lrat_of_mem (clause : CNF.Clause (PosFin n)) (h1 : l ∈
| nil => cases h1
| cons hd tl ih =>
unfold DefaultClause.ofArray at h2
rw [Array.foldr_eq_foldr_toList, List.toArray_toList] at h2
rw [ Array.foldr_toList, List.toArray_toList] at h2
dsimp only [List.foldr] at h2
split at h2
· cases h2
@@ -77,7 +77,7 @@ theorem CNF.Clause.mem_lrat_of_mem (clause : CNF.Clause (PosFin n)) (h1 : l ∈
· assumption
· next heq _ _ =>
unfold DefaultClause.ofArray
rw [Array.foldr_eq_foldr_toList, List.toArray_toList]
rw [ Array.foldr_toList, List.toArray_toList]
exact heq
· cases h1
· simp only [ Option.some.inj h2]
@@ -89,7 +89,7 @@ theorem CNF.Clause.mem_lrat_of_mem (clause : CNF.Clause (PosFin n)) (h1 : l ∈
apply ih
assumption
unfold DefaultClause.ofArray
rw [Array.foldr_eq_foldr_toList, List.toArray_toList]
rw [ Array.foldr_toList, List.toArray_toList]
exact heq
theorem CNF.Clause.convertLRAT_sat_of_sat (clause : CNF.Clause (PosFin n))

View File

@@ -106,7 +106,7 @@ theorem readyForRupAdd_ofArray {n : Nat} (arr : Array (Option (DefaultClause n))
constructor
· simp only [ofArray]
· have hsize : (ofArray arr).assignments.size = n := by
simp only [ofArray, Array.foldl_eq_foldl_toList]
simp only [ofArray, Array.foldl_toList]
have hb : (mkArray n unassigned).size = n := by simp only [Array.size_mkArray]
have hl (acc : Array Assignment) (ih : acc.size = n) (cOpt : Option (DefaultClause n)) (_cOpt_in_arr : cOpt arr.toList) :
(ofArray_fold_fn acc cOpt).size = n := by rw [size_ofArray_fold_fn acc cOpt, ih]
@@ -187,7 +187,7 @@ theorem readyForRupAdd_ofArray {n : Nat} (arr : Array (Option (DefaultClause n))
exact ih i b h
rcases List.foldlRecOn arr.toList ofArray_fold_fn (mkArray n unassigned) hb hl with _h_size, h'
intro i b h
simp only [ofArray, Array.foldl_eq_foldl_toList] at h
simp only [ofArray, Array.foldl_toList] at h
exact h' i b h
theorem readyForRatAdd_ofArray {n : Nat} (arr : Array (Option (DefaultClause n))) :
@@ -605,7 +605,7 @@ theorem deleteOne_preserves_strongAssignmentsInvariant {n : Nat} (f : DefaultFor
theorem readyForRupAdd_delete {n : Nat} (f : DefaultFormula n) (arr : Array Nat) :
ReadyForRupAdd f ReadyForRupAdd (delete f arr) := by
intro h
rw [delete, Array.foldl_eq_foldl_toList]
rw [delete, Array.foldl_toList]
constructor
· have hb : f.rupUnits = #[] := h.1
have hl (acc : DefaultFormula n) (ih : acc.rupUnits = #[]) (id : Nat) (_id_in_arr : id arr.toList) :
@@ -625,7 +625,7 @@ theorem readyForRatAdd_delete {n : Nat} (f : DefaultFormula n) (arr : Array Nat)
ReadyForRatAdd f ReadyForRatAdd (delete f arr) := by
intro h
constructor
· rw [delete, Array.foldl_eq_foldl_toList]
· rw [delete, Array.foldl_toList]
have hb : f.ratUnits = #[] := h.1
have hl (acc : DefaultFormula n) (ih : acc.ratUnits = #[]) (id : Nat) (_id_in_arr : id arr.toList) :
(deleteOne acc id).ratUnits = #[] := by rw [deleteOne_preserves_ratUnits, ih]
@@ -659,7 +659,7 @@ theorem deleteOne_subset (f : DefaultFormula n) (id : Nat) (c : DefaultClause n)
theorem delete_subset (f : DefaultFormula n) (arr : Array Nat) (c : DefaultClause n) :
c toList (delete f arr) c toList f := by
simp only [delete, Array.foldl_eq_foldl_toList]
simp only [delete, Array.foldl_toList]
have hb : c toList f c toList f := id
have hl (f' : DefaultFormula n) (ih : c toList f' c toList f) (id : Nat) (_ : id arr.toList) :
c toList (deleteOne f' id) c toList f := by intro h; exact ih <| deleteOne_subset f' id c h

View File

@@ -739,7 +739,7 @@ theorem size_assignemnts_confirmRupHint {n : Nat} (clauses : Array (Option (Defa
theorem size_assignments_performRupCheck {n : Nat} (f : DefaultFormula n) (rupHints : Array Nat) :
(performRupCheck f rupHints).1.assignments.size = f.assignments.size := by
simp only [performRupCheck]
rw [Array.foldl_eq_foldl_toList]
rw [ Array.foldl_toList]
have hb : (f.assignments, ([] : CNF.Clause (PosFin n)), false, false).1.size = f.assignments.size := rfl
have hl (acc : Array Assignment × CNF.Clause (PosFin n) × Bool × Bool) (hsize : acc.1.size = f.assignments.size)
(id : Nat) (_ : id rupHints.toList) : (confirmRupHint f.clauses acc id).1.size = f.assignments.size := by
@@ -1288,7 +1288,7 @@ theorem restoreAssignments_performRupCheck {n : Nat} (f : DefaultFormula n) (f_a
have derivedLits_satisfies_invariant := derivedLitsInvariant_performRupCheck f f_assignments_size rupHints f'_assignments_size
simp only at derivedLits_satisfies_invariant
generalize (performRupCheck f rupHints).2.1 = derivedLits at *
rw [ f'_def, Array.foldl_eq_foldl_toList]
rw [ f'_def, Array.foldl_toList]
let derivedLits_arr : Array (Literal (PosFin n)) := {toList := derivedLits}
have derivedLits_arr_def : derivedLits_arr = {toList := derivedLits} := rfl
have derivedLits_arr_nodup := nodup_derivedLits f f_assignments_size rupHints f'_assignments_size derivedLits
@@ -1301,7 +1301,7 @@ theorem restoreAssignments_performRupCheck {n : Nat} (f : DefaultFormula n) (f_a
clear_insert_inductive_case f f_assignments_size derivedLits_arr derivedLits_arr_nodup idx assignments ih
rcases Array.foldl_induction motive h_base h_inductive with h_size, h
apply Array.ext
· rw [Array.foldl_eq_foldl_toList, size_clearUnit_foldl f'.assignments clearUnit size_clearUnit derivedLits,
· rw [ Array.foldl_toList, size_clearUnit_foldl f'.assignments clearUnit size_clearUnit derivedLits,
f'_assignments_size, f_assignments_size]
· intro i hi1 hi2
rw [f_assignments_size] at hi2

View File

@@ -544,7 +544,7 @@ theorem reduce_postcondition {n : Nat} (c : DefaultClause n) (assignment : Array
( l : Literal (PosFin n), reduce c assignment = reducedToUnit l (p : (PosFin n) Bool), p assignment p c p l) := by
let c_arr := c.clause.toArray
have c_clause_rw : c.clause = c_arr.toList := by simp [c_arr]
rw [reduce, c_clause_rw, Array.foldl_eq_foldl_toList]
rw [reduce, c_clause_rw, Array.foldl_toList]
let motive := ReducePostconditionInductionMotive c_arr assignment
have h_base : motive 0 reducedToEmpty := by
have : (a : PosFin n) (b : Bool), (reducedToEmpty = reducedToUnit (a, b)) = False := by intros; simp

View File

@@ -99,17 +99,5 @@ attribute [bv_normalize] BitVec.mul_eq
attribute [bv_normalize] BitVec.udiv_eq
attribute [bv_normalize] BitVec.umod_eq
@[bv_normalize]
theorem Bool.and_eq_and (x y : Bool) : x.and y = (x && y) := by
rfl
@[bv_normalize]
theorem Bool.or_eq_or (x y : Bool) : x.or y = (x || y) := by
rfl
@[bv_normalize]
theorem Bool.no_eq_not (x : Bool) : x.not = !x := by
rfl
end Normalize
end Std.Tactic.BVDecide

View File

@@ -29,6 +29,16 @@ structure BVDecideConfig where
-/
acNf : Bool := false
/--
Split hypotheses of the form `h : (x && y) = true` into `h1 : x = true` and `h2 : y = true`.
This has synergy potential with embedded constraint substitution.
-/
andFlattening : Bool := true
/--
Look at all hypotheses of the form `h : x = true`, if `x` occurs in another hypothesis substitute
it with `true`.
-/
embeddedConstraintSubst : Bool := true
/--
Output the AIG of bv_decide as graphviz into a file called aig.gv in the working directory of the
Lean process.
-/

231
src/Std/Time.lean Normal file
View File

@@ -0,0 +1,231 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Time
import Std.Time.Date
import Std.Time.Zoned
import Std.Time.Format
import Std.Time.DateTime
import Std.Time.Notation
import Std.Time.Duration
import Std.Time.Zoned.Database
namespace Std
namespace Time
/-!
# Time
The Lean API for date, time, and duration functionalities.
# Overview
This module of the standard library defines various concepts related to time, such as dates, times,
time zones and durations. These types are designed to be strongly-typed and to avoid problems with
conversion. It offers both unbounded and bounded variants to suit different use cases, like
adding days to a date or representing ordinal values.
# Date and Time Components
Date and time components are classified into different types based how you SHOULD use them. These
components are categorized as:
## Offset
Offsets represent unbounded shifts in specific date or time units. They are typically used in operations
like `date.addDays` where a `Day.Offset` is the parameter. Some offsets, such as `Month.Offset`, do not
correspond directly to a specific duration in seconds, as their value depends on the context (if
the year is leap or the size of the month). Offsets with a clear correspondent to seconds can be
converted because they use an internal type called `UnitVal`.
- Types with a correspondence to seconds:
- `Day.Offset`
- `Hour.Offset`
- `Week.Offset`
- `Millisecond.Offset`
- `Nanosecond.Offset`
- `Second.Offset`
- Types without a correspondence to seconds:
- `Month.Offset`
- `Year.Offset`
## Ordinal
Ordinal types represent specific bounded values in reference to another unit, e.g., `Day.Ordinal`
represents a day in a month, ranging from 1 to 31. Some ordinal types like `Hour.Ordinal` and `Second.Ordinal`,
allow for values beyond the normal range (e.g, 60 seconds) to accommodate special cases with leap seconds
like `23:59:60` that is valid in ISO 8601.
- Ordinal types:
- `Day.Ordinal`: Ranges from 1 to 31.
- `Day.Ordinal.OfYear`: Ranges from 1 to (365 or 366).
- `Month.Ordinal`: Ranges from 1 to 12.
- `WeekOfYear.Ordinal`: Ranges from 1 to 53.
- `Hour.Ordinal`: Ranges from 0 to 23.
- `Millisecond.Ordinal`: Ranges from 0 to 999.
- `Minute.Ordinal`: Ranges from 0 to 59.
- `Nanosecond.Ordinal`: Ranges from 0 to 999,999,999.
- `Second.Ordinal`: Ranges from 0 to 60.
- `Weekday`: That is a inductive type with all the seven days.
## Span
Span types are used as subcomponents of other types. They represent a range of values in the limits
of the parent type, e.g, `Nanosecond.Span` ranges from -999,999,999 to 999,999,999, as 1,000,000,000
nanoseconds corresponds to one second.
- Span types:
- `Nanosecond.Span`: Ranges from -999,999,999 to 999,999,999.
# Date and Time Types
Dates and times are made up of different parts. An `Ordinal` is an absolute value, like a specific day in a month,
while an `Offset` is a shift forward or backward in time, used in arithmetic operations to add or subtract days, months or years.
Dates use components like `Year.Ordinal`, `Month.Ordinal`, and `Day.Ordinal` to ensure they represent
valid points in time.
Some types, like `Duration`, include a `Span` to represent ranges over other types, such as `Second.Offset`.
This type can have a fractional nanosecond part that can be negative or positive that is represented as a `Nanosecond.Span`.
## Date
These types provide precision down to the day level, useful for representing and manipulating dates.
- **`PlainDate`:** Represents a calendar date in the format `YYYY-MM-DD`.
## Time
These types offer precision down to the nanosecond level, useful for representing and manipulating time of day.
- **`PlainTime`**: Represents a time of day in the format `HH:mm:ss,sssssssss`.
## Date and time
Combines date and time into a single representation, useful for precise timestamps and scheduling.
- **`PlainDateTime`**: Represents both date and time in the format `YYYY-MM-DDTHH:mm:ss,sssssssss`.
- **`Timestamp`**: Represents a specific point in time with nanosecond precision. Its zero value corresponds
to the UNIX epoch. This type should be used when sending or receiving timestamps between systems.
## Zoned date and times.
Combines date, time and time zones.
- **`DateTime`**: Represents both date and time but with a time zone in the type constructor.
- **`ZonedDateTime`**: Is a way to represent date and time that includes `ZoneRules`, which consider
Daylight Saving Time (DST). This means it can handle local time changes throughout the year better
than a regular `DateTime`. If you want to use a specific time zone without worrying about DST, you can
use the `ofTimestampWithZone` function, which gives you a `ZonedDateTime` based only on that time zone,
without considering the zone rules, otherwise you can use `ofTimestamp` or `ofTimestampWithIdentifier`.
## Duration
Represents spans of time and the difference between two points in time.
- **`Duration`**: Represents the time span or difference between two `Timestamp`s values with nanosecond precision.
# 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. 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 supported formats include:
- `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.
- `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.
- `u`: Represents the year.
- `uu`: Two-digit year format, showing the last two digits (e.g., "04" for 2004).
- `uuuu`: Displays the year in a four-digit format (e.g., "2004" or "-1000").
- `uuuu+`: Extended format for handling years with more than four digits (e.g., "12345" or "-12345"). Useful for historical dates far into the past or future!
- `D`: Represents the day of the year.
- `M`: Represents the month of the year, displayed as either a number or text.
- `M`, `MM`: Displays the month as a number, with `MM` zero-padded (e.g., "7" for July, "07" for July with padding).
- `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).
- `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").
- `w`: Represents the week of the week-based year, each week starts on Monday (e.g., "27").
- `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).
- `e`: Represents the weekday as number or text.
- `e`, `ee`: Displays the the as a number, starting from 1 (Monday) to 7 (Sunday).
- `eee`, `eeee`, `eeeee`: Displays the weekday as text (same format as `E`).
- `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 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").
- 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").
- 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").
- 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").
- 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").
- 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").
- 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 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 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 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 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 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, 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, 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
In order to help the user build dates easily, there are a lot of macros available for creating dates.
The `.sssssssss` can be ommited in most cases.
- **`date("uuuu-MM-dd")`**: Represents a date in the `uuuu-MM-dd` format, where `uuuu` refers to the year.
- **`time("HH:mm:ss.sssssssss")`**: Represents a time in the format `HH:mm:ss.sssssssss`, including optional support for nanoseconds.
- **`datetime("uuuu-MM-ddTHH:mm:ss.sssssssss")`**: Represents a datetime value in the `uuuu-MM-ddTHH:mm:ss.sssssssss` format, with optional nanoseconds.
- **`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.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.
-/

8
src/Std/Time/Date.lean Normal file
View File

@@ -0,0 +1,8 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Date.Basic
import Std.Time.Date.PlainDate

View File

@@ -0,0 +1,476 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Date.Unit.Basic
import Std.Time.Date.ValidDate
import Std.Time.Time.Basic
namespace Std
namespace Time
namespace Nanosecond
namespace Offset
/--
Convert `Nanosecond.Offset` into `Day.Offset`.
-/
@[inline]
def toDays (nanoseconds : Nanosecond.Offset) : Day.Offset :=
nanoseconds.div 86400000000000
/--
Convert `Day.Offset` into `Nanosecond.Offset`.
-/
@[inline]
def ofDays (days : Day.Offset) : Nanosecond.Offset :=
days.mul 86400000000000
/--
Convert `Nanosecond.Offset` into `Week.Offset`.
-/
@[inline]
def toWeeks (nanoseconds : Nanosecond.Offset) : Week.Offset :=
nanoseconds.div 604800000000000
/--
Convert `Week.Offset` into `Nanosecond.Offset`.
-/
@[inline]
def ofWeeks (weeks : Week.Offset) : Nanosecond.Offset :=
weeks.mul 604800000000000
end Offset
end Nanosecond
namespace Millisecond
namespace Offset
/--
Convert `Millisecond.Offset` into `Day.Offset`.
-/
@[inline]
def toDays (milliseconds : Millisecond.Offset) : Day.Offset :=
milliseconds.div 86400000
/--
Convert `Day.Offset` into `Millisecond.Offset`.
-/
@[inline]
def ofDays (days : Day.Offset) : Millisecond.Offset :=
days.mul 86400000
/--
Convert `Millisecond.Offset` into `Week.Offset`.
-/
@[inline]
def toWeeks (milliseconds : Millisecond.Offset) : Week.Offset :=
milliseconds.div 604800000
/--
Convert `Week.Offset` into `Millisecond.Offset`.
-/
@[inline]
def ofWeeks (weeks : Week.Offset) : Millisecond.Offset :=
weeks.mul 604800000
end Offset
end Millisecond
namespace Second
namespace Offset
/--
Convert `Second.Offset` into `Day.Offset`.
-/
@[inline]
def toDays (seconds : Second.Offset) : Day.Offset :=
seconds.div 86400
/--
Convert `Day.Offset` into `Second.Offset`.
-/
@[inline]
def ofDays (days : Day.Offset) : Second.Offset :=
days.mul 86400
/--
Convert `Second.Offset` into `Week.Offset`.
-/
@[inline]
def toWeeks (seconds : Second.Offset) : Week.Offset :=
seconds.div 604800
/--
Convert `Week.Offset` into `Second.Offset`.
-/
@[inline]
def ofWeeks (weeks : Week.Offset) : Second.Offset :=
weeks.mul 604800
end Offset
end Second
namespace Minute
namespace Offset
/--
Convert `Minute.Offset` into `Day.Offset`.
-/
@[inline]
def toDays (minutes : Minute.Offset) : Day.Offset :=
minutes.div 1440
/--
Convert `Day.Offset` into `Minute.Offset`.
-/
@[inline]
def ofDays (days : Day.Offset) : Minute.Offset :=
days.mul 1440
/--
Convert `Minute.Offset` into `Week.Offset`.
-/
@[inline]
def toWeeks (minutes : Minute.Offset) : Week.Offset :=
minutes.div 10080
/--
Convert `Week.Offset` into `Minute.Offset`.
-/
@[inline]
def ofWeeks (weeks : Week.Offset) : Minute.Offset :=
weeks.mul 10080
end Offset
end Minute
namespace Hour
namespace Offset
/--
Convert `Hour.Offset` into `Day.Offset`.
-/
@[inline]
def toDays (hours : Hour.Offset) : Day.Offset :=
hours.div 24
/--
Convert `Day.Offset` into `Hour.Offset`.
-/
@[inline]
def ofDays (days : Day.Offset) : Hour.Offset :=
days.mul 24
/--
Convert `Hour.Offset` into `Week.Offset`.
-/
@[inline]
def toWeeks (hours : Hour.Offset) : Week.Offset :=
hours.div 168
/--
Convert `Week.Offset` into `Hour.Offset`.
-/
@[inline]
def ofWeeks (weeks : Week.Offset) : Hour.Offset :=
weeks.mul 168
end Offset
end Hour
instance : HAdd Nanosecond.Offset Nanosecond.Offset Nanosecond.Offset where
hAdd x y := x.add y
instance : HAdd Nanosecond.Offset Millisecond.Offset Nanosecond.Offset where
hAdd x y := x.add y.toNanoseconds
instance : HAdd Nanosecond.Offset Second.Offset Nanosecond.Offset where
hAdd x y := x.add y.toNanoseconds
instance : HAdd Nanosecond.Offset Minute.Offset Nanosecond.Offset where
hAdd x y := x.add y.toNanoseconds
instance : HAdd Nanosecond.Offset Hour.Offset Nanosecond.Offset where
hAdd x y := x.add y.toNanoseconds
instance : HAdd Nanosecond.Offset Day.Offset Nanosecond.Offset where
hAdd x y := x.add y.toNanoseconds
instance : HAdd Nanosecond.Offset Week.Offset Nanosecond.Offset where
hAdd x y := x.add y.toNanoseconds
instance : HAdd Millisecond.Offset Nanosecond.Offset Nanosecond.Offset where
hAdd x y := x.toNanoseconds.add y
instance : HAdd Millisecond.Offset Millisecond.Offset Millisecond.Offset where
hAdd x y := x.add y
instance : HAdd Millisecond.Offset Second.Offset Millisecond.Offset where
hAdd x y := x.add y.toMilliseconds
instance : HAdd Millisecond.Offset Minute.Offset Millisecond.Offset where
hAdd x y := x.add y.toMilliseconds
instance : HAdd Millisecond.Offset Hour.Offset Millisecond.Offset where
hAdd x y := x.add y.toMilliseconds
instance : HAdd Millisecond.Offset Day.Offset Millisecond.Offset where
hAdd x y := x.add y.toMilliseconds
instance : HAdd Millisecond.Offset Week.Offset Millisecond.Offset where
hAdd x y := x.add y.toMilliseconds
instance : HAdd Second.Offset Nanosecond.Offset Nanosecond.Offset where
hAdd x y := x.toNanoseconds.add y
instance : HAdd Second.Offset Millisecond.Offset Millisecond.Offset where
hAdd x y := x.toMilliseconds.add y
instance : HAdd Second.Offset Second.Offset Second.Offset where
hAdd x y := x.add y
instance : HAdd Second.Offset Minute.Offset Second.Offset where
hAdd x y := x.add y.toSeconds
instance : HAdd Second.Offset Hour.Offset Second.Offset where
hAdd x y := x.add y.toSeconds
instance : HAdd Second.Offset Day.Offset Second.Offset where
hAdd x y := x.add y.toSeconds
instance : HAdd Second.Offset Week.Offset Second.Offset where
hAdd x y := x.add y.toSeconds
instance : HAdd Minute.Offset Nanosecond.Offset Nanosecond.Offset where
hAdd x y := x.toNanoseconds.add y
instance : HAdd Minute.Offset Millisecond.Offset Millisecond.Offset where
hAdd x y := x.toMilliseconds.add y
instance : HAdd Minute.Offset Second.Offset Second.Offset where
hAdd x y := x.toSeconds.add y
instance : HAdd Minute.Offset Minute.Offset Minute.Offset where
hAdd x y := x.add y
instance : HAdd Minute.Offset Hour.Offset Minute.Offset where
hAdd x y := x.add y.toMinutes
instance : HAdd Minute.Offset Day.Offset Minute.Offset where
hAdd x y := x.add y.toMinutes
instance : HAdd Minute.Offset Week.Offset Minute.Offset where
hAdd x y := x.add y.toMinutes
instance : HAdd Hour.Offset Nanosecond.Offset Nanosecond.Offset where
hAdd x y := x.toNanoseconds.add y
instance : HAdd Hour.Offset Millisecond.Offset Millisecond.Offset where
hAdd x y := x.toMilliseconds.add y
instance : HAdd Hour.Offset Second.Offset Second.Offset where
hAdd x y := x.toSeconds.add y
instance : HAdd Hour.Offset Minute.Offset Minute.Offset where
hAdd x y := x.toMinutes.add y
instance : HAdd Hour.Offset Hour.Offset Hour.Offset where
hAdd x y := x.add y
instance : HAdd Hour.Offset Day.Offset Hour.Offset where
hAdd x y := x.add y.toHours
instance : HAdd Hour.Offset Week.Offset Hour.Offset where
hAdd x y := x.add y.toHours
instance : HAdd Day.Offset Nanosecond.Offset Nanosecond.Offset where
hAdd x y := x.toNanoseconds.add y
instance : HAdd Day.Offset Millisecond.Offset Millisecond.Offset where
hAdd x y := x.toMilliseconds.add y
instance : HAdd Day.Offset Second.Offset Second.Offset where
hAdd x y := x.toSeconds.add y
instance : HAdd Day.Offset Minute.Offset Minute.Offset where
hAdd x y := x.toMinutes.add y
instance : HAdd Day.Offset Hour.Offset Hour.Offset where
hAdd x y := x.toHours.add y
instance : HAdd Day.Offset Day.Offset Day.Offset where
hAdd x y := x.add y
instance : HAdd Day.Offset Week.Offset Day.Offset where
hAdd x y := x.add y.toDays
instance : HAdd Week.Offset Nanosecond.Offset Nanosecond.Offset where
hAdd x y := x.toNanoseconds.add y
instance : HAdd Week.Offset Millisecond.Offset Millisecond.Offset where
hAdd x y := x.toMilliseconds.add y
instance : HAdd Week.Offset Second.Offset Second.Offset where
hAdd x y := x.toSeconds.add y
instance : HAdd Week.Offset Minute.Offset Minute.Offset where
hAdd x y := x.toMinutes.add y
instance : HAdd Week.Offset Hour.Offset Hour.Offset where
hAdd x y := x.toHours.add y
instance : HAdd Week.Offset Day.Offset Day.Offset where
hAdd x y := x.toDays.add y
instance : HAdd Week.Offset Week.Offset Week.Offset where
hAdd x y := x.add y
instance : HSub Nanosecond.Offset Nanosecond.Offset Nanosecond.Offset where
hSub x y := x.sub y
instance : HSub Nanosecond.Offset Millisecond.Offset Nanosecond.Offset where
hSub x y := x.sub y.toNanoseconds
instance : HSub Nanosecond.Offset Second.Offset Nanosecond.Offset where
hSub x y := x.sub y.toNanoseconds
instance : HSub Nanosecond.Offset Minute.Offset Nanosecond.Offset where
hSub x y := x.sub y.toNanoseconds
instance : HSub Nanosecond.Offset Hour.Offset Nanosecond.Offset where
hSub x y := x.sub y.toNanoseconds
instance : HSub Nanosecond.Offset Day.Offset Nanosecond.Offset where
hSub x y := x.sub y.toNanoseconds
instance : HSub Nanosecond.Offset Week.Offset Nanosecond.Offset where
hSub x y := x.sub y.toNanoseconds
instance : HSub Millisecond.Offset Nanosecond.Offset Nanosecond.Offset where
hSub x y := x.toNanoseconds.sub y
instance : HSub Millisecond.Offset Millisecond.Offset Millisecond.Offset where
hSub x y := x.sub y
instance : HSub Millisecond.Offset Second.Offset Millisecond.Offset where
hSub x y := x.sub y.toMilliseconds
instance : HSub Millisecond.Offset Minute.Offset Millisecond.Offset where
hSub x y := x.sub y.toMilliseconds
instance : HSub Millisecond.Offset Hour.Offset Millisecond.Offset where
hSub x y := x.sub y.toMilliseconds
instance : HSub Millisecond.Offset Day.Offset Millisecond.Offset where
hSub x y := x.sub y.toMilliseconds
instance : HSub Millisecond.Offset Week.Offset Millisecond.Offset where
hSub x y := x.sub y.toMilliseconds
instance : HSub Second.Offset Nanosecond.Offset Nanosecond.Offset where
hSub x y := x.toNanoseconds.sub y
instance : HSub Second.Offset Millisecond.Offset Millisecond.Offset where
hSub x y := x.toMilliseconds.sub y
instance : HSub Second.Offset Second.Offset Second.Offset where
hSub x y := x.sub y
instance : HSub Second.Offset Minute.Offset Second.Offset where
hSub x y := x.sub y.toSeconds
instance : HSub Second.Offset Hour.Offset Second.Offset where
hSub x y := x.sub y.toSeconds
instance : HSub Second.Offset Day.Offset Second.Offset where
hSub x y := x.sub y.toSeconds
instance : HSub Second.Offset Week.Offset Second.Offset where
hSub x y := x.sub y.toSeconds
instance : HSub Minute.Offset Nanosecond.Offset Nanosecond.Offset where
hSub x y := x.toNanoseconds.sub y
instance : HSub Minute.Offset Millisecond.Offset Millisecond.Offset where
hSub x y := x.toMilliseconds.sub y
instance : HSub Minute.Offset Second.Offset Second.Offset where
hSub x y := x.toSeconds.sub y
instance : HSub Minute.Offset Minute.Offset Minute.Offset where
hSub x y := x.sub y
instance : HSub Minute.Offset Hour.Offset Minute.Offset where
hSub x y := x.sub y.toMinutes
instance : HSub Minute.Offset Day.Offset Minute.Offset where
hSub x y := x.sub y.toMinutes
instance : HSub Minute.Offset Week.Offset Minute.Offset where
hSub x y := x.sub y.toMinutes
instance : HSub Hour.Offset Nanosecond.Offset Nanosecond.Offset where
hSub x y := x.toNanoseconds.sub y
instance : HSub Hour.Offset Millisecond.Offset Millisecond.Offset where
hSub x y := x.toMilliseconds.sub y
instance : HSub Hour.Offset Second.Offset Second.Offset where
hSub x y := x.toSeconds.sub y
instance : HSub Hour.Offset Minute.Offset Minute.Offset where
hSub x y := x.toMinutes.sub y
instance : HSub Hour.Offset Hour.Offset Hour.Offset where
hSub x y := x.sub y
instance : HSub Hour.Offset Day.Offset Hour.Offset where
hSub x y := x.sub y.toHours
instance : HSub Hour.Offset Week.Offset Hour.Offset where
hSub x y := x.sub y.toHours
instance : HSub Day.Offset Nanosecond.Offset Nanosecond.Offset where
hSub x y := x.toNanoseconds.sub y
instance : HSub Day.Offset Millisecond.Offset Millisecond.Offset where
hSub x y := x.toMilliseconds.sub y
instance : HSub Day.Offset Second.Offset Second.Offset where
hSub x y := x.toSeconds.sub y
instance : HSub Day.Offset Minute.Offset Minute.Offset where
hSub x y := x.toMinutes.sub y
instance : HSub Day.Offset Hour.Offset Hour.Offset where
hSub x y := x.toHours.sub y
instance : HSub Day.Offset Day.Offset Day.Offset where
hSub x y := x.sub y
instance : HSub Day.Offset Week.Offset Day.Offset where
hSub x y := x.sub y.toDays
instance : HSub Week.Offset Nanosecond.Offset Nanosecond.Offset where
hSub x y := x.toNanoseconds.sub y
instance : HSub Week.Offset Millisecond.Offset Millisecond.Offset where
hSub x y := x.toMilliseconds.sub y
instance : HSub Week.Offset Second.Offset Second.Offset where
hSub x y := x.toSeconds.sub y
instance : HSub Week.Offset Minute.Offset Minute.Offset where
hSub x y := x.toMinutes.sub y
instance : HSub Week.Offset Hour.Offset Hour.Offset where
hSub x y := x.toHours.sub y
instance : HSub Week.Offset Day.Offset Day.Offset where
hSub x y := x.toDays.sub y
instance : HSub Week.Offset Week.Offset Week.Offset where
hSub x y := x.sub y

View File

@@ -0,0 +1,354 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Internal
import Std.Time.Date.Basic
import Std.Internal.Rat
namespace Std
namespace Time
open Std.Internal
open Std.Time
open Internal
open Lean
set_option linter.all true
/--
`PlainDate` represents a date in the Year-Month-Day (YMD) format. It encapsulates the year, month,
and day components, with validation to ensure the date is valid.
-/
structure PlainDate where
/-- The year component of the date. It is represented as an `Offset` type from `Year`. -/
year : Year.Offset
/-- The month component of the date. It is represented as an `Ordinal` type from `Month`. -/
month : Month.Ordinal
/-- The day component of the date. It is represented as an `Ordinal` type from `Day`. -/
day : Day.Ordinal
/-- Validates the date by ensuring that the year, month, and day form a correct and valid date. -/
valid : year.Valid month day
deriving Repr
instance : Inhabited PlainDate where
default := 1, 1, 1, by decide
instance : BEq PlainDate where
beq x y := x.day == y.day && x.month == y.month && x.year == y.year
namespace PlainDate
/--
Creates a `PlainDate` by clipping the day to ensure validity. This function forces the date to be
valid by adjusting the day to fit within the valid range to fit the given month and year.
-/
@[inline]
def ofYearMonthDayClip (year : Year.Offset) (month : Month.Ordinal) (day : Day.Ordinal) : PlainDate :=
let day := month.clipDay year.isLeap day
PlainDate.mk year month day Month.Ordinal.valid_clipDay
instance : Inhabited PlainDate where
default := mk 0 1 1 (by decide)
/--
Creates a new `PlainDate` from year, month, and day components.
-/
@[inline]
def ofYearMonthDay? (year : Year.Offset) (month : Month.Ordinal) (day : Day.Ordinal) : Option PlainDate :=
if valid : year.Valid month day
then some (PlainDate.mk year month day valid)
else none
/--
Creates a `PlainDate` from a year and a day ordinal within that year.
-/
@[inline]
def ofYearOrdinal (year : Year.Offset) (ordinal : Day.Ordinal.OfYear year.isLeap) : PlainDate :=
let month, day, proof := ValidDate.ofOrdinal ordinal
year, month, day, proof
/--
Creates a `PlainDate` from the number of days since the UNIX epoch (January 1st, 1970).
-/
def ofDaysSinceUNIXEpoch (day : Day.Offset) : PlainDate :=
let z := day.toInt + 719468
let era := (if z 0 then z else z - 146096).tdiv 146097
let doe := z - era * 146097
let yoe := (doe - doe.tdiv 1460 + doe.tdiv 36524 - doe.tdiv 146096).tdiv 365
let y := yoe + era * 400
let doy := doe - (365 * yoe + yoe.tdiv 4 - yoe.tdiv 100)
let mp := (5 * doy + 2).tdiv 153
let d := doy - (153 * mp + 2).tdiv 5 + 1
let m := mp + (if mp < 10 then 3 else -9)
let y := y + (if m <= 2 then 1 else 0)
.ofYearMonthDayClip y (.clip m (by decide)) (.clip d (by decide))
/--
Returns the unaligned week of the month for a `PlainDate` (day divided by 7, plus 1).
-/
def weekOfMonth (date : PlainDate) : Bounded.LE 1 5 :=
date.day.sub 1 |>.ediv 7 (by decide) |>.add 1
/--
Determines the quarter of the year for the given `PlainDate`.
-/
def quarter (date : PlainDate) : Bounded.LE 1 4 :=
date.month.sub 1 |>.ediv 3 (by decide) |>.add 1
/--
Transforms a `PlainDate` into a `Day.Ordinal.OfYear`.
-/
def dayOfYear (date : PlainDate) : Day.Ordinal.OfYear date.year.isLeap :=
ValidDate.dayOfYear (date.month, date.day), date.valid
/--
Determines the era of the given `PlainDate` based on its year.
-/
@[inline]
def era (date : PlainDate) : Year.Era :=
date.year.era
/--
Checks if the `PlainDate` is in a leap year.
-/
@[inline]
def inLeapYear (date : PlainDate) : Bool :=
date.year.isLeap
/--
Converts a `PlainDate` to the number of days since the UNIX epoch.
-/
def toDaysSinceUNIXEpoch (date : PlainDate) : Day.Offset :=
let y : Int := if date.month.toInt > 2 then date.year else date.year.toInt - 1
let era : Int := (if y 0 then y else y - 399).tdiv 400
let yoe : Int := y - era * 400
let m : Int := date.month.toInt
let d : Int := date.day.toInt
let doy := (153 * (m + (if m > 2 then -3 else 9)) + 2).tdiv 5 + d - 1
let doe := yoe * 365 + yoe.tdiv 4 - yoe.tdiv 100 + doy
.ofInt (era * 146097 + doe - 719468)
/--
Adds a given number of days to a `PlainDate`.
-/
@[inline]
def addDays (date : PlainDate) (days : Day.Offset) : PlainDate :=
let dateDays := date.toDaysSinceUNIXEpoch
ofDaysSinceUNIXEpoch (dateDays + days)
/--
Subtracts a given number of days from a `PlainDate`.
-/
@[inline]
def subDays (date : PlainDate) (days : Day.Offset) : PlainDate :=
addDays date (-days)
/--
Adds a given number of weeks to a `PlainDate`.
-/
@[inline]
def addWeeks (date : PlainDate) (weeks : Week.Offset) : PlainDate :=
let dateDays := date.toDaysSinceUNIXEpoch
let daysToAdd := weeks.toDays
ofDaysSinceUNIXEpoch (dateDays + daysToAdd)
/--
Subtracts a given number of weeks from a `PlainDate`.
-/
@[inline]
def subWeeks (date : PlainDate) (weeks : Week.Offset) : PlainDate :=
addWeeks date (-weeks)
/--
Adds a given number of months to a `PlainDate`, clipping the day to the last valid day of the month.
-/
def addMonthsClip (date : PlainDate) (months : Month.Offset) : PlainDate :=
let totalMonths := (date.month.toOffset - 1) + months
let totalMonths : Int := totalMonths
let wrappedMonths := Bounded.LE.byEmod totalMonths 12 (by decide) |>.add 1
let yearsOffset := totalMonths / 12
PlainDate.ofYearMonthDayClip (date.year.add yearsOffset) wrappedMonths date.day
/--
Subtracts `Month.Offset` from a `PlainDate`, it clips the day to the last valid day of that month.
-/
@[inline]
def subMonthsClip (date : PlainDate) (months : Month.Offset) : PlainDate :=
addMonthsClip date (-months)
/--
Creates a `PlainDate` by rolling over the extra days to the next month.
-/
def rollOver (year : Year.Offset) (month : Month.Ordinal) (day : Day.Ordinal) : PlainDate :=
ofYearMonthDayClip year month 1 |>.addDays (day.toOffset - 1)
/--
Creates a new `PlainDate` by adjusting the year to the given `year` value. The month and day remain unchanged,
and any invalid days for the new year will be handled according to the `clip` behavior.
-/
@[inline]
def withYearClip (dt : PlainDate) (year : Year.Offset) : PlainDate :=
ofYearMonthDayClip year dt.month dt.day
/--
Creates a new `PlainDate` by adjusting the year to the given `year` value. The month and day are rolled
over to the next valid month and day if necessary.
-/
@[inline]
def withYearRollOver (dt : PlainDate) (year : Year.Offset) : PlainDate :=
rollOver year dt.month dt.day
/--
Adds a given number of months to a `PlainDate`, rolling over any excess days into the following month.
-/
def addMonthsRollOver (date : PlainDate) (months : Month.Offset) : PlainDate :=
addMonthsClip (ofYearMonthDayClip date.year date.month 1) months
|>.addDays (date.day.toOffset - 1)
/--
Subtracts `Month.Offset` from a `PlainDate`, rolling over excess days as needed.
-/
@[inline]
def subMonthsRollOver (date : PlainDate) (months : Month.Offset) : PlainDate :=
addMonthsRollOver date (-months)
/--
Adds `Year.Offset` to a `PlainDate`, rolling over excess days to the next month, or next year.
-/
@[inline]
def addYearsRollOver (date : PlainDate) (years : Year.Offset) : PlainDate :=
addMonthsRollOver date (years.mul 12)
/--
Subtracts `Year.Offset` from a `PlainDate`, rolling over excess days to the next month.
-/
@[inline]
def subYearsRollOver (date : PlainDate) (years : Year.Offset) : PlainDate :=
addMonthsRollOver date (- years.mul 12)
/--
Adds `Year.Offset` to a `PlainDate`, clipping the day to the last valid day of the month.
-/
@[inline]
def addYearsClip (date : PlainDate) (years : Year.Offset) : PlainDate :=
addMonthsClip date (years.mul 12)
/--
Subtracts `Year.Offset` from a `PlainDate`, clipping the day to the last valid day of the month.
-/
@[inline]
def subYearsClip (date : PlainDate) (years : Year.Offset) : PlainDate :=
addMonthsClip date (- years.mul 12)
/--
Creates a new `PlainDate` by adjusting the day of the month to the given `days` value, with any
out-of-range days clipped to the nearest valid date.
-/
@[inline]
def withDaysClip (dt : PlainDate) (days : Day.Ordinal) : PlainDate :=
ofYearMonthDayClip dt.year dt.month days
/--
Creates a new `PlainDate` by adjusting the day of the month to the given `days` value, with any
out-of-range days rolled over to the next month or year as needed.
-/
@[inline]
def withDaysRollOver (dt : PlainDate) (days : Day.Ordinal) : PlainDate :=
rollOver dt.year dt.month days
/--
Creates a new `PlainDate` by adjusting the month to the given `month` value.
The day remains unchanged, and any invalid days for the new month will be handled according to the `clip` behavior.
-/
@[inline]
def withMonthClip (dt : PlainDate) (month : Month.Ordinal) : PlainDate :=
ofYearMonthDayClip dt.year month dt.day
/--
Creates a new `PlainDate` by adjusting the month to the given `month` value.
The day is rolled over to the next valid month if necessary.
-/
@[inline]
def withMonthRollOver (dt : PlainDate) (month : Month.Ordinal) : PlainDate :=
rollOver dt.year month dt.day
/--
Calculates the `Weekday` of a given `PlainDate` using Zeller's Congruence for the Gregorian calendar.
-/
def weekday (date : PlainDate) : Weekday :=
let days := date.toDaysSinceUNIXEpoch.val
let res := if days -4 then (days + 4) % 7 else (days + 5) % 7 + 6
.ofOrdinal (Bounded.LE.ofNatWrapping res (by decide))
/--
Determines the week of the month for the given `PlainDate`. 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.
-/
def alignedWeekOfMonth (date : PlainDate) : Week.Ordinal.OfMonth :=
let weekday := date.withDaysClip 1 |>.weekday |>.toOrdinal |>.sub 1
let days := date.day |>.sub 1 |>.addBounds weekday
days |>.ediv 7 (by decide) |>.add 1
/--
Sets the date to the specified `desiredWeekday`. If the `desiredWeekday` is the same as the current weekday,
the original `date` is returned without modification. If the `desiredWeekday` is in the future, the
function adjusts the date forward to the next occurrence of that weekday.
-/
def withWeekday (date : PlainDate) (desiredWeekday : Weekday) : PlainDate :=
let weekday := date |>.weekday |>.toOrdinal
let offset := desiredWeekday.toOrdinal |>.subBounds weekday
let offset : Bounded.LE 0 6 :=
if h : offset.val < 0 then
offset.truncateTop (Int.le_sub_one_of_lt h) |>.addBounds (.exact 7)
|>.expandBottom (by decide)
else
offset.truncateBottom (Int.not_lt.mp h)
|>.expandTop (by decide)
date.addDays (Day.Offset.ofInt offset.toInt)
/--
Calculates the week of the year starting Monday for a given year.
-/
def weekOfYear (date : PlainDate) : Week.Ordinal :=
let y := date.year
let w := Bounded.LE.exact 10
|>.addBounds date.dayOfYear
|>.subBounds date.weekday.toOrdinal
|>.ediv 7 (by decide)
if h : w.val < 1 then
(y-1).weeks |>.expandBottom (by decide)
else if h₁ : w.val > y.weeks.val then
.ofNat' 1 (by decide)
else
let h := Int.not_lt.mp h
let h₁ := Int.not_lt.mp h₁
let w := w.truncateBottom h |>.truncateTop (Int.le_trans h₁ y.weeks.property.right)
w
instance : HAdd PlainDate Day.Offset PlainDate where
hAdd := addDays
instance : HSub PlainDate Day.Offset PlainDate where
hSub := subDays
instance : HAdd PlainDate Week.Offset PlainDate where
hAdd := addWeeks
instance : HSub PlainDate Week.Offset PlainDate where
hSub := subWeeks
end PlainDate
end Time
end Std

View File

@@ -0,0 +1,41 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Date.Unit.Day
import Std.Time.Date.Unit.Month
import Std.Time.Date.Unit.Year
import Std.Time.Date.Unit.Weekday
import Std.Time.Date.Unit.Week
/-!
This module defines various units used for measuring, counting, and converting between days, months,
years, weekdays, and weeks of the year.
The units are organized into types representing these time-related concepts, with operations provided
to facilitate conversions and manipulations between them.
-/
namespace Std
namespace Time
open Internal
namespace Day.Offset
/--
Convert `Week.Offset` into `Day.Offset`.
-/
@[inline]
def ofWeeks (week : Week.Offset) : Day.Offset :=
week.mul 7
/--
Convert `Day.Offset` into `Week.Offset`.
-/
@[inline]
def toWeeks (day : Day.Offset) : Week.Offset :=
day.ediv 7
end Day.Offset

View File

@@ -0,0 +1,221 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Time
namespace Std
namespace Time
namespace Day
open Lean Internal
set_option linter.all true
/--
`Ordinal` represents a bounded value for days, which ranges between 1 and 31.
-/
def Ordinal := Bounded.LE 1 31
deriving Repr, BEq, LE, LT
instance : OfNat Ordinal n :=
inferInstanceAs (OfNat (Bounded.LE 1 (1 + (30 : Nat))) n)
instance {x y : Ordinal} : Decidable (x y) :=
inferInstanceAs (Decidable (x.val y.val))
instance {x y : Ordinal} : Decidable (x < y) :=
inferInstanceAs (Decidable (x.val < y.val))
instance : Inhabited Ordinal where default := 1
/--
`Offset` represents an offset in days. It is defined as an `Int` with a base unit of 86400
(the number of seconds in a day).
-/
def Offset : Type := UnitVal 86400
deriving Repr, BEq, Inhabited, Add, Sub, Neg, LE, LT, ToString
instance : OfNat Offset n := UnitVal.ofNat n
instance {x y : Offset} : Decidable (x y) :=
inferInstanceAs (Decidable (x.val y.val))
instance {x y : Offset} : Decidable (x < y) :=
inferInstanceAs (Decidable (x.val < y.val))
namespace Ordinal
/--
Creates an `Ordinal` from an integer, ensuring the value is within bounds.
-/
@[inline]
def ofInt (data : Int) (h : 1 data data 31) : Ordinal :=
Bounded.LE.mk data h
/--
`OfYear` represents the day ordinal within a year, which can be bounded between 1 and 365 or 366,
depending on whether it's a leap year.
-/
def OfYear (leap : Bool) := Bounded.LE 1 (.ofNat (if leap then 366 else 365))
instance : Repr (OfYear leap) where
reprPrec r p := reprPrec r.val p
instance : ToString (OfYear leap) where
toString r := toString r.val
namespace OfYear
/--
Creates an ordinal for a specific day within the year, ensuring that the provided day (`data`)
is within the valid range for the year, which can be 1 to 365 or 366 for leap years.
-/
@[inline]
def ofNat (data : Nat) (h : data 1 data (if leap then 366 else 365) := by decide) : OfYear leap :=
Bounded.LE.ofNat' data h
end OfYear
instance : OfNat (Ordinal.OfYear leap) n :=
match leap with
| true => inferInstanceAs (OfNat (Bounded.LE 1 (1 + (365 : Nat))) n)
| false => inferInstanceAs (OfNat (Bounded.LE 1 (1 + (364 : Nat))) n)
instance : Inhabited (Ordinal.OfYear leap) where
default := by
refine 1, And.intro (by decide) ?_
split <;> simp
/--
Creates an ordinal from a natural number, ensuring the number is within the valid range
for days of a month (1 to 31).
-/
@[inline]
def ofNat (data : Nat) (h : data 1 data 31 := by decide) : Ordinal :=
Bounded.LE.ofNat' data h
/--
Creates an ordinal from a `Fin` value, ensuring it is within the valid range for days of the month (1 to 31).
If the `Fin` value is 0, it is converted to 1.
-/
@[inline]
def ofFin (data : Fin 32) : Ordinal :=
Bounded.LE.ofFin' data (by decide)
/--
Converts an `Ordinal` to an `Offset`.
-/
@[inline]
def toOffset (ordinal : Ordinal) : Offset :=
UnitVal.ofInt ordinal.val
namespace OfYear
/--
Converts an `OfYear` ordinal to a `Offset`.
-/
def toOffset (ofYear : OfYear leap) : Offset :=
UnitVal.ofInt ofYear.val
end OfYear
end Ordinal
namespace Offset
/--
Converts an `Offset` to an `Ordinal`.
-/
@[inline]
def toOrdinal (off : Day.Offset) (h : off.val 1 off.val 31) : Ordinal :=
Bounded.LE.mk off.val h
/--
Creates an `Offset` from a natural number.
-/
@[inline]
def ofNat (data : Nat) : Day.Offset :=
UnitVal.ofInt data
/--
Creates an `Offset` from an integer.
-/
@[inline]
def ofInt (data : Int) : Day.Offset :=
UnitVal.ofInt data
/--
Convert `Day.Offset` into `Nanosecond.Offset`.
-/
@[inline]
def toNanoseconds (days : Day.Offset) : Nanosecond.Offset :=
days.mul 86400000000000
/--
Convert `Nanosecond.Offset` into `Day.Offset`.
-/
@[inline]
def ofNanoseconds (ns : Nanosecond.Offset) : Day.Offset :=
ns.ediv 86400000000000
/--
Convert `Day.Offset` into `Millisecond.Offset`.
-/
@[inline]
def toMilliseconds (days : Day.Offset) : Millisecond.Offset :=
days.mul 86400000
/--
Convert `Millisecond.Offset` into `Day.Offset`.
-/
@[inline]
def ofMilliseconds (ms : Millisecond.Offset) : Day.Offset :=
ms.ediv 86400000
/--
Convert `Day.Offset` into `Second.Offset`.
-/
@[inline]
def toSeconds (days : Day.Offset) : Second.Offset :=
days.mul 86400
/--
Convert `Second.Offset` into `Day.Offset`.
-/
@[inline]
def ofSeconds (secs : Second.Offset) : Day.Offset :=
secs.ediv 86400
/--
Convert `Day.Offset` into `Minute.Offset`.
-/
@[inline]
def toMinutes (days : Day.Offset) : Minute.Offset :=
days.mul 1440
/--
Convert `Minute.Offset` into `Day.Offset`.
-/
@[inline]
def ofMinutes (minutes : Minute.Offset) : Day.Offset :=
minutes.ediv 1440
/--
Convert `Day.Offset` into `Hour.Offset`.
-/
@[inline]
def toHours (days : Day.Offset) : Hour.Offset :=
days.mul 24
/--
Convert `Hour.Offset` into `Day.Offset`.
-/
@[inline]
def ofHours (hours : Hour.Offset) : Day.Offset :=
hours.ediv 24
end Offset
end Day
end Time
end Std

View File

@@ -0,0 +1,308 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Internal.Rat
import Std.Time.Date.Unit.Day
namespace Std
namespace Time
namespace Month
open Std.Internal
open Internal
set_option linter.all true
/--
`Ordinal` represents a bounded value for months, which ranges between 1 and 12.
-/
def Ordinal := Bounded.LE 1 12
deriving Repr, BEq, LE, LT
instance : OfNat Ordinal n :=
inferInstanceAs (OfNat (Bounded.LE 1 (1 + (11 : Nat))) n)
instance : Inhabited Ordinal where
default := 1
instance {x y : Ordinal} : Decidable (x y) :=
inferInstanceAs (Decidable (x.val y.val))
instance {x y : Ordinal} : Decidable (x < y) :=
inferInstanceAs (Decidable (x.val < y.val))
/--
`Offset` represents an offset in months. It is defined as an `Int`.
-/
def Offset : Type := Int
deriving Repr, BEq, Inhabited, Add, Sub, Mul, Div, Neg, ToString, LT, LE, DecidableEq
instance : OfNat Offset n :=
Int.ofNat n
/--
`Quarter` represents a value between 1 and 4, inclusive, corresponding to the four quarters of a year.
-/
def Quarter := Bounded.LE 1 4
namespace Quarter
/--
Determine the `Quarter` by the month.
-/
def ofMonth (month : Month.Ordinal) : Quarter :=
month
|>.sub 1
|>.ediv 3 (by decide)
|>.add 1
end Quarter
namespace Offset
/--
Creates an `Offset` from a natural number.
-/
@[inline]
def ofNat (data : Nat) : Offset :=
.ofNat data
/--
Creates an `Offset` from an integer.
-/
@[inline]
def ofInt (data : Int) : Offset :=
data
end Offset
namespace Ordinal
/--
The ordinal value representing the month of January.
-/
@[inline] def january : Ordinal := 1
/--
The ordinal value representing the month of February.
-/
@[inline] def february : Ordinal := 2
/--
The ordinal value representing the month of March.
-/
@[inline] def march : Ordinal := 3
/--
The ordinal value representing the month of April.
-/
@[inline] def april : Ordinal := 4
/--
The ordinal value representing the month of May.
-/
@[inline] def may : Ordinal := 5
/--
The ordinal value representing the month of June.
-/
@[inline] def june : Ordinal := 6
/--
The ordinal value representing the month of July.
-/
@[inline] def july : Ordinal := 7
/--
The ordinal value representing the month of August.
-/
@[inline] def august : Ordinal := 8
/--
The ordinal value representing the month of September.
-/
@[inline] def september : Ordinal := 9
/--
The ordinal value representing the month of October.
-/
@[inline] def october : Ordinal := 10
/--
The ordinal value representing the month of November.
-/
@[inline] def november : Ordinal := 11
/--
The ordinal value representing the month of December.
-/
@[inline] def december : Ordinal := 12
/--
Converts a `Ordinal` into a `Offset`.
-/
@[inline]
def toOffset (month : Ordinal) : Offset :=
month.val
/--
Creates an `Ordinal` from an integer, ensuring the value is within bounds.
-/
@[inline]
def ofInt (data : Int) (h : 1 data data 12) : Ordinal :=
Bounded.LE.mk data h
/--
Creates an `Ordinal` from a `Nat`, ensuring the value is within bounds.
-/
@[inline]
def ofNat (data : Nat) (h : data 1 data 12 := by decide) : Ordinal :=
Bounded.LE.ofNat' data h
/--
Converts a `Ordinal` into a `Nat`.
-/
@[inline]
def toNat (month : Ordinal) : Nat := by
match month with
| .ofNat s, _ => exact s
| .negSucc s, h => nomatch h.left
/--
Creates an `Ordinal` from a `Fin`, ensuring the value is within bounds, if its 0 then its converted
to 1.
-/
@[inline]
def ofFin (data : Fin 13) : Ordinal :=
Bounded.LE.ofFin' data (by decide)
/--
Transforms `Month.Ordinal` into `Second.Offset`.
-/
def toSeconds (leap : Bool) (month : Ordinal) : Second.Offset :=
let daysAcc := #[0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334]
let days : Day.Offset := daysAcc[month.toNat]!
let time := days.toSeconds
if leap && month.toNat 2
then time + 86400
else time
/--
Transforms `Month.Ordinal` into `Minute.Offset`.
-/
@[inline]
def toMinutes (leap : Bool) (month : Ordinal) : Minute.Offset :=
toSeconds leap month
|>.ediv 60
/--
Transforms `Month.Ordinal` into `Hour.Offset`.
-/
@[inline]
def toHours (leap : Bool) (month : Ordinal) : Hour.Offset :=
toMinutes leap month
|>.ediv 60
/--
Transforms `Month.Ordinal` into `Day.Offset`.
-/
@[inline]
def toDays (leap : Bool) (month : Ordinal) : Day.Offset :=
toSeconds leap month
|>.convert
/--
Size in days of each month if the year is not a leap year.
-/
@[inline]
private def monthSizesNonLeap : { val : Array Day.Ordinal // val.size = 12 } :=
#[31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31], by decide
/--
Returns the cumulative size in days of each month for a non-leap year.
-/
@[inline]
private def cumulativeSizes : { val : Array Day.Offset // val.size = 12 } :=
#[0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334], by decide
/--
Gets the number of days in a month.
-/
def days (leap : Bool) (month : Ordinal) : Day.Ordinal :=
if month.val = 2 then
if leap then 29 else 28
else
let months, p := monthSizesNonLeap
let index : Fin 12 := (month.sub 1).toFin (by decide)
let idx := (index.cast (by rw [p]))
months.get idx.val idx.isLt
theorem days_gt_27 (leap : Bool) (i : Month.Ordinal) : days leap i > 27 := by
match i with
| 2, _ =>
simp [days]
split <;> decide
| 1, _ | 3, _ | 4, _ | 5, _ | 6, _ | 7, _
| 8, _ | 9, _ | 10, _ | 11, _ | 12, _ =>
simp [days, monthSizesNonLeap]
decide +revert
/--
Returns the number of days until the `month`.
-/
def cumulativeDays (leap : Bool) (month : Ordinal) : Day.Offset := by
let months, p := cumulativeSizes
let index : Fin 12 := (month.sub 1).toFin (by decide)
rw [ p] at index
let res := months.get index.val index.isLt
exact res + (if leap month.val > 2 then 1 else 0)
theorem cumulativeDays_le (leap : Bool) (month : Month.Ordinal) : cumulativeDays leap month 0 cumulativeDays leap month 334 + (if leap then 1 else 0) := by
match month with
| 1, _ | 2, _ | 3, _ | 4, _ | 5, _ | 6, _ | 7, _ | 8, _ | 9, _ | 10, _ | 11, _ | 12, _ =>
simp [cumulativeSizes, Bounded.LE.sub, Bounded.LE.add, Bounded.LE.toFin, cumulativeDays]
try split
all_goals decide +revert
theorem difference_eq (p : month.val 11) :
let next := month.truncateTop p |>.addTop 1 (by decide)
(cumulativeDays leap next).val = (cumulativeDays leap month).val + (days leap month).val := by
match month with
| 1, _ | 2, _ | 3, _ | 4, _ | 5, _ | 6, _ | 7, _ | 8, _ | 9, _ | 10, _ | 11, _ =>
simp [cumulativeDays, Bounded.LE.addTop, days, monthSizesNonLeap];
try split <;> rfl
try rfl
| 12, _ => contradiction
/--
Checks if a given day is valid for the specified month and year. For example, `29/02` is valid only
if the year is a leap year.
-/
abbrev Valid (leap : Bool) (month : Month.Ordinal) (day : Day.Ordinal) : Prop :=
day.val (days leap month).val
/--
Clips the day to be within the valid range.
-/
@[inline]
def clipDay (leap : Bool) (month : Month.Ordinal) (day : Day.Ordinal) : Day.Ordinal :=
let max : Day.Ordinal := month.days leap
if day.val > max.val
then max
else day
/--
Proves that every value provided by a clipDay is a valid day in a year.
-/
theorem valid_clipDay : Valid leap month (clipDay leap month day) := by
simp [Valid, clipDay]
split
exact Int.le_refl (days leap month).val
next h => exact Int.not_lt.mp h
end Ordinal
end Month
end Time
end Std

View File

@@ -0,0 +1,185 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Internal.Rat
import Std.Time.Date.Unit.Day
namespace Std
namespace Time
namespace Week
open Std.Internal
open Internal
set_option linter.all true
/--
`Ordinal` represents a bounded value for weeks, which ranges between 1 and 53.
-/
def Ordinal := Bounded.LE 1 53
deriving Repr, BEq, LE, LT
instance : OfNat Ordinal n :=
inferInstanceAs (OfNat (Bounded.LE 1 (1 + (52 : Nat))) n)
instance {x y : Ordinal} : Decidable (x y) :=
inferInstanceAs (Decidable (x.val y.val))
instance {x y : Ordinal} : Decidable (x < y) :=
inferInstanceAs (Decidable (x.val < y.val))
instance : Inhabited Ordinal where
default := 1
/--
`Offset` represents an offset in weeks.
-/
def Offset : Type := UnitVal (86400 * 7)
deriving Repr, BEq, Inhabited, Add, Sub, Neg, LE, LT, ToString
instance : OfNat Offset n := UnitVal.ofNat n
namespace Ordinal
/--
Creates an `Ordinal` from an integer, ensuring the value is within bounds.
-/
@[inline]
def ofInt (data : Int) (h : 1 data data 53) : Ordinal :=
Bounded.LE.mk data h
/--
`OfMonth` represents the number of weeks within a month. It ensures that the week is within the
correct bounds—either 1 to 6, representing the possible weeks in a month.
-/
def OfMonth := Bounded.LE 1 6
deriving Repr
/--
Creates an `Ordinal` from a natural number, ensuring the value is within bounds.
-/
@[inline]
def ofNat (data : Nat) (h : data 1 data 53 := by decide) : Ordinal :=
Bounded.LE.ofNat' data h
/--
Creates an `Ordinal` from a `Fin`, ensuring the value is within bounds.
-/
@[inline]
def ofFin (data : Fin 54) : Ordinal :=
Bounded.LE.ofFin' data (by decide)
/--
Converts an `Ordinal` to an `Offset`.
-/
@[inline]
def toOffset (ordinal : Ordinal) : Offset :=
UnitVal.ofInt ordinal.val
end Ordinal
namespace Offset
/--
Creates an `Offset` from a natural number.
-/
@[inline]
def ofNat (data : Nat) : Week.Offset :=
UnitVal.ofInt data
/--
Creates an `Offset` from an integer.
-/
@[inline]
def ofInt (data : Int) : Week.Offset :=
UnitVal.ofInt data
/--
Convert `Week.Offset` into `Millisecond.Offset`.
-/
@[inline]
def toMilliseconds (weeks : Week.Offset) : Millisecond.Offset :=
weeks.mul 604800000
/--
Convert `Millisecond.Offset` into `Week.Offset`.
-/
@[inline]
def ofMilliseconds (millis : Millisecond.Offset) : Week.Offset :=
millis.ediv 604800000
/--
Convert `Week.Offset` into `Nanosecond.Offset`.
-/
@[inline]
def toNanoseconds (weeks : Week.Offset) : Nanosecond.Offset :=
weeks.mul 604800000000000
/--
Convert `Nanosecond.Offset` into `Week.Offset`.
-/
@[inline]
def ofNanoseconds (nanos : Nanosecond.Offset) : Week.Offset :=
nanos.ediv 604800000000000
/--
Convert `Week.Offset` into `Second.Offset`.
-/
@[inline]
def toSeconds (weeks : Week.Offset) : Second.Offset :=
weeks.mul 604800
/--
Convert `Second.Offset` into `Week.Offset`.
-/
@[inline]
def ofSeconds (secs : Second.Offset) : Week.Offset :=
secs.ediv 604800
/--
Convert `Week.Offset` into `Minute.Offset`.
-/
@[inline]
def toMinutes (weeks : Week.Offset) : Minute.Offset :=
weeks.mul 10080
/--
Convert `Minute.Offset` into `Week.Offset`.
-/
@[inline]
def ofMinutes (minutes : Minute.Offset) : Week.Offset :=
minutes.ediv 10080
/--
Convert `Week.Offset` into `Hour.Offset`.
-/
@[inline]
def toHours (weeks : Week.Offset) : Hour.Offset :=
weeks.mul 168
/--
Convert `Hour.Offset` into `Week.Offset`.
-/
@[inline]
def ofHours (hours : Hour.Offset) : Week.Offset :=
hours.ediv 168
/--
Convert `Week.Offset` into `Day.Offset`.
-/
@[inline]
def toDays (weeks : Week.Offset) : Day.Offset :=
weeks.mul 7
/--
Convert `Day.Offset` into `Week.Offset`.
-/
@[inline]
def ofDays (days : Day.Offset) : Week.Offset :=
days.ediv 7
end Offset
end Week
end Time
end Std

View File

@@ -0,0 +1,134 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Internal.Rat
import Std.Time.Date.Unit.Day
namespace Std
namespace Time
open Std.Internal
open Internal
set_option linter.all true
/--
Defines the enumeration for days of the week. Each variant corresponds to a day of the week.
-/
inductive Weekday
/-- Monday. -/
| monday
/-- Tuesday. -/
| tuesday
/-- Wednesday. -/
| wednesday
/-- Thursday. -/
| thursday
/-- Friday. -/
| friday
/-- Saturday. -/
| saturday
/-- Sunday. -/
| sunday
deriving Repr, Inhabited, BEq
namespace Weekday
/--
`Ordinal` represents a bounded value for weekdays, which ranges between 1 and 7.
-/
def Ordinal := Bounded.LE 1 7
instance : OfNat Ordinal n :=
inferInstanceAs (OfNat (Bounded.LE 1 (1 + (6 : Nat))) n)
/--
Converts a `Ordinal` representing a day index into a corresponding `Weekday`. This function is useful
for mapping numerical representations to days of the week.
-/
def ofOrdinal : Ordinal Weekday
| 1 => .monday
| 2 => .tuesday
| 3 => .wednesday
| 4 => .thursday
| 5 => .friday
| 6 => .saturday
| 7 => .sunday
/--
Converts a `Weekday` to a `Ordinal`.
-/
def toOrdinal : Weekday Ordinal
| .monday => 1
| .tuesday => 2
| .wednesday => 3
| .thursday => 4
| .friday => 5
| .saturday => 6
| .sunday => 7
/--
Converts a `Weekday` to a `Nat`.
-/
def toNat : Weekday Nat
| .monday => 1
| .tuesday => 2
| .wednesday => 3
| .thursday => 4
| .friday => 5
| .saturday => 6
| .sunday => 7
/--
Converts a `Nat` to an `Option Weekday`.
-/
def ofNat? : Nat Option Weekday
| 1 => some .monday
| 2 => some .tuesday
| 3 => some .wednesday
| 4 => some .thursday
| 5 => some .friday
| 6 => some .saturday
| 7 => some .sunday
| _ => none
/--
Converts a `Nat` to a `Weekday`. Panics if the value provided is invalid.
-/
@[inline]
def ofNat! (n : Nat) : Weekday :=
match ofNat? n with
| some res => res
| none => panic! "invalid weekday"
/--
Gets the next `Weekday`.
-/
def next : Weekday Weekday
| .monday => .tuesday
| .tuesday => .wednesday
| .wednesday => .thursday
| .thursday => .friday
| .friday => .saturday
| .saturday => .sunday
| .sunday => .monday
/--
Check if it's a weekend.
-/
def isWeekend : Weekday Bool
| .saturday => true
| .sunday => true
| _ => false
end Weekday
end Time
end Std

View File

@@ -0,0 +1,128 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Internal
import Std.Internal.Rat
import Std.Time.Date.Unit.Day
import Std.Time.Date.Unit.Month
namespace Std
namespace Time
namespace Year
open Std.Internal
open Internal
set_option linter.all true
/--
Defines the different eras.
-/
inductive Era
/-- The era before the Common Era (BCE), always represents a date before year 0. -/
| bce
/-- The Common Era (CE), represents dates from year 0 onwards. -/
| ce
deriving Repr, Inhabited
instance : ToString Era where
toString
| .bce => "BCE"
| .ce => "CE"
/--
`Offset` represents a year offset, defined as an `Int`.
-/
def Offset : Type := Int
deriving Repr, BEq, Inhabited, Add, Sub, Neg, LE, LT, ToString
instance {x y : Offset} : Decidable (x y) :=
let x : Int := x
inferInstanceAs (Decidable (x y))
instance {x y : Offset} : Decidable (x < y) :=
let x : Int := x
inferInstanceAs (Decidable (x < y))
instance : OfNat Offset n := Int.ofNat n
namespace Offset
/--
Creates an `Offset` from a natural number.
-/
@[inline]
def ofNat (data : Nat) : Offset :=
.ofNat data
/--
Creates an `Offset` from an integer.
-/
@[inline]
def ofInt (data : Int) : Offset :=
data
/--
Converts the `Year` offset to an `Int`.
-/
@[inline]
def toInt (offset : Offset) : Int :=
offset
/--
Converts the `Year` offset to a `Month` offset.
-/
@[inline]
def toMonths (val : Offset) : Month.Offset :=
val.mul 12
/--
Determines if a year is a leap year in the proleptic Gregorian calendar.
-/
@[inline]
def isLeap (y : Offset) : Bool :=
y.toInt.tmod 4 = 0 (y.toInt.tmod 100 0 y.toInt.tmod 400 = 0)
/--
Returns the `Era` of the `Year`.
-/
def era (year : Offset) : Era :=
if year.toInt 1
then .ce
else .bce
/--
Calculates the number of days in the specified `year`.
-/
def days (year : Offset) : Bounded.LE 365 366 :=
if year.isLeap
then .ofNatWrapping 366 (by decide)
else .ofNatWrapping 355 (by decide)
/--
Calculates the number of weeks in the specified `year`.
-/
def weeks (year : Offset) : Bounded.LE 52 53 :=
let p (year : Offset) := Bounded.LE.byEmod (year.toInt + year.toInt/4 - year.toInt/100 + year.toInt/400) 7 (by decide)
let add : Bounded.LE 0 1 :=
if (p year).val = 4 (p (year - 1)).val = 3
then Bounded.LE.ofNat 1 (by decide)
else Bounded.LE.ofNat 0 (by decide)
Bounded.LE.exact 52 |>.addBounds add
/--
Checks if the given date is valid for the specified year, month, and day.
-/
@[inline]
abbrev Valid (year : Year.Offset) (month : Month.Ordinal) (day : Day.Ordinal) : Prop :=
day month.days year.isLeap
end Offset
end Year
end Time
end Std

View File

@@ -0,0 +1,88 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Internal.Rat
import Std.Time.Date.Unit.Day
import Std.Time.Date.Unit.Month
namespace Std
namespace Time
open Std.Internal
open Internal
open Month.Ordinal
set_option linter.all true
/--
Represents a valid date for a given year, considering whether it is a leap year. Example: `(2, 29)`
is valid only if `leap` is `true`.
-/
def ValidDate (leap : Bool) := { val : Month.Ordinal × Day.Ordinal // Valid leap (Prod.fst val) (Prod.snd val) }
instance : Inhabited (ValidDate l) where
default := 1, 1, (by cases l <;> decide)
namespace ValidDate
/--
Transforms a tuple of a `Month` and a `Day` into a `Day.Ordinal.OfYear`.
-/
def dayOfYear (ordinal : ValidDate leap) : Day.Ordinal.OfYear leap :=
let days := cumulativeDays leap ordinal.val.fst
let proof := cumulativeDays_le leap ordinal.val.fst
let bounded := Bounded.LE.mk days.toInt proof |>.addBounds ordinal.val.snd
match leap, bounded with
| true, bounded => bounded
| false, bounded => bounded
/--
Transforms a `Day.Ordinal.OfYear` into a tuple of a `Month` and a `Day`.
-/
def ofOrdinal (ordinal : Day.Ordinal.OfYear leap) : ValidDate leap :=
let rec go (idx : Month.Ordinal) (acc : Int) (h : ordinal.val > acc) (p : acc = (cumulativeDays leap idx).val) : ValidDate leap :=
let monthDays := days leap idx
if h₁ : ordinal.val acc + monthDays.val then
let bounded := Bounded.LE.mk ordinal.val (And.intro h h₁) |>.sub acc
let bounded : Bounded.LE 1 monthDays.val := bounded.cast (by omega) (by omega)
let days₁ : Day.Ordinal := bounded.val, And.intro bounded.property.left (Int.le_trans bounded.property.right monthDays.property.right)
idx, days₁, Int.le_trans bounded.property.right (by simp)
else by
let h₂ := Int.not_le.mp h₁
have h₃ : idx.val < 12 := Int.not_le.mp <| λh₃ => by
have h₅ := ordinal.property.right
let eq := Int.eq_iff_le_and_ge.mpr (And.intro idx.property.right h₃)
simp [monthDays, days, eq] at h₂
simp [cumulativeDays, eq] at p
simp [p] at h₂
cases leap
all_goals (simp at h₂; simp_all)
· have h₂ : 365 < ordinal.val := h₂
omega
· have h₂ : 366 < ordinal.val := h₂
omega
let idx₂ := idx.truncateTop (Int.le_sub_one_of_lt h₃) |>.addTop 1 (by decide)
refine go idx₂ (acc + monthDays.val) h₂ ?_
simp [monthDays, p]
rw [difference_eq (Int.le_of_lt_add_one h₃)]
termination_by 12 - idx.val.toNat
decreasing_by
simp_wf
simp [Bounded.LE.addTop]
let gt0 : idx.val 0 := Int.le_trans (by decide) idx.property.left
refine Nat.sub_lt_sub_left (Int.toNat_lt gt0 |>.mpr h₃) ?_
let toNat_lt_lt {n z : Int} (h : 0 z) (h₁ : 0 n) : z.toNat < n.toNat z < n := by
rw [ Int.not_le, Nat.not_le, Int.ofNat_le, Int.toNat_of_nonneg h, Int.toNat_of_nonneg h₁]
rw [toNat_lt_lt (by omega) (by omega)]
omega
go 1 0 (Int.le_trans (by decide) ordinal.property.left) (by cases leap <;> decide)
end ValidDate
end Time
end Std

104
src/Std/Time/DateTime.lean Normal file
View File

@@ -0,0 +1,104 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.DateTime.Timestamp
import Std.Time.DateTime.PlainDateTime
namespace Std
namespace Time
namespace Timestamp
set_option linter.all true
/--
Converts a `PlainDateTime` to a `Timestamp`
-/
@[inline]
def ofPlainDateTimeAssumingUTC (pdt : PlainDateTime) : Timestamp :=
pdt.toTimestampAssumingUTC
/--
Converts a `Timestamp` to a `PlainDateTime`
-/
@[inline]
def toPlainDateTimeAssumingUTC (timestamp : Timestamp) : PlainDateTime :=
PlainDateTime.ofTimestampAssumingUTC timestamp
/--
Converts a `PlainDate` to a `Timestamp`
-/
@[inline]
def ofPlainDateAssumingUTC (pd : PlainDate) : Timestamp :=
let days := pd.toDaysSinceUNIXEpoch
let secs := days.toSeconds
Timestamp.ofSecondsSinceUnixEpoch secs
/--
Converts a `Timestamp` to a `PlainDate`
-/
@[inline]
def toPlainDateAssumingUTC (timestamp : Timestamp) : PlainDate :=
let secs := timestamp.toSecondsSinceUnixEpoch
let days := Day.Offset.ofSeconds secs
PlainDate.ofDaysSinceUNIXEpoch days
/--
Converts a `Timestamp` to a `PlainTime`
-/
@[inline]
def getTimeAssumingUTC (timestamp : Timestamp) : PlainTime :=
let nanos := timestamp.toNanosecondsSinceUnixEpoch
PlainTime.ofNanoseconds nanos
end Timestamp
namespace PlainDate
/--
Converts a `PlainDate` to a `Timestamp`
-/
@[inline]
def toTimestampAssumingUTC (pdt : PlainDate) : Timestamp :=
Timestamp.ofPlainDateAssumingUTC pdt
instance : HSub PlainDate PlainDate Duration where
hSub x y := x.toTimestampAssumingUTC - y.toTimestampAssumingUTC
end PlainDate
namespace PlainDateTime
/--
Converts a `PlainDate` to a `Timestamp`
-/
@[inline]
def ofPlainDate (date : PlainDate) : PlainDateTime :=
{ date, time := PlainTime.midnight }
/--
Converts a `PlainDateTime` to a `PlainDate`
-/
@[inline]
def toPlainDate (pdt : PlainDateTime) : PlainDate :=
pdt.date
/--
Converts a `PlainTime` to a `PlainDateTime`
-/
@[inline]
def ofPlainTime (time : PlainTime) : PlainDateTime :=
{ date := 1, 1, 1, by decide, time }
/--
Converts a `PlainDateTime` to a `PlainTime`
-/
@[inline]
def toPlainTime (pdt : PlainDateTime) : PlainTime :=
pdt.time
instance : HSub PlainDateTime PlainDateTime Duration where
hSub x y := x.toTimestampAssumingUTC - y.toTimestampAssumingUTC
end PlainDateTime

View File

@@ -0,0 +1,601 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Date
import Std.Time.Time
import Std.Time.Internal
import Std.Time.DateTime.Timestamp
namespace Std
namespace Time
open Internal
set_option linter.all true
/--
Represents a date and time with components for Year, Month, Day, Hour, Minute, Second, and Nanosecond.
-/
structure PlainDateTime where
/--
The `Date` component of a `PlainDate`
-/
date : PlainDate
/--
The `Time` component of a `PlainTime`
-/
time : PlainTime
deriving Inhabited, BEq, Repr
namespace PlainDateTime
/--
Converts a `PlainDateTime` to a `Timestamp`
-/
def toTimestampAssumingUTC (dt : PlainDateTime) : Timestamp :=
let days := dt.date.toDaysSinceUNIXEpoch
let nanos := days.toSeconds + dt.time.toSeconds |>.mul 1000000000
let nanos := nanos.val + dt.time.nanosecond.val
Timestamp.ofNanosecondsSinceUnixEpoch (Nanosecond.Offset.ofInt nanos)
/--
Converts a `Timestamp` to a `PlainDateTime`.
-/
def ofTimestampAssumingUTC (stamp : Timestamp) : PlainDateTime := Id.run do
let leapYearEpoch := 11017
let daysPer400Y := 365 * 400 + 97
let daysPer100Y := 365 * 100 + 24
let daysPer4Y := 365 * 4 + 1
let nanos := stamp.toNanosecondsSinceUnixEpoch
let secs : Second.Offset := nanos.ediv 1000000000
let daysSinceEpoch : Day.Offset := secs.ediv 86400
let boundedDaysSinceEpoch := daysSinceEpoch
let mut rawDays := boundedDaysSinceEpoch - leapYearEpoch
let mut rem := Bounded.LE.byMod secs.val 86400 (by decide)
let remSecs, days :=
if h : rem.val -1 then
let remSecs := rem.truncateTop h
let remSecs : Bounded.LE 1 86399 := remSecs.add 86400
let rawDays := rawDays - 1
(remSecs.expandBottom (by decide), rawDays)
else
let h := rem.truncateBottom (Int.not_le.mp h)
(h, rawDays)
let mut quadracentennialCycles := days.val / daysPer400Y;
let mut remDays := days.val % daysPer400Y;
if remDays < 0 then
remDays := remDays + daysPer400Y
quadracentennialCycles := quadracentennialCycles - 1
let mut centenialCycles := remDays / daysPer100Y;
if centenialCycles = 4 then
centenialCycles := centenialCycles - 1
remDays := remDays - centenialCycles * daysPer100Y
let mut quadrennialCycles := remDays / daysPer4Y;
if quadrennialCycles = 25 then
quadrennialCycles := quadrennialCycles - 1
remDays := remDays - quadrennialCycles * daysPer4Y
let mut remYears := remDays / 365;
if remYears = 4 then
remYears := remYears - 1
remDays := remDays - remYears * 365
let mut year := 2000 + remYears + 4 * quadrennialCycles + 100 * centenialCycles + 400 * quadracentennialCycles
let months := [31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31, 29];
let mut mon : Fin 13 := 0;
for monLen in months do
mon := mon + 1;
if remDays < monLen then
break
remDays := remDays - monLen
let mday : Fin 31 := Fin.ofNat (Int.toNat remDays)
let hmon
if h₁ : mon.val > 10
then do
year := year + 1
pure (Month.Ordinal.ofNat (mon.val - 10) (by omega))
else
pure (Month.Ordinal.ofNat (mon.val + 2) (by omega))
let second : Bounded.LE 0 59 := remSecs.emod 60 (by decide)
let minute : Bounded.LE 0 59 := (remSecs.ediv 60 (by decide)).emod 60 (by decide)
let hour : Bounded.LE 0 23 := remSecs.ediv 3600 (by decide)
let nano : Bounded.LE 0 999999999 := Bounded.LE.byEmod nanos.val 1000000000 (by decide)
return {
date := PlainDate.ofYearMonthDayClip year hmon (Day.Ordinal.ofFin (Fin.succ mday))
time := PlainTime.ofHourMinuteSecondsNano (leap := false) (hour.expandTop (by decide)) minute second nano
}
/--
Converts a `PlainDateTime` to the number of days since the UNIX epoch.
-/
@[inline]
def toDaysSinceUNIXEpoch (pdt : PlainDateTime) : Day.Offset :=
pdt.date.toDaysSinceUNIXEpoch
/--
Converts a `PlainDateTime` to the number of days since the UNIX epoch.
-/
@[inline]
def ofDaysSinceUNIXEpoch (days : Day.Offset) (time : PlainTime) : PlainDateTime :=
PlainDateTime.mk (PlainDate.ofDaysSinceUNIXEpoch days) time
/--
Sets the `PlainDateTime` to the specified `desiredWeekday`.
-/
def withWeekday (dt : PlainDateTime) (desiredWeekday : Weekday) : PlainDateTime :=
{ dt with date := PlainDate.withWeekday dt.date desiredWeekday }
/--
Creates a new `PlainDateTime` by adjusting the day of the month to the given `days` value, with any
out-of-range days clipped to the nearest valid date.
-/
@[inline]
def withDaysClip (dt : PlainDateTime) (days : Day.Ordinal) : PlainDateTime :=
{ dt with date := PlainDate.ofYearMonthDayClip dt.date.year dt.date.month days }
/--
Creates a new `PlainDateTime` by adjusting the day of the month to the given `days` value, with any
out-of-range days rolled over to the next month or year as needed.
-/
@[inline]
def withDaysRollOver (dt : PlainDateTime) (days : Day.Ordinal) : PlainDateTime :=
{ dt with date := PlainDate.rollOver dt.date.year dt.date.month days }
/--
Creates a new `PlainDateTime` by adjusting the month to the given `month` value, with any
out-of-range days clipped to the nearest valid date.
-/
@[inline]
def withMonthClip (dt : PlainDateTime) (month : Month.Ordinal) : PlainDateTime :=
{ dt with date := PlainDate.ofYearMonthDayClip dt.date.year month dt.date.day }
/--
Creates a new `PlainDateTime` by adjusting the month to the given `month` value.
The day is rolled over to the next valid month if necessary.
-/
@[inline]
def withMonthRollOver (dt : PlainDateTime) (month : Month.Ordinal) : PlainDateTime :=
{ dt with date := PlainDate.rollOver dt.date.year month dt.date.day }
/--
Creates a new `PlainDateTime` by adjusting the year to the given `year` value. The month and day
remain unchanged, with any out-of-range days clipped to the nearest valid date.
-/
@[inline]
def withYearClip (dt : PlainDateTime) (year : Year.Offset) : PlainDateTime :=
{ dt with date := PlainDate.ofYearMonthDayClip year dt.date.month dt.date.day }
/--
Creates a new `PlainDateTime` by adjusting the year to the given `year` value. The month and day are rolled
over to the next valid month and day if necessary.
-/
@[inline]
def withYearRollOver (dt : PlainDateTime) (year : Year.Offset) : PlainDateTime :=
{ dt with date := PlainDate.rollOver year dt.date.month dt.date.day }
/--
Creates a new `PlainDateTime` by adjusting the `hour` component of its `time` to the given value.
-/
@[inline]
def withHours (dt : PlainDateTime) (hour : Hour.Ordinal) : PlainDateTime :=
{ dt with time := { dt.time with hour := hour } }
/--
Creates a new `PlainDateTime` by adjusting the `minute` component of its `time` to the given value.
-/
@[inline]
def withMinutes (dt : PlainDateTime) (minute : Minute.Ordinal) : PlainDateTime :=
{ dt with time := { dt.time with minute := minute } }
/--
Creates a new `PlainDateTime` by adjusting the `second` component of its `time` to the given value.
-/
@[inline]
def withSeconds (dt : PlainDateTime) (second : Sigma Second.Ordinal) : PlainDateTime :=
{ dt with time := { dt.time with second := second } }
/--
Creates a new `PlainDateTime` by adjusting the milliseconds component inside the `nano` component of its `time` to the given value.
-/
@[inline]
def withMilliseconds (dt : PlainDateTime) (millis : Millisecond.Ordinal) : PlainDateTime :=
{ dt with time := dt.time.withMilliseconds millis }
/--
Creates a new `PlainDateTime` by adjusting the `nano` component of its `time` to the given value.
-/
@[inline]
def withNanoseconds (dt : PlainDateTime) (nano : Nanosecond.Ordinal) : PlainDateTime :=
{ dt with time := dt.time.withNanoseconds nano }
/--
Adds a `Day.Offset` to a `PlainDateTime`.
-/
@[inline]
def addDays (dt : PlainDateTime) (days : Day.Offset) : PlainDateTime :=
{ dt with date := dt.date.addDays days }
/--
Subtracts a `Day.Offset` from a `PlainDateTime`.
-/
@[inline]
def subDays (dt : PlainDateTime) (days : Day.Offset) : PlainDateTime :=
{ dt with date := dt.date.subDays days }
/--
Adds a `Week.Offset` to a `PlainDateTime`.
-/
@[inline]
def addWeeks (dt : PlainDateTime) (weeks : Week.Offset) : PlainDateTime :=
{ dt with date := dt.date.addWeeks weeks }
/--
Subtracts a `Week.Offset` from a `PlainDateTime`.
-/
@[inline]
def subWeeks (dt : PlainDateTime) (weeks : Week.Offset) : PlainDateTime :=
{ dt with date := dt.date.subWeeks weeks }
/--
Adds a `Month.Offset` to a `PlainDateTime`, adjusting the day to the last valid day of the resulting
month.
-/
def addMonthsClip (dt : PlainDateTime) (months : Month.Offset) : PlainDateTime :=
{ dt with date := dt.date.addMonthsClip months }
/--
Subtracts `Month.Offset` from a `PlainDateTime`, it clips the day to the last valid day of that month.
-/
@[inline]
def subMonthsClip (dt : PlainDateTime) (months : Month.Offset) : PlainDateTime :=
{ dt with date := dt.date.subMonthsClip months }
/--
Adds a `Month.Offset` to a `PlainDateTime`, rolling over excess days to the following month if needed.
-/
def addMonthsRollOver (dt : PlainDateTime) (months : Month.Offset) : PlainDateTime :=
{ dt with date := dt.date.addMonthsRollOver months }
/--
Subtracts a `Month.Offset` from a `PlainDateTime`, adjusting the day to the last valid day of the
resulting month.
-/
@[inline]
def subMonthsRollOver (dt : PlainDateTime) (months : Month.Offset) : PlainDateTime :=
{ dt with date := dt.date.subMonthsRollOver months }
/--
Adds a `Month.Offset` to a `PlainDateTime`, rolling over excess days to the following month if needed.
-/
@[inline]
def addYearsRollOver (dt : PlainDateTime) (years : Year.Offset) : PlainDateTime :=
{ dt with date := dt.date.addYearsRollOver years }
/--
Subtracts a `Month.Offset` from a `PlainDateTime`, rolling over excess days to the following month if
needed.
-/
@[inline]
def addYearsClip (dt : PlainDateTime) (years : Year.Offset) : PlainDateTime :=
{ dt with date := dt.date.addYearsClip years }
/--
Subtracts a `Year.Offset` from a `PlainDateTime`, this function rolls over any excess days into the
following month.
-/
@[inline]
def subYearsRollOver (dt : PlainDateTime) (years : Year.Offset) : PlainDateTime :=
{ dt with date := dt.date.subYearsRollOver years }
/--
Subtracts a `Year.Offset` from a `PlainDateTime`, adjusting the day to the last valid day of the
resulting month.
-/
@[inline]
def subYearsClip (dt : PlainDateTime) (years : Year.Offset) : PlainDateTime :=
{ dt with date := dt.date.subYearsClip years }
/--
Adds an `Hour.Offset` to a `PlainDateTime`, adjusting the date if the hour overflows.
-/
@[inline]
def addHours (dt : PlainDateTime) (hours : Hour.Offset) : PlainDateTime :=
let totalSeconds := dt.time.toSeconds + hours.toSeconds
let days := totalSeconds.ediv 86400
let newTime := dt.time.addSeconds (hours.toSeconds)
{ dt with date := dt.date.addDays days, time := newTime }
/--
Subtracts an `Hour.Offset` from a `PlainDateTime`, adjusting the date if the hour underflows.
-/
@[inline]
def subHours (dt : PlainDateTime) (hours : Hour.Offset) : PlainDateTime :=
addHours dt (-hours)
/--
Adds a `Minute.Offset` to a `PlainDateTime`, adjusting the hour and date if the minutes overflow.
-/
@[inline]
def addMinutes (dt : PlainDateTime) (minutes : Minute.Offset) : PlainDateTime :=
let totalSeconds := dt.time.toSeconds + minutes.toSeconds
let days := totalSeconds.ediv 86400
let newTime := dt.time.addSeconds (minutes.toSeconds)
{ dt with date := dt.date.addDays days, time := newTime }
/--
Subtracts a `Minute.Offset` from a `PlainDateTime`, adjusting the hour and date if the minutes underflow.
-/
@[inline]
def subMinutes (dt : PlainDateTime) (minutes : Minute.Offset) : PlainDateTime :=
addMinutes dt (-minutes)
/--
Adds a `Second.Offset` to a `PlainDateTime`, adjusting the minute, hour, and date if the seconds overflow.
-/
@[inline]
def addSeconds (dt : PlainDateTime) (seconds : Second.Offset) : PlainDateTime :=
let totalSeconds := dt.time.toSeconds + seconds
let days := totalSeconds.ediv 86400
let newTime := dt.time.addSeconds seconds
{ dt with date := dt.date.addDays days, time := newTime }
/--
Subtracts a `Second.Offset` from a `PlainDateTime`, adjusting the minute, hour, and date if the seconds underflow.
-/
@[inline]
def subSeconds (dt : PlainDateTime) (seconds : Second.Offset) : PlainDateTime :=
addSeconds dt (-seconds)
/--
Adds a `Millisecond.Offset` to a `PlainDateTime`, adjusting the second, minute, hour, and date if the milliseconds overflow.
-/
@[inline]
def addMilliseconds (dt : PlainDateTime) (milliseconds : Millisecond.Offset) : PlainDateTime :=
let totalMilliseconds := dt.time.toMilliseconds + milliseconds
let days := totalMilliseconds.ediv 86400000 -- 86400000 ms in a day
let newTime := dt.time.addMilliseconds milliseconds
{ dt with date := dt.date.addDays days, time := newTime }
/--
Subtracts a `Millisecond.Offset` from a `PlainDateTime`, adjusting the second, minute, hour, and date if the milliseconds underflow.
-/
@[inline]
def subMilliseconds (dt : PlainDateTime) (milliseconds : Millisecond.Offset) : PlainDateTime :=
addMilliseconds dt (-milliseconds)
/--
Adds a `Nanosecond.Offset` to a `PlainDateTime`, adjusting the seconds, minutes, hours, and date if the nanoseconds overflow.
-/
@[inline]
def addNanoseconds (dt : PlainDateTime) (nanos : Nanosecond.Offset) : PlainDateTime :=
let nano := Nanosecond.Offset.ofInt dt.time.nanosecond.val
let totalNanos := nano + nanos
let extraSeconds := totalNanos.ediv 1000000000
let nanosecond := Bounded.LE.byEmod totalNanos.val 1000000000 (by decide)
let newTime := dt.time.addSeconds extraSeconds
{ dt with time := { newTime with nanosecond } }
/--
Subtracts a `Nanosecond.Offset` from a `PlainDateTime`, adjusting the seconds, minutes, hours, and date if the nanoseconds underflow.
-/
@[inline]
def subNanoseconds (dt : PlainDateTime) (nanos : Nanosecond.Offset) : PlainDateTime :=
addNanoseconds dt (-nanos)
/--
Getter for the `Year` inside of a `PlainDateTime`.
-/
@[inline]
def year (dt : PlainDateTime) : Year.Offset :=
dt.date.year
/--
Getter for the `Month` inside of a `PlainDateTime`.
-/
@[inline]
def month (dt : PlainDateTime) : Month.Ordinal :=
dt.date.month
/--
Getter for the `Day` inside of a `PlainDateTime`.
-/
@[inline]
def day (dt : PlainDateTime) : Day.Ordinal :=
dt.date.day
/--
Getter for the `Weekday` inside of a `PlainDateTime`.
-/
@[inline]
def weekday (dt : PlainDateTime) : Weekday :=
dt.date.weekday
/--
Getter for the `Hour` inside of a `PlainDateTime`.
-/
@[inline]
def hour (dt : PlainDateTime) : Hour.Ordinal :=
dt.time.hour
/--
Getter for the `Minute` inside of a `PlainDateTime`.
-/
@[inline]
def minute (dt : PlainDateTime) : Minute.Ordinal :=
dt.time.minute
/--
Getter for the `Millisecond` inside of a `PlainDateTime`.
-/
@[inline]
def millisecond (dt : PlainDateTime) : Millisecond.Ordinal :=
dt.time.millisecond
/--
Getter for the `Second` inside of a `PlainDateTime`.
-/
@[inline]
def second (dt : PlainDateTime) : Second.Ordinal dt.time.second.fst :=
dt.time.second.snd
/--
Getter for the `Nanosecond.Ordinal` inside of a `PlainDateTime`.
-/
@[inline]
def nanosecond (dt : PlainDateTime) : Nanosecond.Ordinal :=
dt.time.nanosecond
/--
Determines the era of the given `PlainDateTime` based on its year.
-/
@[inline]
def era (date : PlainDateTime) : Year.Era :=
date.date.era
/--
Checks if the `PlainDateTime` is in a leap year.
-/
@[inline]
def inLeapYear (date : PlainDateTime) : Bool :=
date.year.isLeap
/--
Determines the week of the year for the given `PlainDateTime`.
-/
@[inline]
def weekOfYear (date : PlainDateTime) : Week.Ordinal :=
date.date.weekOfYear
/--
Returns the unaligned week of the month for a `PlainDateTime` (day divided by 7, plus 1).
-/
def weekOfMonth (date : PlainDateTime) : Bounded.LE 1 5 :=
date.date.weekOfMonth
/--
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.
-/
@[inline]
def alignedWeekOfMonth (date : PlainDateTime) : Week.Ordinal.OfMonth :=
date.date.alignedWeekOfMonth
/--
Transforms a tuple of a `PlainDateTime` into a `Day.Ordinal.OfYear`.
-/
@[inline]
def dayOfYear (date : PlainDateTime) : Day.Ordinal.OfYear date.year.isLeap :=
ValidDate.dayOfYear (date.month, date.day), date.date.valid
/--
Determines the quarter of the year for the given `PlainDateTime`.
-/
@[inline]
def quarter (date : PlainDateTime) : Bounded.LE 1 4 :=
date.date.quarter
/--
Combines a `PlainDate` and `PlainTime` into a `PlainDateTime`.
-/
@[inline]
def atTime : PlainDate PlainTime PlainDateTime :=
PlainDateTime.mk
/--
Combines a `PlainTime` and `PlainDate` into a `PlainDateTime`.
-/
@[inline]
def atDate (time: PlainTime) (date: PlainDate) : PlainDateTime :=
PlainDateTime.mk date time
instance : HAdd PlainDateTime Day.Offset PlainDateTime where
hAdd := addDays
instance : HSub PlainDateTime Day.Offset PlainDateTime where
hSub := subDays
instance : HAdd PlainDateTime Week.Offset PlainDateTime where
hAdd := addWeeks
instance : HSub PlainDateTime Week.Offset PlainDateTime where
hSub := subWeeks
instance : HAdd PlainDateTime Hour.Offset PlainDateTime where
hAdd := addHours
instance : HSub PlainDateTime Hour.Offset PlainDateTime where
hSub := subHours
instance : HAdd PlainDateTime Minute.Offset PlainDateTime where
hAdd := addMinutes
instance : HSub PlainDateTime Minute.Offset PlainDateTime where
hSub := subMinutes
instance : HAdd PlainDateTime Millisecond.Offset PlainDateTime where
hAdd := addMilliseconds
instance : HSub PlainDateTime Millisecond.Offset PlainDateTime where
hSub := addMilliseconds
instance : HAdd PlainDateTime Second.Offset PlainDateTime where
hAdd := addSeconds
instance : HSub PlainDateTime Second.Offset PlainDateTime where
hSub := subSeconds
instance : HAdd PlainDateTime Nanosecond.Offset PlainDateTime where
hAdd := addNanoseconds
instance : HSub PlainDateTime Nanosecond.Offset PlainDateTime where
hSub := subNanoseconds
instance : HAdd PlainDateTime Duration PlainDateTime where
hAdd x y := addNanoseconds x y.toNanoseconds
end PlainDateTime
namespace PlainDate
/--
Combines a `PlainDate` and `PlainTime` into a `PlainDateTime`.
-/
@[inline]
def atTime : PlainDate PlainTime PlainDateTime :=
PlainDateTime.mk
end PlainDate
namespace PlainTime
/--
Combines a `PlainTime` and `PlainDate` into a `PlainDateTime`.
-/
@[inline]
def atDate (time: PlainTime) (date: PlainDate) : PlainDateTime :=
PlainDateTime.mk date time
end PlainTime
end Time
end Std

View File

@@ -0,0 +1,289 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Internal
import Init.Data.Int
import Std.Time.Time
import Std.Time.Date
import Std.Time.Duration
namespace Std
namespace Time
open Internal
set_option linter.all true
/--
Represents an exact point in time as a UNIX Epoch timestamp.
-/
structure Timestamp where
/--
Duration since the unix epoch.
-/
val : Duration
deriving Repr, BEq, Inhabited
instance : LE Timestamp where
le x y := x.val y.val
instance { x y : Timestamp } : Decidable (x y) :=
inferInstanceAs (Decidable (x.val y.val))
instance : OfNat Timestamp n where
ofNat := OfNat.ofNat n
instance : ToString Timestamp where
toString s := toString s.val.toMilliseconds
instance : Repr Timestamp where
reprPrec s := reprPrec (toString s)
namespace Timestamp
/--
Fetches the current duration from the system.
-/
@[extern "lean_get_current_time"]
opaque now : IO Timestamp
/--
Converts a `Timestamp` to minutes as `Minute.Offset`.
-/
@[inline]
def toMinutes (tm : Timestamp) : Minute.Offset :=
tm.val.second.ediv 60
/--
Converts a `Timestamp` to days as `Day.Offset`.
-/
@[inline]
def toDays (tm : Timestamp) : Day.Offset :=
tm.val.second.ediv 86400
/--
Creates a `Timestamp` from a `Second.Offset` since the Unix epoch.
-/
@[inline]
def ofSecondsSinceUnixEpoch (secs : Second.Offset) : Timestamp :=
Duration.ofSeconds secs
/--
Creates a `Timestamp` from a `Nanosecond.Offset` since the Unix epoch.
-/
@[inline]
def ofNanosecondsSinceUnixEpoch (nanos : Nanosecond.Offset) : Timestamp :=
Duration.ofNanoseconds nanos
/--
Creates a `Timestamp` from a `Millisecond.Offset` since the Unix epoch.
-/
@[inline]
def ofMillisecondsSinceUnixEpoch (milli : Millisecond.Offset) : Timestamp :=
Duration.ofNanoseconds milli.toNanoseconds
/--
Converts a `Timestamp` to seconds as `Second.Offset`.
-/
@[inline]
def toSecondsSinceUnixEpoch (t : Timestamp) : Second.Offset :=
t.val.second
/--
Converts a `Timestamp` to nanoseconds as `Nanosecond.Offset`.
-/
@[inline]
def toNanosecondsSinceUnixEpoch (tm : Timestamp) : Nanosecond.Offset :=
let nanos := tm.toSecondsSinceUnixEpoch.mul 1000000000
let nanos := nanos + (.ofInt tm.val.nano.val)
nanos
/--
Converts a `Timestamp` to nanoseconds as `Millisecond.Offset`.
-/
@[inline]
def toMillisecondsSinceUnixEpoch (tm : Timestamp) : Millisecond.Offset :=
tm.toNanosecondsSinceUnixEpoch.toMilliseconds
/--
Calculates the duration from the given `Timestamp` to the current time.
-/
@[inline]
def since (f : Timestamp) : IO Duration := do
let cur Timestamp.now
return Std.Time.Duration.sub cur.val f.val
/--
Returns the `Duration` represented by the `Timestamp` since the Unix epoch.
-/
@[inline]
def toDurationSinceUnixEpoch (tm : Timestamp) : Duration :=
tm.val
/--
Adds a `Millisecond.Offset` to the given `Timestamp`.
-/
@[inline]
def addMilliseconds (t : Timestamp) (s : Millisecond.Offset) : Timestamp :=
t.val + s
/--
Subtracts a `Millisecond.Offset` from the given `Timestamp`.
-/
@[inline]
def subMilliseconds (t : Timestamp) (s : Millisecond.Offset) : Timestamp :=
t.val - s
/--
Adds a `Nanosecond.Offset` to the given `Timestamp`.
-/
@[inline]
def addNanoseconds (t : Timestamp) (s : Nanosecond.Offset) : Timestamp :=
t.val + s
/--
Subtracts a `Nanosecond.Offset` from the given `Timestamp`.
-/
@[inline]
def subNanoseconds (t : Timestamp) (s : Nanosecond.Offset) : Timestamp :=
t.val - s
/--
Adds a `Second.Offset` to the given `Timestamp`.
-/
@[inline]
def addSeconds (t : Timestamp) (s : Second.Offset) : Timestamp :=
t.val + s
/--
Subtracts a `Second.Offset` from the given `Timestamp`.
-/
@[inline]
def subSeconds (t : Timestamp) (s : Second.Offset) : Timestamp :=
t.val - s
/--
Adds a `Minute.Offset` to the given `Timestamp`.
-/
@[inline]
def addMinutes (t : Timestamp) (m : Minute.Offset) : Timestamp :=
t.val + m
/--
Subtracts a `Minute.Offset` from the given `Timestamp`.
-/
@[inline]
def subMinutes (t : Timestamp) (m : Minute.Offset) : Timestamp :=
t.val - m
/--
Adds an `Hour.Offset` to the given `Timestamp`.
-/
@[inline]
def addHours (t : Timestamp) (h : Hour.Offset) : Timestamp :=
t.val + h
/--
Subtracts an `Hour.Offset` from the given `Timestamp`.
-/
@[inline]
def subHours (t : Timestamp) (h : Hour.Offset) : Timestamp :=
t.val - h
/--
Adds a `Day.Offset` to the given `Timestamp`.
-/
@[inline]
def addDays (t : Timestamp) (d : Day.Offset) : Timestamp :=
t.val + d
/--
Subtracts a `Day.Offset` from the given `Timestamp`.
-/
@[inline]
def subDays (t : Timestamp) (d : Day.Offset) : Timestamp :=
t.val - d
/--
Adds a `Week.Offset` to the given `Timestamp`.
-/
@[inline]
def addWeeks (t : Timestamp) (d : Week.Offset) : Timestamp :=
t.val + d
/--
Subtracts a `Week.Offset` from the given `Timestamp`.
-/
@[inline]
def subWeeks (t : Timestamp) (d : Week.Offset) : Timestamp :=
t.val - d
/--
Adds a `Duration` to the given `Timestamp`.
-/
@[inline]
def addDuration (t : Timestamp) (d : Duration) : Timestamp :=
t.val + d
/--
Subtracts a `Duration` from the given `Timestamp`.
-/
@[inline]
def subDuration (t : Timestamp) (d : Duration) : Timestamp :=
t.val - d
instance : HAdd Timestamp Duration Timestamp where
hAdd := addDuration
instance : HSub Timestamp Duration Timestamp where
hSub := subDuration
instance : HAdd Timestamp Day.Offset Timestamp where
hAdd := addDays
instance : HSub Timestamp Day.Offset Timestamp where
hSub := subDays
instance : HAdd Timestamp Week.Offset Timestamp where
hAdd := addWeeks
instance : HSub Timestamp Week.Offset Timestamp where
hSub := subWeeks
instance : HAdd Timestamp Hour.Offset Timestamp where
hAdd := addHours
instance : HSub Timestamp Hour.Offset Timestamp where
hSub := subHours
instance : HAdd Timestamp Minute.Offset Timestamp where
hAdd := addMinutes
instance : HSub Timestamp Minute.Offset Timestamp where
hSub := subMinutes
instance : HAdd Timestamp Second.Offset Timestamp where
hAdd := addSeconds
instance : HSub Timestamp Second.Offset Timestamp where
hSub := subSeconds
instance : HAdd Timestamp Millisecond.Offset Timestamp where
hAdd := addMilliseconds
instance : HSub Timestamp Millisecond.Offset Timestamp where
hSub := subMilliseconds
instance : HAdd Timestamp Nanosecond.Offset Timestamp where
hAdd := addNanoseconds
instance : HSub Timestamp Nanosecond.Offset Timestamp where
hSub := subNanoseconds
instance : HSub Timestamp Timestamp Duration where
hSub x y := x.val - y.val
end Timestamp

361
src/Std/Time/Duration.lean Normal file
View File

@@ -0,0 +1,361 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Date
import Std.Time.Time
namespace Std
namespace Time
open Internal
set_option linter.all true
/--
Represents a time interval with nanoseconds precision.
-/
structure Duration where
/--
Second offset of the duration.
-/
second : Second.Offset
/--
Nanosecond span that ranges from -999999999 and 999999999
-/
nano : Nanosecond.Span
/--
Proof that the duration is valid, ensuring that the `second` and `nano` values are correctly related.
-/
proof : (second.val 0 nano.val 0) (second.val 0 nano.val 0)
deriving Repr
instance : ToString Duration where
toString s :=
let (sign, secs, nanos) :=
if s.second.val > 0 then ("" ,s.second, s.nano.val)
else if s.second.val < 0 then ("-", -s.second, -s.nano.val)
else if s.nano.val < 0 then ("-", -s.second, -s.nano.val) else ("", s.second, s.nano.val)
sign ++ toString secs ++ (if s.nano.val == 0 then "" else "." ++ (leftPad 9 <| toString nanos)) ++ "s"
where
leftPad n s := "".pushn '0' (n - s.length) ++ s
instance : Repr Duration where
reprPrec s := reprPrec (toString s)
instance : BEq Duration where
beq x y := x.second == y.second && y.nano == x.nano
instance : Inhabited Duration where
default := 0, Bounded.LE.mk 0 (by decide), by decide
instance : OfNat Duration n where
ofNat := by
refine .ofInt n, 0, by decide, ?_
simp <;> exact Int.le_total n 0 |>.symm
namespace Duration
/--
Negates a `Duration`, flipping its second and nanosecond values.
-/
@[inline]
protected def neg (duration : Duration) : Duration := by
refine -duration.second, duration.nano.neg, ?_
cases duration.proof with
| inl n => exact Or.inr (n.imp Int.neg_le_neg Int.neg_le_neg)
| inr n => exact Or.inl (n.imp Int.neg_le_neg Int.neg_le_neg)
/--
Creates a new `Duration` out of `Second.Offset`.
-/
@[inline]
def ofSeconds (s : Second.Offset) : Duration := by
refine s, 0, by decide, ?_
simp <;> exact Int.le_total s.val 0 |>.symm
/--
Creates a new `Duration` out of `Nanosecond.Offset`.
-/
def ofNanoseconds (s : Nanosecond.Offset) : Duration := by
refine s.ediv 1000000000, Bounded.LE.byMod s.val 1000000000 (by decide), ?_
cases Int.le_total s.val 0
next n => exact Or.inr (And.intro (Int.ediv_le_ediv (by decide) n) (mod_nonpos 1000000000 n (by decide)))
next n => exact Or.inl (And.intro (Int.ediv_nonneg n (by decide)) (Int.tmod_nonneg 1000000000 n))
where
mod_nonpos : {a : Int} (b : Int), (a 0) (b 0) 0 a.tmod b
| .negSucc m, .ofNat n, _, _ => Int.neg_le_neg (Int.tmod_nonneg (n) (Int.ofNat_le.mpr (Nat.zero_le (m + 1))))
| 0, n, _, _ => Int.eq_iff_le_and_ge.mp (Int.zero_tmod n) |>.left
/--
Creates a new `Duration` out of `Millisecond.Offset`.
-/
@[inline]
def ofMillisecond (s : Millisecond.Offset) : Duration :=
ofNanoseconds (s.mul 1000000)
/--
Checks if the duration is zero seconds and zero nanoseconds.
-/
@[inline]
def isZero (d : Duration) : Bool :=
d.second.val = 0 d.nano.val = 0
/--
Converts a `Duration` to a `Second.Offset`
-/
@[inline]
def toSeconds (duration : Duration) : Second.Offset :=
duration.second
/--
Converts a `Duration` to a `Millisecond.Offset`
-/
@[inline]
def toMilliseconds (duration : Duration) : Millisecond.Offset :=
let secMillis := duration.second.mul 1000
let nanosMillis := duration.nano.ediv 1000000 (by decide)
let millis := secMillis + (.ofInt nanosMillis.val)
millis
/--
Converts a `Duration` to a `Nanosecond.Offset`
-/
@[inline]
def toNanoseconds (duration : Duration) : Nanosecond.Offset :=
let nanos := duration.second.mul 1000000000
let nanos := nanos + (.ofInt duration.nano.val)
nanos
instance : LE Duration where
le d1 d2 := d1.toNanoseconds d2.toNanoseconds
instance {x y : Duration} : Decidable (x y) :=
inferInstanceAs (Decidable (x.toNanoseconds y.toNanoseconds))
/--
Converts a `Duration` to a `Minute.Offset`
-/
@[inline]
def toMinutes (tm : Duration) : Minute.Offset :=
tm.second.ediv 60
/--
Converts a `Duration` to a `Day.Offset`
-/
@[inline]
def toDays (tm : Duration) : Day.Offset :=
tm.second.ediv 86400
/--
Normalizes `Second.Offset` and `NanoSecond.span` in order to build a new `Duration` out of it.
-/
@[inline]
def fromComponents (secs : Second.Offset) (nanos : Nanosecond.Span) : Duration :=
ofNanoseconds (secs.toNanoseconds + nanos.toOffset)
/--
Adds two durations together, handling any carry-over in nanoseconds.
-/
@[inline]
def add (t₁ t₂ : Duration) : Duration :=
ofNanoseconds (toNanoseconds t₁ + toNanoseconds t₂)
/--
Subtracts one `Duration` from another.
-/
@[inline]
def sub (t₁ t₂ : Duration) : Duration :=
t₁.add t₂.neg
/--
Adds a `Nanosecond.Offset` to a `Duration`
-/
@[inline]
def addNanoseconds (t : Duration) (s : Nanosecond.Offset) : Duration :=
t.add (ofNanoseconds s)
/--
Adds a `Millisecond.Offset` to a `Duration`
-/
@[inline]
def addMilliseconds (t : Duration) (s : Millisecond.Offset) : Duration :=
t.add (ofNanoseconds s.toNanoseconds)
/--
Adds a `Millisecond.Offset` to a `Duration`
-/
@[inline]
def subMilliseconds (t : Duration) (s : Millisecond.Offset) : Duration :=
t.sub (ofNanoseconds s.toNanoseconds)
/--
Adds a `Nanosecond.Offset` to a `Duration`
-/
@[inline]
def subNanoseconds (t : Duration) (s : Nanosecond.Offset) : Duration :=
t.sub (ofNanoseconds s)
/--
Adds a `Second.Offset` to a `Duration`
-/
@[inline]
def addSeconds (t : Duration) (s : Second.Offset) : Duration :=
t.add (ofSeconds s)
/--
Subtracts a `Second.Offset` from a `Duration`
-/
@[inline]
def subSeconds (t : Duration) (s : Second.Offset) : Duration :=
t.sub (ofSeconds s)
/--
Adds a `Minute.Offset` to a `Duration`
-/
@[inline]
def addMinutes (t : Duration) (m : Minute.Offset) : Duration :=
let seconds := m.mul 60
t.addSeconds seconds
/--
Subtracts a `Minute.Offset` from a `Duration`
-/
@[inline]
def subMinutes (t : Duration) (m : Minute.Offset) : Duration :=
let seconds := m.mul 60
t.subSeconds seconds
/--
Adds an `Hour.Offset` to a `Duration`
-/
@[inline]
def addHours (t : Duration) (h : Hour.Offset) : Duration :=
let seconds := h.mul 3600
t.addSeconds seconds
/--
Subtracts an `Hour.Offset` from a `Duration`
-/
@[inline]
def subHours (t : Duration) (h : Hour.Offset) : Duration :=
let seconds := h.mul 3600
t.subSeconds seconds
/--
Adds a `Day.Offset` to a `Duration`
-/
@[inline]
def addDays (t : Duration) (d : Day.Offset) : Duration :=
let seconds := d.mul 86400
t.addSeconds seconds
/--
Subtracts a `Day.Offset` from a `Duration`
-/
@[inline]
def subDays (t : Duration) (d : Day.Offset) : Duration :=
let seconds := d.mul 86400
t.subSeconds seconds
/--
Adds a `Week.Offset` to a `Duration`
-/
@[inline]
def addWeeks (t : Duration) (w : Week.Offset) : Duration :=
let seconds := w.mul 604800
t.addSeconds seconds
/--
Subtracts a `Week.Offset` from a `Duration`
-/
@[inline]
def subWeeks (t : Duration) (w : Week.Offset) : Duration :=
let seconds := w.mul 604800
t.subSeconds seconds
instance : HAdd Duration Day.Offset Duration where
hAdd := addDays
instance : HSub Duration Day.Offset Duration where
hSub := subDays
instance : HAdd Duration Week.Offset Duration where
hAdd := addWeeks
instance : HSub Duration Week.Offset Duration where
hSub := subWeeks
instance : HAdd Duration Hour.Offset Duration where
hAdd := addHours
instance : HSub Duration Hour.Offset Duration where
hSub := subHours
instance : HAdd Duration Minute.Offset Duration where
hAdd := addMinutes
instance : HSub Duration Minute.Offset Duration where
hSub := subMinutes
instance : HAdd Duration Second.Offset Duration where
hAdd := addSeconds
instance : HSub Duration Second.Offset Duration where
hSub := subSeconds
instance : HAdd Duration Nanosecond.Offset Duration where
hAdd := addNanoseconds
instance : HSub Duration Nanosecond.Offset Duration where
hSub := subNanoseconds
instance : HAdd Duration Millisecond.Offset Duration where
hAdd := addMilliseconds
instance : HSub Duration Millisecond.Offset Duration where
hSub := subMilliseconds
instance : HSub Duration Duration Duration where
hSub := sub
instance : HAdd Duration Duration Duration where
hAdd := add
instance : Coe Nanosecond.Offset Duration where
coe := ofNanoseconds
instance : Coe Second.Offset Duration where
coe := ofSeconds
instance : Coe Minute.Offset Duration where
coe := ofSeconds Minute.Offset.toSeconds
instance : Coe Hour.Offset Duration where
coe := ofSeconds Hour.Offset.toSeconds
instance : Coe Week.Offset Duration where
coe := ofSeconds Day.Offset.toSeconds Week.Offset.toDays
instance : Coe Day.Offset Duration where
coe := ofSeconds Day.Offset.toSeconds
instance : HMul Int Duration Duration where
hMul i d := Duration.ofNanoseconds <| Nanosecond.Offset.ofInt (d.toNanoseconds.val * i)
instance : HMul Duration Int Duration where
hMul d i := Duration.ofNanoseconds <| Nanosecond.Offset.ofInt (d.toNanoseconds.val * i)
instance : HAdd PlainTime Duration PlainTime where
hAdd pt d := PlainTime.ofNanoseconds (d.toNanoseconds + pt.toNanoseconds)
instance : HSub PlainTime Duration PlainTime where
hSub pt d := PlainTime.ofNanoseconds (d.toNanoseconds - pt.toNanoseconds)
end Duration
end Time
end Std

623
src/Std/Time/Format.lean Normal file
View File

@@ -0,0 +1,623 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Notation.Spec
import Std.Time.Format.Basic
import Std.Time.Internal.Bounded
namespace Std
namespace Time
namespace Formats
open Internal
set_option linter.all true
/--
The ISO8601 format, which is always 24 or 27 characters long, used for representing date and time in
a standardized format. The format follows the pattern `uuuu-MM-dd'T'HH:mm:ssZ`.
-/
def iso8601 : GenericFormat .any := datespec("uuuu-MM-dd'T'HH:mm.ssZ")
/--
The americanDate format, which follows the pattern `MM-dd-uuuu`.
-/
def americanDate : GenericFormat .any := datespec("MM-dd-uuuu")
/--
The europeanDate format, which follows the pattern `dd-MM-uuuu`.
-/
def europeanDate : GenericFormat .any := datespec("dd-MM-uuuu")
/--
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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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 : 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`.
This format is an older standard for representing date and time in headers.
-/
def rfc850 : GenericFormat .any := datespec("eee, dd-MM-uuuu HH:mm:ss ZZZ")
end Formats
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 : GenericFormat .any := datespec("VV ZZZZZ")
spec.parseBuilder (fun id off => some (TimeZone.mk off id (off.toIsoString true) false)) input
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 : GenericFormat .any := datespec("xxx")
spec.parseBuilder some input
end Offset
end TimeZone
namespace PlainDate
/--
Formats a `PlainDate` using a specific format.
-/
def format (date : PlainDate) (format : String) : String :=
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
| .u _ => some date.year
| .D _ => some (Sigma.mk date.year.isLeap date.dayOfYear)
| .Qorq _ => some date.quarter
| .w _ => some date.weekOfYear
| .W _ => some date.alignedWeekOfMonth
| .MorL _ => some date.month
| .d _ => some date.day
| .E _ => 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 :=
fromAmericanDateString input
<|> fromSQLDateString input
instance : ToString PlainDate where
toString := toLeanDateString
instance : Repr PlainDate where
reprPrec data := Repr.addAppParen ("date(\"" ++ toLeanDateString data ++ "\")")
end PlainDate
namespace PlainTime
/--
Formats a `PlainTime` using a specific format.
-/
def format (time : PlainTime) (format : String) : String :=
let format : Except String (GenericFormat .any) := GenericFormat.spec format
match format with
| .error err => s!"error: {err}"
| .ok res =>
let res := res.formatGeneric fun
| .H _ => some time.hour
| .k _ => some (time.hour.shiftTo1BasedHour)
| .m _ => some time.minute
| .n _ => some time.nanosecond
| .s _ => some time.second
| .a _ => some (HourMarker.ofOrdinal time.hour)
| .h _ => some time.hour.toRelative
| .K _ => some (time.hour.emod 12 (by decide))
| .S _ => some time.nanosecond
| .A _ => some time.toMilliseconds
| .N _ => some time.toNanoseconds
| _ => none
match res with
| some res => res
| none => "invalid time"
/--
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.snd)) 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.snd n)) input
<|> Formats.leanTime24HourNoNanos.parseBuilder (fun h m s => some (PlainTime.ofHourMinuteSecondsNano h m s.snd 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.snd
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 :=
fromTime12Hour input
<|> fromTime24Hour input
instance : ToString PlainTime where
toString := toLeanTime24Hour
instance : Repr PlainTime where
reprPrec data := Repr.addAppParen ("time(\"" ++ toLeanTime24Hour data ++ "\")")
end PlainTime
namespace ZonedDateTime
/--
Formats a `ZonedDateTime` using a specific format.
-/
def format (data: ZonedDateTime) (format : String) : String :=
let format : Except String (GenericFormat .any) := GenericFormat.spec format
match format with
| .error err => s!"error: {err}"
| .ok res => res.format data.toDateTime
/--
Parses a `String` in the `ISO8601` format and returns a `ZonedDateTime`.
-/
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 :=
fromISO8601String input
<|> fromRFC822String input
<|> fromRFC850String input
<|> fromDateTimeWithZoneString input
<|> fromLeanDateTimeWithIdentifierString input
instance : ToString ZonedDateTime where
toString := toLeanDateTimeWithIdentifierString
instance : Repr ZonedDateTime where
reprPrec data := Repr.addAppParen ("zoned(\"" ++ toLeanDateTimeWithZoneString data ++ "\")")
end ZonedDateTime
namespace PlainDateTime
/--
Formats a `PlainDateTime` using a specific format.
-/
def format (date : PlainDateTime) (format : String) : String :=
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
| .u _ => some date.year
| .D _ => some (Sigma.mk date.year.isLeap date.dayOfYear)
| .Qorq _ => some date.quarter
| .w _ => some date.weekOfYear
| .W _ => some date.alignedWeekOfMonth
| .MorL _ => some date.month
| .d _ => some date.day
| .E _ => some date.weekday
| .eorc _ => some date.weekday
| .F _ => some date.weekOfMonth
| .H _ => some date.hour
| .k _ => some date.hour.shiftTo1BasedHour
| .m _ => some date.minute
| .n _ => some date.nanosecond
| .s _ => some date.time.second
| .a _ => some (HourMarker.ofOrdinal date.hour)
| .h _ => some date.hour.toRelative
| .K _ => some (date.hour.emod 12 (by decide))
| .S _ => some date.nanosecond
| .A _ => some date.time.toMilliseconds
| .N _ => some date.time.toNanoseconds
| _ => none
match res with
| some res => res
| none => "invalid time"
/--
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 :=
fromAscTimeString date
<|> fromLongDateFormatString date
<|> fromDateTimeString date
<|> fromLeanDateTimeString date
instance : ToString PlainDateTime where
toString := toLeanDateTimeString
instance : Repr PlainDateTime where
reprPrec data := Repr.addAppParen ("datetime(\"" ++ toLeanDateTimeString data ++ "\")")
end PlainDateTime
namespace DateTime
/--
Formats a `DateTime` using a specific format.
-/
def format (data: DateTime tz) (format : String) : String :=
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) :=
fromAscTimeString date
<|> fromLongDateFormatString date
instance : Repr (DateTime tz) where
reprPrec data := Repr.addAppParen (toLeanDateTimeWithZoneString data)
instance : ToString (DateTime tz) where
toString := toLeanDateTimeWithZoneString
end DateTime

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,8 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Internal.Bounded
import Std.Time.Internal.UnitVal

View File

@@ -0,0 +1,474 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Init.Data.Int
namespace Std
namespace Time
namespace Internal
set_option linter.all true in
/--
A `Bounded` is represented by an `Int` that is constrained by a lower and higher bounded using some
relation `rel`. It includes all the integers that `rel lo val ∧ rel val hi`.
-/
def Bounded (rel : Int Int Prop) (lo : Int) (hi : Int) := { val : Int // rel lo val rel val hi }
namespace Bounded
@[always_inline]
instance : LE (Bounded rel n m) where
le l r := l.val r.val
@[always_inline]
instance : LT (Bounded rel n m) where
lt l r := l.val < r.val
@[always_inline]
instance : Repr (Bounded rel m n) where
reprPrec n := reprPrec n.val
@[always_inline]
instance : BEq (Bounded rel n m) where
beq x y := (x.val = y.val)
@[always_inline]
instance {x y : Bounded rel a b} : Decidable (x y) :=
inferInstanceAs (Decidable (x.val y.val))
/--
A `Bounded` integer that the relation used is the the less-equal relation so, it includes all
integers that `lo ≤ val ≤ hi`.
-/
abbrev LE := @Bounded LE.le
/--
Casts the boundaries of the `Bounded` using equivalences.
-/
@[inline]
def cast {rel : Int Int Prop} {lo₁ lo₂ hi₁ hi₂ : Int} (h₁ : lo₁ = lo₂) (h₂ : hi₁ = hi₂) (b : Bounded rel lo₁ hi₁) : Bounded rel lo₂ hi₂ :=
.mk b.val h₁ b.property.1, h₂ b.property.2
/--
A `Bounded` integer that the relation used is the the less-than relation so, it includes all
integers that `lo < val < hi`.
-/
abbrev LT := @Bounded LT.lt
/--
Creates a new `Bounded` Integer.
-/
@[inline]
def mk {rel : Int Int Prop} (val : Int) (proof : rel lo val rel val hi) : @Bounded rel lo hi :=
val, proof
/--
Convert a `Int` to a `Bounded` if it checks.
-/
@[inline]
def ofInt? [DecidableRel rel] (val : Int) : Option (Bounded rel lo hi) :=
if h : rel lo val rel val hi then
some val, h
else
none
namespace LE
/--
Convert a `Nat` to a `Bounded.LE` by wrapping it.
-/
@[inline]
def ofNatWrapping { lo hi : Int } (val : Int) (h : lo hi) : Bounded.LE lo hi := by
let range := hi - lo + 1
have range_pos := Int.add_pos_of_nonneg_of_pos (b := 1) (Int.sub_nonneg_of_le h) (by decide)
have not_zero := Int.ne_iff_lt_or_gt.mpr (Or.inl range_pos)
have mod_nonneg : 0 (val - lo) % range := Int.emod_nonneg (val - lo) not_zero.symm
have add_nonneg : lo lo + (val - lo) % range := Int.le_add_of_nonneg_right mod_nonneg
have mod_range : (val - lo) % (hi - lo + 1) < range := Int.emod_lt_of_pos (a := val - lo) range_pos
refine ((val - lo) % range + range) % range + lo, And.intro ?_ ?_
· simp_all [range]
rw [Int.add_comm] at add_nonneg
exact add_nonneg
· apply Int.add_le_of_le_sub_right
simp_all [range]
exact Int.le_of_lt_add_one mod_range
instance {k : Nat} : OfNat (Bounded.LE lo (lo + k)) n where
ofNat :=
let h : lo lo + k := Int.le_add_of_nonneg_right (Int.ofNat_zero_le k)
ofNatWrapping n h
instance {k : Nat} : Inhabited (Bounded.LE lo (lo + k)) where
default :=
let h : lo lo + k := Int.le_add_of_nonneg_right (Int.ofNat_zero_le k)
ofNatWrapping lo h
/--
Creates a new `Bounded` integer that the relation is less-equal.
-/
@[inline]
def mk (val : Int) (proof : lo val val hi) : Bounded.LE lo hi :=
val, proof
/--
Creates a new `Bounded` integer that the relation is less-equal.
-/
@[inline]
def exact (val : Nat) : Bounded.LE val val :=
val, by simp
/--
Creates a new `Bounded` integer.
-/
@[inline]
def ofInt { lo hi : Int } (val : Int) : Option (Bounded.LE lo hi) :=
if h : lo val val hi
then some val, h
else none
/--
Convert a `Nat` to a `Bounded.LE`.
-/
@[inline]
def ofNat (val : Nat) (h : val hi) : Bounded.LE 0 hi :=
Bounded.mk val (And.intro (Int.ofNat_zero_le val) (Int.ofNat_le.mpr h))
/--
Convert a `Nat` to a `Bounded.LE` if it checks.
-/
@[inline]
def ofNat? { hi : Nat } (val : Nat) : Option (Bounded.LE 0 hi) :=
if h : val hi then
ofNat val h
else
none
/--
Convert a `Nat` to a `Bounded.LE` using the lower boundary too.
-/
@[inline]
def ofNat' (val : Nat) (h : lo val val hi) : Bounded.LE lo hi :=
Bounded.mk val (And.intro (Int.ofNat_le.mpr h.left) (Int.ofNat_le.mpr h.right))
/--
Convert a `Nat` to a `Bounded.LE` using the lower boundary too.
-/
@[inline]
def clip (val : Int) (h : lo hi) : Bounded.LE lo hi :=
if h₀ : lo val then
if h₁ : val hi
then val, And.intro h₀ h₁
else hi, And.intro h (Int.le_refl hi)
else lo, And.intro (Int.le_refl lo) h
/--
Convert a `Bounded.LE` to a Nat.
-/
@[inline]
def toNat (n : Bounded.LE lo hi) : Nat :=
n.val.toNat
/--
Convert a `Bounded.LE` to a Nat.
-/
@[inline]
def toNat' (n : Bounded.LE lo hi) (h : lo 0) : Nat :=
let h₁ := (Int.le_trans h n.property.left)
match n.val, h₁ with
| .ofNat n, _ => n
| .negSucc _, h => by contradiction
/--
Convert a `Bounded.LE` to an Int.
-/
@[inline]
def toInt (n : Bounded.LE lo hi) : Int :=
n.val
/--
Convert a `Bounded.LE` to a `Fin`.
-/
@[inline, simp]
def toFin (n : Bounded.LE lo hi) (h₀ : 0 lo) : Fin (hi + 1).toNat := by
let h := n.property.right
let h₁ := Int.le_trans h₀ n.property.left
refine n.val.toNat, (Int.toNat_lt h₁).mpr ?_
rw [Int.toNat_of_nonneg (by omega)]
exact Int.lt_add_one_of_le h
/--
Convert a `Fin` to a `Bounded.LE`.
-/
@[inline]
def ofFin (fin : Fin (Nat.succ hi)) : Bounded.LE 0 hi :=
ofNat fin.val (Nat.le_of_lt_succ fin.isLt)
/--
Convert a `Fin` to a `Bounded.LE`.
-/
@[inline]
def ofFin' {lo : Nat} (fin : Fin (Nat.succ hi)) (h : lo hi) : Bounded.LE lo hi :=
if h₁ : fin.val lo
then ofNat' fin.val (And.intro h₁ ((Nat.le_of_lt_succ fin.isLt)))
else ofNat' lo (And.intro (Nat.le_refl lo) h)
/--
Creates a new `Bounded.LE` using a the modulus of a number.
-/
@[inline]
def byEmod (b : Int) (i : Int) (hi : i > 0) : Bounded.LE 0 (i - 1) := by
refine b % i, And.intro ?_ ?_
· apply Int.emod_nonneg b
intro a
simp_all [Int.lt_irrefl]
· apply Int.le_of_lt_add_one
simp [Int.add_sub_assoc]
exact Int.emod_lt_of_pos b hi
/--
Creates a new `Bounded.LE` using a the Truncating modulus of a number.
-/
@[inline]
def byMod (b : Int) (i : Int) (hi : 0 < i) : Bounded.LE (- (i - 1)) (i - 1) := by
refine b.tmod i, And.intro ?_ ?_
· simp [Int.tmod]
split <;> try contradiction
next m n =>
let h := Int.emod_nonneg (a := m) (b := n) (Int.ne_of_gt hi)
apply (Int.le_trans · h)
apply Int.le_of_neg_le_neg
simp_all
exact (Int.le_sub_one_of_lt hi)
next m n =>
apply Int.neg_le_neg
have h := Int.tmod_lt_of_pos (m + 1) hi
exact Int.le_sub_one_of_lt h
· exact Int.le_sub_one_of_lt (Int.tmod_lt_of_pos b hi)
/--
Adjust the bounds of a `Bounded` by setting the lower bound to zero and the maximum value to (m - n).
-/
@[inline]
def truncate (bounded : Bounded.LE n m) : Bounded.LE 0 (m - n) := by
let left, right := bounded.property
refine bounded.val - n, And.intro ?_ ?_
all_goals omega
/--
Adjust the bounds of a `Bounded` by changing the higher bound if another value `j` satisfies the same
constraint.
-/
@[inline, simp]
def truncateTop (bounded : Bounded.LE n m) (h : bounded.val j) : Bounded.LE n j := by
refine bounded.val, And.intro ?_ ?_
· exact bounded.property.left
· exact h
/--
Adjust the bounds of a `Bounded` by changing the lower bound if another value `j` satisfies the same
constraint.
-/
@[inline]
def truncateBottom (bounded : Bounded.LE n m) (h : bounded.val j) : Bounded.LE j m := by
refine bounded.val, And.intro ?_ ?_
· exact h
· exact bounded.property.right
/--
Adjust the bounds of a `Bounded` by adding a constant value to both the lower and upper bounds.
-/
@[inline]
def neg (bounded : Bounded.LE n m) : Bounded.LE (-m) (-n) := by
refine -bounded.val, And.intro ?_ ?_
· exact Int.neg_le_neg bounded.property.right
· exact Int.neg_le_neg bounded.property.left
/--
Adjust the bounds of a `Bounded` by adding a constant value to both the lower and upper bounds.
-/
@[inline, simp]
def add (bounded : Bounded.LE n m) (num : Int) : Bounded.LE (n + num) (m + num) := by
refine bounded.val + num, And.intro ?_ ?_
all_goals apply (Int.add_le_add · (Int.le_refl num))
· exact bounded.property.left
· exact bounded.property.right
/--
Adjust the bounds of a `Bounded` by adding a constant value to both the lower and upper bounds.
-/
@[inline]
def addProven (bounded : Bounded.LE n m) (h₀ : bounded.val + num m) (h₁ : num 0) : Bounded.LE n m := by
refine bounded.val + num, And.intro ?_ ?_
· exact Int.le_trans bounded.property.left (Int.le_add_of_nonneg_right h₁)
· exact h₀
/--
Adjust the bounds of a `Bounded` by adding a constant value to the upper bounds.
-/
@[inline]
def addTop (bounded : Bounded.LE n m) (num : Int) (h : num 0) : Bounded.LE n (m + num) := by
refine bounded.val + num, And.intro ?_ ?_
· let h := Int.add_le_add bounded.property.left h
simp at h
exact h
· exact Int.add_le_add bounded.property.right (Int.le_refl num)
/--
Adjust the bounds of a `Bounded` by adding a constant value to the lower bounds.
-/
@[inline]
def subBottom (bounded : Bounded.LE n m) (num : Int) (h : num 0) : Bounded.LE (n - num) m := by
refine bounded.val - num, And.intro ?_ ?_
· exact Int.add_le_add bounded.property.left (Int.le_refl (-num))
· let h := Int.sub_le_sub bounded.property.right h
simp at h
exact h
/--
Adds two `Bounded` and adjust the boundaries.
-/
@[inline]
def addBounds (bounded : Bounded.LE n m) (bounded₂ : Bounded.LE i j) : Bounded.LE (n + i) (m + j) := by
refine bounded.val + bounded₂.val, And.intro ?_ ?_
· exact Int.add_le_add bounded.property.left bounded₂.property.left
· exact Int.add_le_add bounded.property.right bounded₂.property.right
/--
Adjust the bounds of a `Bounded` by subtracting a constant value to both the lower and upper bounds.
-/
@[inline, simp]
def sub (bounded : Bounded.LE n m) (num : Int) : Bounded.LE (n - num) (m - num) :=
add bounded (-num)
/--
Adds two `Bounded` and adjust the boundaries.
-/
@[inline]
def subBounds (bounded : Bounded.LE n m) (bounded₂ : Bounded.LE i j) : Bounded.LE (n - j) (m - i) :=
addBounds bounded bounded₂.neg
/--
Adjust the bounds of a `Bounded` by applying the emod operation constraining the lower bound to 0 and
the upper bound to the value.
-/
@[inline]
def emod (bounded : Bounded.LE n num) (num : Int) (hi : 0 < num) : Bounded.LE 0 (num - 1) :=
byEmod bounded.val num hi
/--
Adjust the bounds of a `Bounded` by applying the mod operation.
-/
@[inline]
def mod (bounded : Bounded.LE n num) (num : Int) (hi : 0 < num) : Bounded.LE (- (num - 1)) (num - 1) :=
byMod bounded.val num hi
/--
Adjust the bounds of a `Bounded` by applying the multiplication operation with a positive number.
-/
@[inline]
def mul_pos (bounded : Bounded.LE n m) (num : Int) (h : num 0) : Bounded.LE (n * num) (m * num) := by
refine bounded.val * num, And.intro ?_ ?_
· exact Int.mul_le_mul_of_nonneg_right bounded.property.left h
· exact Int.mul_le_mul_of_nonneg_right bounded.property.right h
/--
Adjust the bounds of a `Bounded` by applying the multiplication operation with a positive number.
-/
@[inline]
def mul_neg (bounded : Bounded.LE n m) (num : Int) (h : num 0) : Bounded.LE (m * num) (n * num) := by
refine bounded.val * num, And.intro ?_ ?_
· exact Int.mul_le_mul_of_nonpos_right bounded.property.right h
· exact Int.mul_le_mul_of_nonpos_right bounded.property.left h
/--
Adjust the bounds of a `Bounded` by applying the div operation.
-/
@[inline]
def ediv (bounded : Bounded.LE n m) (num : Int) (h : num > 0) : Bounded.LE (n / num) (m / num) := by
let left, right := bounded.property
refine bounded.val.ediv num, And.intro ?_ ?_
apply Int.ediv_le_ediv
· exact h
· exact left
· apply Int.ediv_le_ediv
· exact h
· exact right
@[inline]
def eq {n : Int} : Bounded.LE n n :=
n, And.intro (Int.le_refl n) (Int.le_refl n)
/--
Expand the range of a bounded value.
-/
@[inline]
def expand (bounded : Bounded.LE lo hi) (h : hi nhi) (h₁ : nlo lo) : Bounded.LE nlo nhi :=
bounded.val, And.intro (Int.le_trans h₁ bounded.property.left) (Int.le_trans bounded.property.right h)
/--
Expand the bottom of the bounded to a number `nhi` is `hi` is less or equal to the previous higher bound.
-/
@[inline]
def expandTop (bounded : Bounded.LE lo hi) (h : hi nhi) : Bounded.LE lo nhi :=
expand bounded h (Int.le_refl lo)
/--
Expand the bottom of the bounded to a number `nlo` if `lo` is greater or equal to the previous lower bound.
-/
@[inline]
def expandBottom (bounded : Bounded.LE lo hi) (h : nlo lo) : Bounded.LE nlo hi :=
expand bounded (Int.le_refl hi) h
/--
Adds one to the value of the bounded if the value is less than the higher bound of the bounded number.
-/
@[inline]
def succ (bounded : Bounded.LE lo hi) (h : bounded.val < hi) : Bounded.LE lo hi :=
let left := bounded.property.left
bounded.val + 1, And.intro (by omega) (by omega)
/--
Returns the absolute value of the bounded number `bo` with bounds `-(i - 1)` to `i - 1`. The result
will be a new bounded number with bounds `0` to `i - 1`.
-/
@[inline]
def abs (bo : Bounded.LE (-i) i) : Bounded.LE 0 i :=
if h : bo.val 0 then
bo.truncateBottom h
else by
let r := bo.truncateTop (Int.le_of_lt (Int.not_le.mp h)) |>.neg
rw [Int.neg_neg] at r
exact r
/--
Returns the maximum between a number and the bounded.
-/
def max (bounded : Bounded.LE n m) (val : Int) : Bounded.LE (Max.max n val) (Max.max m val) := by
let left, right := bounded.property
refine Max.max bounded.val val, And.intro ?_ ?_
all_goals
simp [Int.max_def]
split <;> split
next h => simp [h, Int.le_trans left h]
next h h₁ => exact Int.le_of_lt <| Int.not_le.mp h₁
next h => simp [h, Int.le_trans left h]
next h h₁ => exact left
next h h₁ => simp [h, Int.le_trans left h]
next h h₁ => exact Int.le_of_lt <| Int.not_le.mp h₁
next h h₁ =>
let h₃ := Int.lt_of_lt_of_le (Int.not_le.mp h) right
let h₄ := Int.not_le.mpr h₃ h₁
contradiction
next h h₁ => exact right
end LE
end Bounded
end Internal
end Time
end Std

View File

@@ -0,0 +1,125 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Init.Data
import Std.Internal.Rat
namespace Std
namespace Time
namespace Internal
open Std.Internal
open Lean
set_option linter.all true
/--
A structure representing a unit of a given ratio type `α`.
-/
structure UnitVal (α : Rat) where
/--
Creates a `UnitVal` from an `Int`.
-/
ofInt ::
/--
Value inside the UnitVal Value.
-/
val : Int
deriving Inhabited, BEq
instance : LE (UnitVal x) where
le x y := x.val y.val
instance { x y : UnitVal z }: Decidable (x y) :=
inferInstanceAs (Decidable (x.val y.val))
namespace UnitVal
/--
Creates a `UnitVal` from a `Nat`.
-/
@[inline]
def ofNat (value : Nat) : UnitVal α :=
value
/--
Converts a `UnitVal` to an `Int`.
-/
@[inline]
def toInt (unit : UnitVal α) : Int :=
unit.val
/--
Multiplies the `UnitVal` by an `Int`, resulting in a new `UnitVal` with an adjusted ratio.
-/
@[inline]
def mul (unit : UnitVal a) (factor : Int) : UnitVal (a / factor) :=
unit.val * factor
/--
Divides the `UnitVal` by an `Int`, resulting in a new `UnitVal` with an adjusted ratio.
-/
@[inline]
def ediv (unit : UnitVal a) (divisor : Int) : UnitVal (a * divisor) :=
unit.val.ediv divisor
/--
Divides the `UnitVal` by an `Int`, resulting in a new `UnitVal` with an adjusted ratio.
-/
@[inline]
def div (unit : UnitVal a) (divisor : Int) : UnitVal (a * divisor) :=
unit.val.tdiv divisor
/--
Adds two `UnitVal` values of the same ratio.
-/
@[inline]
def add (u1 : UnitVal α) (u2 : UnitVal α) : UnitVal α :=
u1.val + u2.val
/--
Subtracts one `UnitVal` value from another of the same ratio.
-/
@[inline]
def sub (u1 : UnitVal α) (u2 : UnitVal α) : UnitVal α :=
u1.val - u2.val
/--
Returns the absolute value of a `UnitVal`.
-/
@[inline]
def abs (u : UnitVal α) : UnitVal α :=
u.val.natAbs
/--
Converts an `Offset` to another unit type.
-/
@[inline]
def convert (val : UnitVal a) : UnitVal b :=
let ratio := a.div b
ofInt <| val.toInt * ratio.num / ratio.den
instance : OfNat (UnitVal α) n where ofNat := Int.ofNat n
instance : Repr (UnitVal α) where reprPrec x p := reprPrec x.val p
instance : LE (UnitVal α) where le x y := x.val y.val
instance : LT (UnitVal α) where lt x y := x.val < y.val
instance : Add (UnitVal α) where add := UnitVal.add
instance : Sub (UnitVal α) where sub := UnitVal.sub
instance : Neg (UnitVal α) where neg x := -x.val
instance : ToString (UnitVal n) where toString n := toString n.val
end UnitVal
end Internal
end Time
end Std

246
src/Std/Time/Notation.lean Normal file
View File

@@ -0,0 +1,246 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Date
import Std.Time.Time
import Std.Time.Zoned
import Std.Time.DateTime
import Std.Time.Format
namespace Std
namespace Time
open Lean Parser Command Std
set_option linter.all true
private def convertText : Text MacroM (TSyntax `term)
| .short => `(Std.Time.Text.short)
| .full => `(Std.Time.Text.full)
| .narrow => `(Std.Time.Text.narrow)
private def convertNumber : Number MacroM (TSyntax `term)
| padding => `(Std.Time.Number.mk $(quote padding))
private def convertFraction : Fraction MacroM (TSyntax `term)
| .nano => `(Std.Time.Fraction.nano)
| .truncated digits => `(Std.Time.Fraction.truncated $(quote digits))
private def convertYear : Year MacroM (TSyntax `term)
| .twoDigit => `(Std.Time.Year.twoDigit)
| .fourDigit => `(Std.Time.Year.fourDigit)
| .extended n => `(Std.Time.Year.extended $(quote n))
private def convertZoneName : ZoneName MacroM (TSyntax `term)
| .short => `(Std.Time.ZoneName.short)
| .full => `(Std.Time.ZoneName.full)
private def convertOffsetX : OffsetX MacroM (TSyntax `term)
| .hour => `(Std.Time.OffsetX.hour)
| .hourMinute => `(Std.Time.OffsetX.hourMinute)
| .hourMinuteColon => `(Std.Time.OffsetX.hourMinuteColon)
| .hourMinuteSecond => `(Std.Time.OffsetX.hourMinuteSecond)
| .hourMinuteSecondColon => `(Std.Time.OffsetX.hourMinuteSecondColon)
private def convertOffsetO : OffsetO MacroM (TSyntax `term)
| .short => `(Std.Time.OffsetO.short)
| .full => `(Std.Time.OffsetO.full)
private def convertOffsetZ : OffsetZ MacroM (TSyntax `term)
| .hourMinute => `(Std.Time.OffsetZ.hourMinute)
| .full => `(Std.Time.OffsetZ.full)
| .hourMinuteSecondColon => `(Std.Time.OffsetZ.hourMinuteSecondColon)
private def convertModifier : Modifier MacroM (TSyntax `term)
| .G p => do `(Std.Time.Modifier.G $( convertText 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))
| .MorL p =>
match p with
| .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))
| .Qorq p =>
match p with
| .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))
| .eorc p =>
match p with
| .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))
| .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))
| .H p => do `(Std.Time.Modifier.H $( convertNumber p))
| .m p => do `(Std.Time.Modifier.m $( convertNumber p))
| .s p => do `(Std.Time.Modifier.s $( convertNumber p))
| .S p => do `(Std.Time.Modifier.S $( convertFraction p))
| .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 => `(Std.Time.Modifier.V)
| .z p => do `(Std.Time.Modifier.z $( 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))
| .Z p => do `(Std.Time.Modifier.Z $( convertOffsetZ p))
private def convertFormatPart : FormatPart MacroM (TSyntax `term)
| .string s => `(.string $(Syntax.mkStrLit s))
| .modifier mod => do `(.modifier $( convertModifier mod))
private def syntaxNat (n : Nat) : MacroM (TSyntax `term) := do
let info MonadRef.mkInfoFromRefPos
pure { raw := Syntax.node1 info `num (Lean.Syntax.atom info (toString n)) }
private def syntaxString (n : String) : MacroM (TSyntax `term) := do
let info MonadRef.mkInfoFromRefPos
pure { raw := Syntax.node1 info `str (Lean.Syntax.atom info (toString n)) }
private def syntaxInt (n : Int) : MacroM (TSyntax `term) := do
match n with
| .ofNat n => `(Int.ofNat $(Syntax.mkNumLit <| toString n))
| .negSucc n => `(Int.negSucc $(Syntax.mkNumLit <| toString n))
private def syntaxBounded (n : Int) : MacroM (TSyntax `term) := do
`(Std.Time.Internal.Bounded.LE.ofNatWrapping $( syntaxInt n) (by decide))
private def syntaxVal (n : Int) : MacroM (TSyntax `term) := do
`(Std.Time.Internal.UnitVal.ofInt $( syntaxInt n))
private def convertOffset (offset : Std.Time.TimeZone.Offset) : MacroM (TSyntax `term) := do
`(Std.Time.TimeZone.Offset.ofSeconds $( syntaxVal offset.second.val))
private def convertTimezone (tz : Std.Time.TimeZone) : MacroM (TSyntax `term) := do
`(Std.Time.TimeZone.mk $( convertOffset tz.offset) $(Syntax.mkStrLit tz.name) $(Syntax.mkStrLit tz.abbreviation) false)
private def convertPlainDate (d : Std.Time.PlainDate) : MacroM (TSyntax `term) := do
`(Std.Time.PlainDate.ofYearMonthDayClip $( syntaxInt d.year) $( syntaxBounded d.month.val) $( syntaxBounded d.day.val))
private def convertPlainTime (d : Std.Time.PlainTime) : MacroM (TSyntax `term) := do
`(Std.Time.PlainTime.mk $( syntaxBounded d.hour.val) $( syntaxBounded d.minute.val) true, $( syntaxBounded d.second.snd.val) $( syntaxBounded d.nanosecond.val))
private def convertPlainDateTime (d : Std.Time.PlainDateTime) : MacroM (TSyntax `term) := do
`(Std.Time.PlainDateTime.mk $( convertPlainDate d.date) $( convertPlainTime d.time))
private def convertZonedDateTime (d : Std.Time.ZonedDateTime) (identifier := false) : MacroM (TSyntax `term) := do
let plain convertPlainDateTime d.toPlainDateTime
if identifier then
`(Std.Time.ZonedDateTime.ofPlainDateTime $plain <$> Std.Time.Database.defaultGetZoneRules $(Syntax.mkStrLit d.timezone.name))
else
`(Std.Time.ZonedDateTime.ofPlainDateTime $plain (Std.Time.TimeZone.ZoneRules.ofTimeZone $( convertTimezone d.timezone)))
/--
Defines a syntax for zoned datetime values. It expects a string representing a datetime with
timezone information.
Example:
`zoned("2024-10-13T15:00:00-03:00")`
-/
syntax "zoned(" str ")" : term
/--
Defines a syntax for zoned datetime values. It expects a string representing a datetime and a
timezone information as a term.
Example:
`zoned("2024-10-13T15:00:00", timezone)`
-/
syntax "zoned(" str "," term ")" : term
/--
Defines a syntax for datetime values without timezone. The input should be a string in an
ISO8601-like format.
Example:
`datetime("2024-10-13T15:00:00")`
-/
syntax "datetime(" str ")" : term
/--
Defines a syntax for date-only values. The input string represents a date in formats like "YYYY-MM-DD".
Example:
`date("2024-10-13")`
-/
syntax "date(" str ")" : term
/--
Defines a syntax for time-only values. The string should represent a time, either in 24-hour or
12-hour format.
Example:
`time("15:00:00")` or `time("03:00:00 PM")`
-/
syntax "time(" str ")" : term
/--
Defines a syntax for UTC offset values. The string should indicate the time difference from UTC
(e.g., "-03:00").
Example:
`offset("-03:00")`
-/
syntax "offset(" str ")" : term
/--
Defines a syntax for timezone identifiers. The input string should be a valid timezone name or
abbreviation.
Example:
`timezone("America/Sao_Paulo")`
-/
syntax "timezone(" str ")" : term
macro_rules
| `(zoned( $date:str )) => do
match ZonedDateTime.fromLeanDateTimeWithZoneString date.getString with
| .ok res => do return convertZonedDateTime res
| .error _ =>
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 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 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.fromSQLDateString date.getString with
| .ok res => return convertPlainDate res
| .error res => Macro.throwErrorAt date s!"error: {res}"
| `(time( $time:str )) => do
match PlainTime.fromLeanTime24Hour time.getString with
| .ok res => return convertPlainTime res
| .error res => Macro.throwErrorAt time s!"error: {res}"
| `(offset( $offset:str )) => do
match TimeZone.Offset.fromOffset offset.getString with
| .ok res => return convertOffset res
| .error res => Macro.throwErrorAt offset s!"error: {res}"
| `(timezone( $tz:str )) => do
match TimeZone.fromTimeZone tz.getString with
| .ok res => return convertTimezone res
| .error res => Macro.throwErrorAt tz s!"error: {res}"

View File

@@ -0,0 +1,113 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Date
import Std.Time.Time
import Std.Time.Zoned
import Std.Time.DateTime
import Std.Time.Format.Basic
namespace Std
namespace Time
open Lean Parser Command Std
private def convertText : Text MacroM (TSyntax `term)
| .short => `(Std.Time.Text.short)
| .full => `(Std.Time.Text.full)
| .narrow => `(Std.Time.Text.narrow)
private def convertNumber : Number MacroM (TSyntax `term)
| padding => `(Std.Time.Number.mk $(quote padding))
private def convertFraction : Fraction MacroM (TSyntax `term)
| .nano => `(Std.Time.Fraction.nano)
| .truncated digits => `(Std.Time.Fraction.truncated $(quote digits))
private def convertYear : Year MacroM (TSyntax `term)
| .twoDigit => `(Std.Time.Year.twoDigit)
| .fourDigit => `(Std.Time.Year.fourDigit)
| .extended n => `(Std.Time.Year.extended $(quote n))
private def convertZoneName : ZoneName MacroM (TSyntax `term)
| .short => `(Std.Time.ZoneName.short)
| .full => `(Std.Time.ZoneName.full)
private def convertOffsetX : OffsetX MacroM (TSyntax `term)
| .hour => `(Std.Time.OffsetX.hour)
| .hourMinute => `(Std.Time.OffsetX.hourMinute)
| .hourMinuteColon => `(Std.Time.OffsetX.hourMinuteColon)
| .hourMinuteSecond => `(Std.Time.OffsetX.hourMinuteSecond)
| .hourMinuteSecondColon => `(Std.Time.OffsetX.hourMinuteSecondColon)
private def convertOffsetO : OffsetO MacroM (TSyntax `term)
| .short => `(Std.Time.OffsetO.short)
| .full => `(Std.Time.OffsetO.full)
private def convertOffsetZ : OffsetZ MacroM (TSyntax `term)
| .hourMinute => `(Std.Time.OffsetZ.hourMinute)
| .full => `(Std.Time.OffsetZ.full)
| .hourMinuteSecondColon => `(Std.Time.OffsetZ.hourMinuteSecondColon)
private def convertModifier : Modifier MacroM (TSyntax `term)
| .G p => do `(Std.Time.Modifier.G $( convertText 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))
| .MorL p =>
match p with
| .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))
| .Qorq p =>
match p with
| .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))
| .eorc p =>
match p with
| .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))
| .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))
| .H p => do `(Std.Time.Modifier.H $( convertNumber p))
| .m p => do `(Std.Time.Modifier.m $( convertNumber p))
| .s p => do `(Std.Time.Modifier.s $( convertNumber p))
| .S p => do `(Std.Time.Modifier.S $( convertFraction p))
| .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 => `(Std.Time.Modifier.V)
| .z p => do `(Std.Time.Modifier.z $( 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))
| .Z p => do `(Std.Time.Modifier.Z $( convertOffsetZ p))
private def convertFormatPart : FormatPart MacroM (TSyntax `term)
| .string s => `(.string $(Syntax.mkStrLit s))
| .modifier mod => do `(.modifier $( convertModifier mod))
/--
Syntax for defining a date spec at compile time.
-/
syntax "datespec(" str ")" : term
macro_rules
| `(datespec( $format_string:str )) => do
let input := format_string.getString
let format : Except String (GenericFormat .any) := GenericFormat.spec input
match format with
| .ok res =>
let alts res.string.mapM convertFormatPart
let alts := alts.foldl Syntax.TSepArray.push (Syntax.TSepArray.mk #[] (sep := ","))
`([$alts,*])
| .error err =>
Macro.throwErrorAt format_string s!"cannot compile spec: {err}"

9
src/Std/Time/Time.lean Normal file
View File

@@ -0,0 +1,9 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Time.Basic
import Std.Time.Time.HourMarker
import Std.Time.Time.PlainTime

View File

@@ -0,0 +1,7 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Time.Unit.Basic

View File

@@ -0,0 +1,71 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Time.Basic
namespace Std
namespace Time
open Internal
set_option linter.all true
/--
`HourMarker` represents the two 12-hour periods of the day: `am` for hours between 12:00 AM and
11:59 AM, and `pm` for hours between 12:00 PM and 11:59 PM.
-/
inductive HourMarker
/--
Ante meridiem.
-/
| am
/--
Post meridiem.
-/
| pm
deriving Repr, BEq
namespace HourMarker
/--
`ofOrdinal` converts an `Hour.Ordinal` value to an `HourMarker`, indicating whether it is AM or PM.
-/
def ofOrdinal (time : Hour.Ordinal) : HourMarker :=
if time.val 12 then
.pm
else
.am
/--
Converts a 12-hour clock time to a 24-hour clock time based on the `HourMarker`.
-/
def toAbsolute (marker : HourMarker) (time : Bounded.LE 1 12) : Hour.Ordinal :=
match marker with
| .am => if time.val = 12 then 0 else time.expand (by decide) (by decide)
| .pm => if time.val = 12 then 12 else time.add 12 |>.emod 24 (by decide)
/--
Converts a 24-hour clock time to a 12-hour clock time with a `HourMarker`.
-/
def toRelative (hour : Hour.Ordinal) : Bounded.LE 1 12 × HourMarker :=
if h₀ : hour.val = 0 then
(12, by decide, .am)
else if h₁ : hour.val 12 then
if hour.val = 12 then
(12, by decide, .pm)
else
Int.ne_iff_lt_or_gt.mp h₀ |>.by_cases
(nomatch Int.not_le.mpr · <| hour.property.left)
(hour.val, And.intro · h₁, .am)
else
let h := Int.not_le.mp h₁
let t := hour |>.truncateBottom h |>.sub 12
(t.expandTop (by decide), .pm)
end HourMarker
end Time
end Std

View File

@@ -0,0 +1,297 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Time.Basic
namespace Std
namespace Time
open Internal
set_option linter.all true
/--
Represents a specific point in a day, including hours, minutes, seconds, and nanoseconds.
-/
structure PlainTime where
/--
`Hour` component of the `PlainTime`
-/
hour : Hour.Ordinal
/--
`Minute` component of the `PlainTime`
-/
minute : Minute.Ordinal
/--
`Second` component of the `PlainTime`
-/
second : Sigma Second.Ordinal
/--
`Nanoseconds` component of the `PlainTime`
-/
nanosecond : Nanosecond.Ordinal
deriving Repr
instance : Inhabited PlainTime where
default := 0, 0, Sigma.mk false 0, 0, by decide
instance : BEq PlainTime where
beq x y := x.hour.val == y.hour.val && x.minute == y.minute
&& x.second.snd.val == y.second.snd.val && x.nanosecond == y.nanosecond
namespace PlainTime
/--
Creates a `PlainTime` value representing midnight (00:00:00.000000000).
-/
def midnight : PlainTime :=
0, 0, true, 0, 0
/--
Creates a `PlainTime` value from the provided hours, minutes, seconds and nanoseconds components.
-/
@[inline]
def ofHourMinuteSecondsNano (hour : Hour.Ordinal) (minute : Minute.Ordinal) (second : Second.Ordinal leap) (nano : Nanosecond.Ordinal) : PlainTime :=
hour, minute, Sigma.mk leap second, nano
/--
Creates a `PlainTime` value from the provided hours, minutes, and seconds.
-/
@[inline]
def ofHourMinuteSeconds (hour : Hour.Ordinal) (minute : Minute.Ordinal) (second : Second.Ordinal leap) : PlainTime :=
ofHourMinuteSecondsNano hour minute second 0
/--
Converts a `PlainTime` value to the total number of milliseconds.
-/
def toMilliseconds (time : PlainTime) : Millisecond.Offset :=
time.hour.toOffset.toMilliseconds +
time.minute.toOffset.toMilliseconds +
time.second.snd.toOffset.toMilliseconds +
time.nanosecond.toOffset.toMilliseconds
/--
Converts a `PlainTime` value to the total number of nanoseconds.
-/
def toNanoseconds (time : PlainTime) : Nanosecond.Offset :=
time.hour.toOffset.toNanoseconds +
time.minute.toOffset.toNanoseconds +
time.second.snd.toOffset.toNanoseconds +
time.nanosecond.toOffset
/--
Converts a `PlainTime` value to the total number of seconds.
-/
def toSeconds (time : PlainTime) : Second.Offset :=
time.hour.toOffset.toSeconds +
time.minute.toOffset.toSeconds +
time.second.snd.toOffset
/--
Converts a `PlainTime` value to the total number of minutes.
-/
def toMinutes (time : PlainTime) : Minute.Offset :=
time.hour.toOffset.toMinutes +
time.minute.toOffset +
time.second.snd.toOffset.toMinutes
/--
Converts a `PlainTime` value to the total number of hours.
-/
def toHours (time : PlainTime) : Hour.Offset :=
time.hour.toOffset
/--
Creates a `PlainTime` value from a total number of nanoseconds.
-/
def ofNanoseconds (nanos : Nanosecond.Offset) : PlainTime :=
have totalSeconds := nanos.ediv 1000000000
have remainingNanos := Bounded.LE.byEmod nanos.val 1000000000 (by decide)
have hours := Bounded.LE.byEmod (totalSeconds.val / 3600) 24 (by decide)
have minutes := (Bounded.LE.byEmod totalSeconds.val 3600 (by decide)).ediv 60 (by decide)
have seconds := Bounded.LE.byEmod totalSeconds.val 60 (by decide)
let nanos := Bounded.LE.byEmod nanos.val 1000000000 (by decide)
PlainTime.mk hours minutes (Sigma.mk false seconds) nanos
/--
Creates a `PlainTime` value from a total number of millisecond.
-/
@[inline]
def ofMilliseconds (millis : Millisecond.Offset) : PlainTime :=
ofNanoseconds millis.toNanoseconds
/--
Creates a `PlainTime` value from a total number of seconds.
-/
@[inline]
def ofSeconds (secs : Second.Offset) : PlainTime :=
ofNanoseconds secs.toNanoseconds
/--
Creates a `PlainTime` value from a total number of minutes.
-/
@[inline]
def ofMinutes (secs : Minute.Offset) : PlainTime :=
ofNanoseconds secs.toNanoseconds
/--
Creates a `PlainTime` value from a total number of hours.
-/
@[inline]
def ofHours (hour : Hour.Offset) : PlainTime :=
ofNanoseconds hour.toNanoseconds
/--
Adds seconds to a `PlainTime`.
-/
@[inline]
def addSeconds (time : PlainTime) (secondsToAdd : Second.Offset) : PlainTime :=
let totalSeconds := time.toNanoseconds + secondsToAdd.toNanoseconds
ofNanoseconds totalSeconds
/--
Subtracts seconds from a `PlainTime`.
-/
@[inline]
def subSeconds (time : PlainTime) (secondsToSub : Second.Offset) : PlainTime :=
addSeconds time (-secondsToSub)
/--
Adds minutes to a `PlainTime`.
-/
@[inline]
def addMinutes (time : PlainTime) (minutesToAdd : Minute.Offset) : PlainTime :=
let total := time.toNanoseconds + minutesToAdd.toNanoseconds
ofNanoseconds total
/--
Subtracts minutes from a `PlainTime`.
-/
@[inline]
def subMinutes (time : PlainTime) (minutesToSub : Minute.Offset) : PlainTime :=
addMinutes time (-minutesToSub)
/--
Adds hours to a `PlainTime`.
-/
@[inline]
def addHours (time : PlainTime) (hoursToAdd : Hour.Offset) : PlainTime :=
let total := time.toNanoseconds + hoursToAdd.toNanoseconds
ofNanoseconds total
/--
Subtracts hours from a `PlainTime`.
-/
@[inline]
def subHours (time : PlainTime) (hoursToSub : Hour.Offset) : PlainTime :=
addHours time (-hoursToSub)
/--
Adds nanoseconds to a `PlainTime`.
-/
def addNanoseconds (time : PlainTime) (nanosToAdd : Nanosecond.Offset) : PlainTime :=
let total := time.toNanoseconds + nanosToAdd
ofNanoseconds total
/--
Subtracts nanoseconds from a `PlainTime`.
-/
def subNanoseconds (time : PlainTime) (nanosToSub : Nanosecond.Offset) : PlainTime :=
addNanoseconds time (-nanosToSub)
/--
Adds milliseconds to a `PlainTime`.
-/
def addMilliseconds (time : PlainTime) (millisToAdd : Millisecond.Offset) : PlainTime :=
let total := time.toMilliseconds + millisToAdd
ofMilliseconds total
/--
Subtracts milliseconds from a `PlainTime`.
-/
def subMilliseconds (time : PlainTime) (millisToSub : Millisecond.Offset) : PlainTime :=
addMilliseconds time (-millisToSub)
/--
Creates a new `PlainTime` by adjusting the `second` component to the given value.
-/
@[inline]
def withSeconds (pt : PlainTime) (second : Sigma Second.Ordinal) : PlainTime :=
{ pt with second := second }
/--
Creates a new `PlainTime` by adjusting the `minute` component to the given value.
-/
@[inline]
def withMinutes (pt : PlainTime) (minute : Minute.Ordinal) : PlainTime :=
{ pt with minute := minute }
/--
Creates a new `PlainTime` by adjusting the milliseconds component inside the `nano` component of its `time` to the given value.
-/
@[inline]
def withMilliseconds (pt : PlainTime) (millis : Millisecond.Ordinal) : PlainTime :=
let minorPart := pt.nanosecond.emod 1000 (by decide)
let majorPart := millis.mul_pos 1000000 (by decide) |>.addBounds minorPart
{ pt with nanosecond := majorPart |>.expandTop (by decide) }
/--
Creates a new `PlainTime` by adjusting the `nano` component to the given value.
-/
@[inline]
def withNanoseconds (pt : PlainTime) (nano : Nanosecond.Ordinal) : PlainTime :=
{ pt with nanosecond := nano }
/--
Creates a new `PlainTime` by adjusting the `hour` component to the given value.
-/
@[inline]
def withHours (pt : PlainTime) (hour : Hour.Ordinal) : PlainTime :=
{ pt with hour := hour }
/--
`Millisecond` component of the `PlainTime`
-/
@[inline]
def millisecond (pt : PlainTime) : Millisecond.Ordinal :=
pt.nanosecond.ediv 1000000 (by decide)
instance : HAdd PlainTime Nanosecond.Offset PlainTime where
hAdd := addNanoseconds
instance : HSub PlainTime Nanosecond.Offset PlainTime where
hSub := subNanoseconds
instance : HAdd PlainTime Millisecond.Offset PlainTime where
hAdd := addMilliseconds
instance : HSub PlainTime Millisecond.Offset PlainTime where
hSub := subMilliseconds
instance : HAdd PlainTime Second.Offset PlainTime where
hAdd := addSeconds
instance : HSub PlainTime Second.Offset PlainTime where
hSub := subSeconds
instance : HAdd PlainTime Minute.Offset PlainTime where
hAdd := addMinutes
instance : HSub PlainTime Minute.Offset PlainTime where
hSub := subMinutes
instance : HAdd PlainTime Hour.Offset PlainTime where
hAdd := addHours
instance : HSub PlainTime Hour.Offset PlainTime where
hSub := subHours
end PlainTime
end Time
end Std

View File

@@ -0,0 +1,329 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Internal
import Std.Time.Time.Unit.Hour
import Std.Time.Time.Unit.Minute
import Std.Time.Time.Unit.Second
import Std.Time.Time.Unit.Nanosecond
import Std.Time.Time.Unit.Millisecond
/-!
This module defines various units used for measuring, counting, and converting between hours, minutes,
second, nanosecond, millisecond and nanoseconds.
The units are organized into types representing these time-related concepts, with operations provided
to facilitate conversions and manipulations between them.
-/
namespace Std
namespace Time
open Internal
set_option linter.all true
namespace Nanosecond.Offset
/--
Converts a `Nanosecond.Offset` to a `Millisecond.Offset`.
-/
@[inline]
def toMilliseconds (offset : Nanosecond.Offset) : Millisecond.Offset :=
offset.div 1000000
/--
Converts a `Millisecond.Offset` to a `Nanosecond.Offset`.
-/
@[inline]
def ofMilliseconds (offset : Millisecond.Offset) : Nanosecond.Offset :=
offset.mul 1000000
/--
Converts a `Nanosecond.Offset` to a `Second.Offset`.
-/
@[inline]
def toSeconds (offset : Nanosecond.Offset) : Second.Offset :=
offset.div 1000000000
/--
Converts a `Second.Offset` to a `Nanosecond.Offset`.
-/
@[inline]
def ofSeconds (offset : Second.Offset) : Nanosecond.Offset :=
offset.mul 1000000000
/--
Converts a `Nanosecond.Offset` to a `Minute.Offset`.
-/
@[inline]
def toMinutes (offset : Nanosecond.Offset) : Minute.Offset :=
offset.div 60000000000
/--
Converts a `Minute.Offset` to a `Nanosecond.Offset`.
-/
@[inline]
def ofMinutes (offset : Minute.Offset) : Nanosecond.Offset :=
offset.mul 60000000000
/--
Converts a `Nanosecond.Offset` to an `Hour.Offset`.
-/
@[inline]
def toHours (offset : Nanosecond.Offset) : Hour.Offset :=
offset.div 3600000000000
/--
Converts an `Hour.Offset` to a `Nanosecond.Offset`.
-/
@[inline]
def ofHours (offset : Hour.Offset) : Nanosecond.Offset :=
offset.mul 3600000000000
end Nanosecond.Offset
namespace Millisecond.Offset
/--
Converts a `Millisecond.Offset` to a `Nanosecond.Offset`.
-/
@[inline]
def toNanoseconds (offset : Millisecond.Offset) : Nanosecond.Offset :=
offset.mul 1000000
/--
Converts a `Nanosecond.Offset` to a `Millisecond.Offset`.
-/
@[inline]
def ofNanoseconds (offset : Nanosecond.Offset) : Millisecond.Offset :=
offset.div 1000000
/--
Converts a `Millisecond.Offset` to a `Second.Offset`.
-/
@[inline]
def toSeconds (offset : Millisecond.Offset) : Second.Offset :=
offset.div 1000
/--
Converts a `Second.Offset` to a `Millisecond.Offset`.
-/
@[inline]
def ofSeconds (offset : Second.Offset) : Millisecond.Offset :=
offset.mul 1000
/--
Converts a `Millisecond.Offset` to a `Minute.Offset`.
-/
@[inline]
def toMinutes (offset : Millisecond.Offset) : Minute.Offset :=
offset.div 60000
/--
Converts a `Minute.Offset` to a `Millisecond.Offset`.
-/
@[inline]
def ofMinutes (offset : Minute.Offset) : Millisecond.Offset :=
offset.mul 60000
/--
Converts a `Millisecond.Offset` to an `Hour.Offset`.
-/
@[inline]
def toHours (offset : Millisecond.Offset) : Hour.Offset :=
offset.div 3600000
/--
Converts an `Hour.Offset` to a `Millisecond.Offset`.
-/
@[inline]
def ofHours (offset : Hour.Offset) : Millisecond.Offset :=
offset.mul 3600000
end Millisecond.Offset
namespace Second.Offset
/--
Converts a `Second.Offset` to a `Nanosecond.Offset`.
-/
@[inline]
def toNanoseconds (offset : Second.Offset) : Nanosecond.Offset :=
offset.mul 1000000000
/--
Converts a `Nanosecond.Offset` to a `Second.Offset`.
-/
@[inline]
def ofNanoseconds (offset : Nanosecond.Offset) : Second.Offset :=
offset.div 1000000000
/--
Converts a `Second.Offset` to a `Millisecond.Offset`.
-/
@[inline]
def toMilliseconds (offset : Second.Offset) : Millisecond.Offset :=
offset.mul 1000
/--
Converts a `Millisecond.Offset` to a `Second.Offset`.
-/
@[inline]
def ofMilliseconds (offset : Millisecond.Offset) : Second.Offset :=
offset.div 1000
/--
Converts a `Second.Offset` to a `Minute.Offset`.
-/
@[inline]
def toMinutes (offset : Second.Offset) : Minute.Offset :=
offset.div 60
/--
Converts a `Minute.Offset` to a `Second.Offset`.
-/
@[inline]
def ofMinutes (offset : Minute.Offset) : Second.Offset :=
offset.mul 60
/--
Converts a `Second.Offset` to an `Hour.Offset`.
-/
@[inline]
def toHours (offset : Second.Offset) : Hour.Offset :=
offset.div 3600
/--
Converts an `Hour.Offset` to a `Second.Offset`.
-/
@[inline]
def ofHours (offset : Hour.Offset) : Second.Offset :=
offset.mul 3600
end Second.Offset
namespace Minute.Offset
/--
Converts a `Minute.Offset` to a `Nanosecond.Offset`.
-/
@[inline]
def toNanoseconds (offset : Minute.Offset) : Nanosecond.Offset :=
offset.mul 60000000000
/--
Converts a `Nanosecond.Offset` to a `Minute.Offset`.
-/
@[inline]
def ofNanoseconds (offset : Nanosecond.Offset) : Minute.Offset :=
offset.div 60000000000
/--
Converts a `Minute.Offset` to a `Millisecond.Offset`.
-/
@[inline]
def toMilliseconds (offset : Minute.Offset) : Millisecond.Offset :=
offset.mul 60000
/--
Converts a `Millisecond.Offset` to a `Minute.Offset`.
-/
@[inline]
def ofMilliseconds (offset : Millisecond.Offset) : Minute.Offset :=
offset.div 60000
/--
Converts a `Minute.Offset` to a `Second.Offset`.
-/
@[inline]
def toSeconds (offset : Minute.Offset) : Second.Offset :=
offset.mul 60
/--
Converts a `Second.Offset` to a `Minute.Offset`.
-/
@[inline]
def ofSeconds (offset : Second.Offset) : Minute.Offset :=
offset.div 60
/--
Converts a `Minute.Offset` to an `Hour.Offset`.
-/
@[inline]
def toHours (offset : Minute.Offset) : Hour.Offset :=
offset.div 60
/--
Converts an `Hour.Offset` to a `Minute.Offset`.
-/
@[inline]
def ofHours (offset : Hour.Offset) : Minute.Offset :=
offset.mul 60
end Minute.Offset
namespace Hour.Offset
/--
Converts an `Hour.Offset` to a `Nanosecond.Offset`.
-/
@[inline]
def toNanoseconds (offset : Hour.Offset) : Nanosecond.Offset :=
offset.mul 3600000000000
/--
Converts a `Nanosecond.Offset` to an `Hour.Offset`.
-/
@[inline]
def ofNanoseconds (offset : Nanosecond.Offset) : Hour.Offset :=
offset.div 3600000000000
/--
Converts an `Hour.Offset` to a `Millisecond.Offset`.
-/
@[inline]
def toMilliseconds (offset : Hour.Offset) : Millisecond.Offset :=
offset.mul 3600000
/--
Converts a `Millisecond.Offset` to an `Hour.Offset`.
-/
@[inline]
def ofMilliseconds (offset : Millisecond.Offset) : Hour.Offset :=
offset.div 3600000
/--
Converts an `Hour.Offset` to a `Second.Offset`.
-/
@[inline]
def toSeconds (offset : Hour.Offset) : Second.Offset :=
offset.mul 3600
/--
Converts a `Second.Offset` to an `Hour.Offset`.
-/
@[inline]
def ofSeconds (offset : Second.Offset) : Hour.Offset :=
offset.div 3600
/--
Converts an `Hour.Offset` to a `Minute.Offset`.
-/
@[inline]
def toMinutes (offset : Hour.Offset) : Minute.Offset :=
offset.mul 60
/--
Converts a `Minute.Offset` to an `Hour.Offset`.
-/
@[inline]
def ofMinutes (offset : Minute.Offset) : Hour.Offset :=
offset.div 60
end Hour.Offset
end Time
end Std

View File

@@ -0,0 +1,111 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Internal.Rat
import Std.Time.Internal
import Std.Time.Time.Unit.Minute
import Std.Time.Time.Unit.Second
namespace Std
namespace Time
namespace Hour
open Std.Internal
open Internal
set_option linter.all true
/--
`Ordinal` represents a bounded value for hours, ranging from 0 to 23.
-/
def Ordinal := Bounded.LE 0 23
deriving Repr, BEq, LE, LT
instance : OfNat Ordinal n :=
inferInstanceAs (OfNat (Bounded.LE 0 (0 + (23 : Nat))) n)
instance : Inhabited Ordinal where
default := 0
instance {x y : Ordinal} : Decidable (x y) :=
inferInstanceAs (Decidable (x.val y.val))
instance {x y : Ordinal} : Decidable (x < y) :=
inferInstanceAs (Decidable (x.val < y.val))
/--
`Offset` represents an offset in hours, defined as an `Int`. This can be used to express durations
or differences in hours.
-/
def Offset : Type := UnitVal 3600
deriving Repr, BEq, Inhabited, Add, Sub, Neg, ToString
instance : OfNat Offset n :=
UnitVal.ofNat n
namespace Ordinal
/--
Creates an `Ordinal` from an integer, ensuring the value is within bounds.
-/
@[inline]
def ofInt (data : Int) (h : 0 data data 23) : Ordinal :=
Bounded.LE.mk data h
/--
Converts an `Ordinal` into a relative hour in the range of 1 to 12.
-/
def toRelative (ordinal : Ordinal) : Bounded.LE 1 12 :=
(ordinal.add 11).emod 12 (by decide) |>.add 1
/--
Converts an Ordinal into a 1-based hour representation within the range of 1 to 24.
-/
def shiftTo1BasedHour (ordinal : Ordinal) : Bounded.LE 1 24 :=
if h : ordinal.val < 1
then Internal.Bounded.LE.ofNatWrapping 24 (by decide)
else ordinal.truncateBottom (Int.not_lt.mp h) |>.expandTop (by decide)
/--
Creates an `Ordinal` from a natural number, ensuring the value is within the valid bounds for hours.
-/
@[inline]
def ofNat (data : Nat) (h : data 23) : Ordinal :=
Bounded.LE.ofNat data h
/--
Creates an `Ordinal` from a `Fin` value.
-/
@[inline]
def ofFin (data : Fin 24) : Ordinal :=
Bounded.LE.ofFin data
/--
Converts an `Ordinal` to an `Offset`, which represents the duration in hours as an integer value.
-/
@[inline]
def toOffset (ordinal : Ordinal) : Offset :=
UnitVal.ofInt ordinal.val
end Ordinal
namespace Offset
/--
Creates an `Offset` from a natural number.
-/
@[inline]
def ofNat (data : Nat) : Offset :=
UnitVal.ofInt data
/--
Creates an `Offset` from an integer.
-/
@[inline]
def ofInt (data : Int) : Offset :=
UnitVal.ofInt data
end Offset
end Hour
end Time
end Std

View File

@@ -0,0 +1,96 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Internal.Rat
import Std.Time.Internal
import Std.Time.Time.Unit.Nanosecond
namespace Std
namespace Time
namespace Millisecond
open Std.Internal
open Internal
set_option linter.all true
/--
`Ordinal` represents a bounded value for milliseconds, ranging from 0 to 999 milliseconds.
-/
def Ordinal := Bounded.LE 0 999
deriving Repr, BEq, LE, LT
instance : OfNat Ordinal n :=
inferInstanceAs (OfNat (Bounded.LE 0 (0 + (999 : Nat))) n)
instance : Inhabited Ordinal where
default := 0
instance {x y : Ordinal} : Decidable (x y) :=
inferInstanceAs (Decidable (x.val y.val))
instance {x y : Ordinal} : Decidable (x < y) :=
inferInstanceAs (Decidable (x.val < y.val))
/--
`Offset` represents a duration offset in milliseconds.
-/
def Offset : Type := UnitVal (1 / 1000)
deriving Repr, BEq, Inhabited, Add, Sub, Neg, LE, LT, ToString
instance : OfNat Offset n :=
UnitVal.ofNat n
namespace Offset
/--
Creates an `Offset` from a natural number.
-/
@[inline]
def ofNat (data : Nat) : Offset :=
UnitVal.ofInt data
/--
Creates an `Offset` from an integer.
-/
@[inline]
def ofInt (data : Int) : Offset :=
UnitVal.ofInt data
end Offset
namespace Ordinal
/--
Creates an `Ordinal` from an integer, ensuring the value is within bounds.
-/
@[inline]
def ofInt (data : Int) (h : 0 data data 999) : Ordinal :=
Bounded.LE.mk data h
/--
Creates an `Ordinal` from a natural number, ensuring the value is within bounds.
-/
@[inline]
def ofNat (data : Nat) (h : data 999) : Ordinal :=
Bounded.LE.ofNat data h
/--
Creates an `Ordinal` from a `Fin`, ensuring the value is within bounds.
-/
@[inline]
def ofFin (data : Fin 1000) : Ordinal :=
Bounded.LE.ofFin data
/--
Converts an `Ordinal` to an `Offset`.
-/
@[inline]
def toOffset (ordinal : Ordinal) : Offset :=
UnitVal.ofInt ordinal.val
end Ordinal
end Millisecond
end Time
end Std

View File

@@ -0,0 +1,96 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Internal.Rat
import Std.Time.Internal
import Std.Time.Time.Unit.Second
namespace Std
namespace Time
namespace Minute
open Std.Internal
open Internal
set_option linter.all true
/--
`Ordinal` represents a bounded value for minutes, ranging from 0 to 59. This is useful for representing the minute component of a time.
-/
def Ordinal := Bounded.LE 0 59
deriving Repr, BEq, LE, LT
instance : OfNat Ordinal n :=
inferInstanceAs (OfNat (Bounded.LE 0 (0 + (59 : Nat))) n)
instance : Inhabited Ordinal where
default := 0
instance {x y : Ordinal} : Decidable (x y) :=
inferInstanceAs (Decidable (x.val y.val))
instance {x y : Ordinal} : Decidable (x < y) :=
inferInstanceAs (Decidable (x.val < y.val))
/--
`Offset` represents a duration offset in minutes.
-/
def Offset : Type := UnitVal 60
deriving Repr, BEq, Inhabited, Add, Sub, Neg, ToString
instance : OfNat Offset n :=
UnitVal.ofInt <| Int.ofNat n
namespace Ordinal
/--
Creates an `Ordinal` from an integer, ensuring the value is within bounds.
-/
@[inline]
def ofInt (data : Int) (h : 0 data data 59) : Ordinal :=
Bounded.LE.mk data h
/--
Creates an `Ordinal` from a natural number, ensuring the value is within bounds.
-/
@[inline]
def ofNat (data : Nat) (h : data 59) : Ordinal :=
Bounded.LE.ofNat data h
/--
Creates an `Ordinal` from a `Fin`, ensuring the value is within bounds.
-/
@[inline]
def ofFin (data : Fin 60) : Ordinal :=
Bounded.LE.ofFin data
/--
Converts an `Ordinal` to an `Offset`.
-/
@[inline]
def toOffset (ordinal : Ordinal) : Offset :=
UnitVal.ofInt ordinal.val
end Ordinal
namespace Offset
/--
Creates an `Offset` from a natural number.
-/
@[inline]
def ofNat (data : Nat) : Offset :=
UnitVal.ofInt data
/--
Creates an `Offset` from an integer.
-/
@[inline]
def ofInt (data : Int) : Offset :=
UnitVal.ofInt data
end Offset
end Minute
end Time
end Std

View File

@@ -0,0 +1,124 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Internal.Rat
import Std.Time.Internal
namespace Std
namespace Time
namespace Nanosecond
open Std.Internal
open Internal
set_option linter.all true
/--
`Ordinal` represents a nanosecond value that is bounded between 0 and 999,999,999 nanoseconds.
-/
def Ordinal := Bounded.LE 0 999999999
deriving Repr, BEq, LE, LT
instance : OfNat Ordinal n where
ofNat := Bounded.LE.ofFin (Fin.ofNat n)
instance : Inhabited Ordinal where
default := 0
instance {x y : Ordinal} : Decidable (x y) :=
inferInstanceAs (Decidable (x.val y.val))
instance {x y : Ordinal} : Decidable (x < y) :=
inferInstanceAs (Decidable (x.val < y.val))
/--
`Offset` represents a time offset in nanoseconds.
-/
def Offset : Type := UnitVal (1 / 1000000000)
deriving Repr, BEq, Inhabited, Add, Sub, Neg, LE, LT, ToString
instance { x y : Offset } : Decidable (x y) :=
inferInstanceAs (Decidable (x.val y.val))
instance : OfNat Offset n :=
UnitVal.ofNat n
namespace Offset
/--
Creates an `Offset` from a natural number.
-/
@[inline]
def ofNat (data : Nat) : Offset :=
UnitVal.ofInt data
/--
Creates an `Offset` from an integer.
-/
@[inline]
def ofInt (data : Int) : Offset :=
UnitVal.ofInt data
end Offset
/--
`Span` represents a bounded value for nanoseconds, ranging between -999999999 and 999999999.
This can be used for operations that involve differences or adjustments within this range.
-/
def Span := Bounded.LE (-999999999) 999999999
deriving Repr, BEq, LE, LT
instance : Inhabited Span where default := Bounded.LE.mk 0 (by decide)
namespace Span
/--
Creates a new `Offset` out of a `Span`.
-/
def toOffset (span : Span) : Offset :=
UnitVal.ofInt span.val
end Span
namespace Ordinal
/--
`Ordinal` represents a bounded value for nanoseconds in a day, which ranges between 0 and 86400000000000.
-/
def OfDay := Bounded.LE 0 86400000000000
deriving Repr, BEq, LE, LT
/--
Creates an `Ordinal` from an integer, ensuring the value is within bounds.
-/
@[inline]
def ofInt (data : Int) (h : 0 data data 999999999) : Ordinal :=
Bounded.LE.mk data h
/--
Creates an `Ordinal` from a natural number, ensuring the value is within bounds.
-/
@[inline]
def ofNat (data : Nat) (h : data 999999999) : Ordinal :=
Bounded.LE.ofNat data h
/--
Creates an `Ordinal` from a `Fin`, ensuring the value is within bounds.
-/
@[inline]
def ofFin (data : Fin 1000000000) : Ordinal :=
Bounded.LE.ofFin data
/--
Converts an `Ordinal` to an `Offset`.
-/
@[inline]
def toOffset (ordinal : Ordinal) : Offset :=
UnitVal.ofInt ordinal.val
end Ordinal
end Nanosecond
end Time
end Std

View File

@@ -0,0 +1,110 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Internal.Rat
import Std.Time.Time.Unit.Nanosecond
namespace Std
namespace Time
namespace Second
open Std.Internal
open Internal
set_option linter.all true
/--
`Ordinal` represents a bounded value for second, which ranges between 0 and 59 or 60. This accounts
for potential leap second.
-/
def Ordinal (leap : Bool) := Bounded.LE 0 (.ofNat (if leap then 60 else 59))
instance : BEq (Ordinal leap) where
beq x y := BEq.beq x.val y.val
instance : LE (Ordinal leap) where
le x y := LE.le x.val y.val
instance : LT (Ordinal leap) where
lt x y := LT.lt x.val y.val
instance : Repr (Ordinal l) where
reprPrec r := reprPrec r.val
instance : OfNat (Ordinal leap) n := by
have inst := inferInstanceAs (OfNat (Bounded.LE 0 (0 + (59 : Nat))) n)
cases leap
· exact inst
· exact inst.ofNat.expandTop (by decide)
instance {x y : Ordinal l} : Decidable (x y) :=
inferInstanceAs (Decidable (x.val y.val))
instance {x y : Ordinal l} : Decidable (x < y) :=
inferInstanceAs (Decidable (x.val < y.val))
/--
`Offset` represents an offset in seconds. It is defined as an `Int`.
-/
def Offset : Type := UnitVal 1
deriving Repr, BEq, Inhabited, Add, Sub, Neg, LE, LT, ToString
instance : OfNat Offset n :=
UnitVal.ofNat n
namespace Offset
/--
Creates an `Second.Offset` from a natural number.
-/
@[inline]
def ofNat (data : Nat) : Second.Offset :=
UnitVal.ofInt data
/--
Creates an `Second.Offset` from an integer.
-/
@[inline]
def ofInt (data : Int) : Second.Offset :=
UnitVal.ofInt data
end Offset
namespace Ordinal
/--
Creates an `Ordinal` from an integer, ensuring the value is within bounds.
-/
@[inline]
def ofInt (data : Int) (h : 0 data data Int.ofNat (if leap then 60 else 59)) : Ordinal leap :=
Bounded.LE.mk data h
/--
Creates an `Ordinal` from a natural number, ensuring the value is within bounds.
-/
@[inline]
def ofNat (data : Nat) (h : data (if leap then 60 else 59)) : Ordinal leap :=
Bounded.LE.ofNat data h
/--
Creates an `Ordinal` from a `Fin`, ensuring the value is within bounds.
-/
@[inline]
def ofFin (data : Fin (if leap then 61 else 60)) : Ordinal leap :=
match leap with
| true => Bounded.LE.ofFin data
| false => Bounded.LE.ofFin data
/--
Converts an `Ordinal` to an `Second.Offset`.
-/
@[inline]
def toOffset (ordinal : Ordinal leap) : Second.Offset :=
UnitVal.ofInt ordinal.val
end Ordinal
end Second
end Time
end Std

180
src/Std/Time/Zoned.lean Normal file
View File

@@ -0,0 +1,180 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Zoned.DateTime
import Std.Time.Zoned.ZoneRules
import Std.Time.Zoned.ZonedDateTime
import Std.Time.Zoned.Database
namespace Std
namespace Time
set_option linter.all true
namespace PlainDateTime
/--
Get the current time.
-/
@[inline]
def now : IO PlainDateTime := do
let tm Timestamp.now
let rules Database.defaultGetLocalZoneRules
let ltt := rules.findLocalTimeTypeForTimestamp tm
return PlainDateTime.ofTimestampAssumingUTC tm |>.addSeconds ltt.getTimeZone.toSeconds
end PlainDateTime
namespace PlainDate
/--
Get the current date.
-/
@[inline]
def now : IO PlainDate :=
PlainDateTime.date <$> PlainDateTime.now
end PlainDate
namespace PlainTime
/--
Get the current time.
-/
@[inline]
def now : IO PlainTime :=
PlainDateTime.time <$> PlainDateTime.now
end PlainTime
namespace DateTime
/--
Converts a `PlainDate` with a `TimeZone` to a `DateTime`
-/
@[inline]
def ofPlainDate (pd : PlainDate) (tz : TimeZone) : DateTime tz :=
DateTime.ofTimestamp (Timestamp.ofPlainDateAssumingUTC pd) tz
/--
Converts a `DateTime` to a `PlainDate`
-/
@[inline]
def toPlainDate (dt : DateTime tz) : PlainDate :=
Timestamp.toPlainDateAssumingUTC dt.toTimestamp
/--
Converts a `DateTime` to a `PlainTime`
-/
@[inline]
def toPlainTime (dt : DateTime tz) : PlainTime :=
dt.date.get.time
end DateTime
namespace DateTime
/--
Gets the current `ZonedDateTime`.
-/
@[inline]
def now : IO (DateTime tz) := do
let tm Timestamp.now
return DateTime.ofTimestamp tm tz
end DateTime
namespace ZonedDateTime
/--
Gets the current `ZonedDateTime`.
-/
@[inline]
def now : IO ZonedDateTime := do
let tm Timestamp.now
let rules Database.defaultGetLocalZoneRules
return ZonedDateTime.ofTimestamp tm rules
/--
Gets the current `ZonedDateTime` using the identifier of a time zone.
-/
@[inline]
def nowAt (id : String) : IO ZonedDateTime := do
let tm Timestamp.now
let rules Database.defaultGetZoneRules id
return ZonedDateTime.ofTimestamp tm rules
/--
Converts a `PlainDate` to a `ZonedDateTime`.
-/
@[inline]
def ofPlainDate (pd : PlainDate) (zr : TimeZone.ZoneRules) : ZonedDateTime :=
ZonedDateTime.ofPlainDateTime (pd.atTime PlainTime.midnight) zr
/--
Converts a `PlainDate` to a `ZonedDateTime` using `TimeZone`.
-/
@[inline]
def ofPlainDateWithZone (pd : PlainDate) (zr : TimeZone) : ZonedDateTime :=
ZonedDateTime.ofPlainDateTime (pd.atTime PlainTime.midnight) (TimeZone.ZoneRules.ofTimeZone zr)
/--
Converts a `ZonedDateTime` to a `PlainDate`
-/
@[inline]
def toPlainDate (dt : ZonedDateTime) : PlainDate :=
dt.toPlainDateTime.date
/--
Converts a `ZonedDateTime` to a `PlainTime`
-/
@[inline]
def toPlainTime (dt : ZonedDateTime) : PlainTime :=
dt.toPlainDateTime.time
/--
Creates a new `ZonedDateTime` out of a `PlainDateTime` and a time zone identifier.
-/
@[inline]
def of (pdt : PlainDateTime) (id : String) : IO ZonedDateTime := do
let zr Database.defaultGetZoneRules id
return ZonedDateTime.ofPlainDateTime pdt zr
end ZonedDateTime
namespace PlainDateTime
/--
Converts a `PlainDateTime` to a `Timestamp` using the `ZoneRules`.
-/
@[inline]
def toTimestamp (pdt : PlainDateTime) (zr : TimeZone.ZoneRules) : Timestamp :=
ZonedDateTime.ofPlainDateTime pdt zr |>.toTimestamp
/--
Converts a `PlainDateTime` to a `Timestamp` using the `TimeZone`.
-/
@[inline]
def toTimestampWithZone (pdt : PlainDateTime) (tz : TimeZone) : Timestamp :=
ZonedDateTime.ofPlainDateTimeWithZone pdt tz |>.toTimestamp
end PlainDateTime
namespace PlainDate
/--
Converts a `PlainDate` to a `Timestamp` using the `ZoneRules`.
-/
@[inline]
def toTimestamp (dt : PlainDate) (zr : TimeZone.ZoneRules) : Timestamp :=
ZonedDateTime.ofPlainDate dt zr |>.toTimestamp
/--
Converts a `PlainDate` to a `Timestamp` using the `TimeZone`.
-/
@[inline]
def toTimestampWithZone (dt : PlainDate) (tz : TimeZone) : Timestamp :=
ZonedDateTime.ofPlainDateWithZone dt tz |>.toTimestamp
end PlainDate

View File

@@ -0,0 +1,38 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Zoned.ZonedDateTime
import Std.Time.Zoned.Database.Basic
import Std.Time.Zoned.Database.TZdb
import Std.Time.Zoned.Database.Windows
import Init.System.Platform
namespace Std
namespace Time
namespace Database
open TimeZone.ZoneRules
set_option linter.all true
/--
Gets the zone rules for a specific time zone identifier, handling Windows and non-Windows platforms.
In windows it uses the current `icu.h` in Windows SDK. If it's linux or macos then it will use the `tzdata`
files.
-/
def defaultGetZoneRules : String IO TimeZone.ZoneRules :=
if System.Platform.isWindows
then getZoneRules WindowsDb.default
else getZoneRules TZdb.default
/--
Gets the local zone rules, accounting for platform differences.
In windows it uses the current `icu.h` in Windows SDK. If it's linux or macos then it will use the `tzdata`
files.
-/
def defaultGetLocalZoneRules : IO TimeZone.ZoneRules :=
if System.Platform.isWindows
then getLocalZoneRules WindowsDb.default
else getLocalZoneRules TZdb.default

View File

@@ -0,0 +1,114 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Zoned.ZoneRules
import Std.Time.Zoned.Database.TzIf
namespace Std
namespace Time
set_option linter.all true
/--
A timezone database from which we can read the `ZoneRules` of some area by it's id.
-/
protected class Database (α : Type) where
/--
Retrieves the zone rules information (`ZoneRules`) for a given area at a specific point in time.
-/
getZoneRules : α String IO TimeZone.ZoneRules
/--
Retrieves the local zone rules information (`ZoneRules`) at a given timestamp.
-/
getLocalZoneRules : α IO TimeZone.ZoneRules
namespace TimeZone
/--
Converts a Boolean value to a corresponding `StdWall` type.
-/
def convertWall : Bool StdWall
| true => .standard
| false => .wall
/--
Converts a Boolean value to a corresponding `UTLocal` type.
-/
def convertUt : Bool UTLocal
| true => .ut
| false => .local
/--
Converts a given time index into a `LocalTimeType` by using a time zone (`tz`) and its identifier.
-/
def convertLocalTimeType (index : Nat) (tz : TZif.TZifV1) (identifier : String) : Option LocalTimeType := do
let localType tz.localTimeTypes.get? index
let offset := Offset.ofSeconds <| .ofInt localType.gmtOffset
let abbreviation tz.abbreviations.getD index (offset.toIsoString true)
let wallflag := convertWall (tz.stdWallIndicators.getD index true)
let utLocal := convertUt (tz.utLocalIndicators.getD index true)
return {
gmtOffset := offset
isDst := localType.isDst
abbreviation
wall := wallflag
utLocal
identifier
}
/--
Converts a transition.
-/
def convertTransition (times: Array LocalTimeType) (index : Nat) (tz : TZif.TZifV1) : Option Transition := do
let time := tz.transitionTimes.get! index
let time := Second.Offset.ofInt time
let indice := tz.transitionIndices.get! index
return { time, localTimeType := times.get! indice.toNat }
/--
Converts a `TZif.TZifV1` structure to a `ZoneRules` structure.
-/
def convertTZifV1 (tz : TZif.TZifV1) (id : String) : Except String ZoneRules := do
let mut times : Array LocalTimeType := #[]
for i in [0:tz.header.typecnt.toNat] do
if let some result := convertLocalTimeType i tz id
then times := times.push result
else .error s!"cannot convert local time {i} of the file"
let mut transitions := #[]
for i in [0:tz.transitionTimes.size] do
if let some result := convertTransition times i tz
then transitions := transitions.push result
else .error s!"cannot convert transition {i} of the file"
-- Local time for timestamps before the first transition is specified by the first time
-- type (time type 0).
let initialLocalTimeType
if let some res := convertLocalTimeType 0 tz id
then .ok res
else .error s!"empty transitions for {id}"
.ok { transitions, initialLocalTimeType }
/--
Converts a `TZif.TZifV2` structure to a `ZoneRules` structure.
-/
def convertTZifV2 (tz : TZif.TZifV2) (id : String) : Except String ZoneRules := do
convertTZifV1 tz.toTZifV1 id
/--
Converts a `TZif.TZif` structure to a `ZoneRules` structure.
-/
def convertTZif (tz : TZif.TZif) (id : String) : Except String ZoneRules := do
if let some v2 := tz.v2
then convertTZifV2 v2 id
else convertTZifV1 tz.v1 id

View File

@@ -0,0 +1,92 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.DateTime
import Std.Time.Zoned.TimeZone
import Std.Time.Zoned.ZoneRules
import Std.Time.Zoned.Database.Basic
namespace Std
namespace Time
namespace Database
set_option linter.all true
/--
Represents a Time Zone Database (TZdb) configuration with paths to local and general timezone data.
-/
structure TZdb where
/--
The path to the local timezone file. This is typically a symlink to a file within the timezone
database that corresponds to the current local time zone.
-/
localPath : System.FilePath := "/etc/localtime"
/--
The path to the directory containing all available time zone files. These files define various
time zones and their rules.
-/
zonesPath : System.FilePath := "/usr/share/zoneinfo/"
namespace TZdb
open TimeZone
/--
Returns a default `TZdb` instance with common timezone data paths for most Linux distributions and macOS.
-/
@[inline]
def default : TZdb := {}
/--
Parses binary timezone data into zone rules based on a given timezone ID.
-/
def parseTZif (bin : ByteArray) (id : String) : Except String ZoneRules := do
let database TZif.parse.run bin
convertTZif database id
/--
Reads a TZif file from disk and retrieves the zone rules for the specified timezone ID.
-/
def parseTZIfFromDisk (path : System.FilePath) (id : String) : IO ZoneRules := do
let binary try IO.FS.readBinFile path catch _ => throw <| IO.userError s!"cannot find {id} in the local timezone database"
IO.ofExcept (parseTZif binary id)
/--
Extracts a timezone ID from a file path.
-/
def idFromPath (path : System.FilePath) : Option String := do
let res := path.components.toArray
let last res.get? (res.size - 1)
let last₁ res.get? (res.size - 2)
if last₁ = some "zoneinfo"
then last
else last₁ ++ "/" ++ last
/--
Retrieves the timezone rules from the local timezone data file.
-/
def localRules (path : System.FilePath) : IO ZoneRules := do
let localTimePath
try
IO.Process.run { cmd := "readlink", args := #["-f", path.toString] }
catch _ =>
throw <| IO.userError "cannot find the local timezone database"
if let some id := idFromPath localTimePath
then parseTZIfFromDisk path id
else throw (IO.userError "cannot read the id of the path.")
/--
Reads timezone rules from disk based on the provided file path and timezone ID.
-/
def readRulesFromDisk (path : System.FilePath) (id : String) : IO ZoneRules := do
parseTZIfFromDisk (System.FilePath.join path id) id
instance : Std.Time.Database TZdb where
getLocalZoneRules db := localRules db.localPath
getZoneRules db id := readRulesFromDisk db.zonesPath id

View File

@@ -0,0 +1,328 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Init.Data.Range
import Std.Internal.Parsec
import Std.Internal.Parsec.ByteArray
-- Based on: https://www.rfc-editor.org/rfc/rfc8536.html
namespace Std
namespace Time
namespace TimeZone
namespace TZif
open Std.Internal.Parsec Std.Internal.Parsec.ByteArray
set_option linter.all true
private abbrev Int32 := Int
private abbrev Int64 := Int
/--
Represents the header of a TZif file, containing metadata about the file's structure.
-/
structure Header where
/--
The version of the TZif file format.
-/
version : UInt8
/--
The count of UT local indicators in the file.
-/
isutcnt : UInt32
/--
The count of standard/wall indicators in the file.
-/
isstdcnt : UInt32
/--
The number of leap second records.
-/
leapcnt : UInt32
/--
The number of transition times in the file.
-/
timecnt : UInt32
/--
The number of local time types in the file.
-/
typecnt : UInt32
/--
The total number of characters used in abbreviations.
-/
charcnt : UInt32
deriving Repr, Inhabited
/--
Represents the local time type information, including offset and daylight saving details.
-/
structure LocalTimeType where
/--
The GMT offset in seconds for this local time type.
-/
gmtOffset : Int32
/--
Indicates if this local time type observes daylight saving time.
-/
isDst : Bool
/--
The index into the abbreviation string table for this time type.
-/
abbreviationIndex : UInt8
deriving Repr, Inhabited
/--
Represents a leap second record, including the transition time and the correction applied.
-/
structure LeapSecond where
/--
The transition time of the leap second event.
-/
transitionTime : Int64
/--
The correction applied during the leap second event in seconds.
-/
correction : Int64
deriving Repr, Inhabited
/--
Represents version 1 of the TZif format.
-/
structure TZifV1 where
/--
The header information of the TZif file.
-/
header : Header
/--
The array of transition times in seconds since the epoch.
-/
transitionTimes : Array Int32
/--
The array of local time type indices corresponding to each transition time.
-/
transitionIndices : Array UInt8
/--
The array of local time type structures.
-/
localTimeTypes : Array LocalTimeType
/--
The array of abbreviation strings used by local time types.
-/
abbreviations : Array String
/--
The array of leap second records.
-/
leapSeconds : Array LeapSecond
/--
The array indicating whether each transition time uses wall clock time or standard time.
-/
stdWallIndicators : Array Bool
/--
The array indicating whether each transition time uses universal time or local time.
-/
utLocalIndicators : Array Bool
deriving Repr, Inhabited
/--
Represents version 2 of the TZif format, extending TZifV1 with an optional footer.
-/
structure TZifV2 extends TZifV1 where
/--
An optional footer for additional metadata in version 2.
-/
footer : Option String
deriving Repr, Inhabited
/--
Represents a TZif file, which can be either version 1 or version 2.
-/
structure TZif where
/--
The data for version 1 of the TZif file.
-/
v1 : TZifV1
/--
Optionally, the data for version 2 of the TZif file.
-/
v2 : Option TZifV2
deriving Repr, Inhabited
private def toUInt32 (bs : ByteArray) : UInt32 :=
assert! bs.size == 4
(bs.get! 0).toUInt32 <<< 0x18 |||
(bs.get! 1).toUInt32 <<< 0x10 |||
(bs.get! 2).toUInt32 <<< 0x8 |||
(bs.get! 3).toUInt32
private def toInt32 (bs : ByteArray) : Int32 :=
let n := toUInt32 bs |>.toNat
if n < (1 <<< 31)
then Int.ofNat n
else Int.negOfNat (UInt32.size - n)
private def toInt64 (bs : ByteArray) : Int64 :=
let n := ByteArray.toUInt64BE! bs |>.toNat
if n < (1 <<< 63)
then Int.ofNat n
else Int.negOfNat (UInt64.size - n)
private def manyN (n : Nat) (p : Parser α) : Parser (Array α) := do
let mut result := #[]
for _ in [0:n] do
let x p
result := result.push x
return result
private def pu64 : Parser UInt64 := ByteArray.toUInt64LE! <$> take 8
private def pi64 : Parser Int64 := toInt64 <$> take 8
private def pu32 : Parser UInt32 := toUInt32 <$> take 4
private def pi32 : Parser Int32 := toInt32 <$> take 4
private def pu8 : Parser UInt8 := any
private def pbool : Parser Bool := (· != 0) <$> pu8
private def parseHeader : Parser Header :=
Header.mk
<$> (pstring "TZif" *> pu8)
<*> (take 15 *> pu32)
<*> pu32
<*> pu32
<*> pu32
<*> pu32
<*> pu32
private def parseLocalTimeType : Parser LocalTimeType :=
LocalTimeType.mk
<$> pi32
<*> pbool
<*> pu8
private def parseLeapSecond (p : Parser Int) : Parser LeapSecond :=
LeapSecond.mk
<$> p
<*> pi32
private def parseTransitionTimes (size : Parser Int32) (n : UInt32) : Parser (Array Int32) :=
manyN (n.toNat) size
private def parseTransitionIndices (n : UInt32) : Parser (Array UInt8) :=
manyN (n.toNat) pu8
private def parseLocalTimeTypes (n : UInt32) : Parser (Array LocalTimeType) :=
manyN (n.toNat) parseLocalTimeType
private def parseAbbreviations (times : Array LocalTimeType) (n : UInt32) : Parser (Array String) := do
let mut strings := #[]
let mut current := ""
let mut chars manyN n.toNat pu8
for time in times do
for indx in [time.abbreviationIndex.toNat:n.toNat] do
let char := chars.get! indx
if char = 0 then
strings := strings.push current
current := ""
break
else
current := current.push (Char.ofUInt8 char)
return strings
private def parseLeapSeconds (size : Parser Int) (n : UInt32) : Parser (Array LeapSecond) :=
manyN (n.toNat) (parseLeapSecond size)
private def parseIndicators (n : UInt32) : Parser (Array Bool) :=
manyN (n.toNat) pbool
private def parseTZifV1 : Parser TZifV1 := do
let header parseHeader
let transitionTimes parseTransitionTimes pi32 header.timecnt
let transitionIndices parseTransitionIndices header.timecnt
let localTimeTypes parseLocalTimeTypes header.typecnt
let abbreviations parseAbbreviations localTimeTypes header.charcnt
let leapSeconds parseLeapSeconds pi32 header.leapcnt
let stdWallIndicators parseIndicators header.isstdcnt
let utLocalIndicators parseIndicators header.isutcnt
return {
header
transitionTimes
transitionIndices
localTimeTypes
abbreviations
leapSeconds
stdWallIndicators
utLocalIndicators
}
private def parseFooter : Parser (Option String) := do
let char pu8
if char = 0x0A then pure () else return none
let tzString many (satisfy (· 0x0A))
let mut str := ""
for byte in tzString do
str := str.push (Char.ofUInt8 byte)
return str
private def parseTZifV2 : Parser (Option TZifV2) := optional do
let header parseHeader
let transitionTimes parseTransitionTimes pi64 header.timecnt
let transitionIndices parseTransitionIndices header.timecnt
let localTimeTypes parseLocalTimeTypes header.typecnt
let abbreviations parseAbbreviations localTimeTypes header.charcnt
let leapSeconds parseLeapSeconds pi64 header.leapcnt
let stdWallIndicators parseIndicators header.isstdcnt
let utLocalIndicators parseIndicators header.isutcnt
return {
header
transitionTimes
transitionIndices
localTimeTypes
abbreviations
leapSeconds
stdWallIndicators
utLocalIndicators
footer := parseFooter
}
/--
Parses a TZif file, which may be in either version 1 or version 2 format.
-/
def parse : Parser TZif := do
let v1 parseTZifV1
let v2 parseTZifV2
return { v1, v2 }
end TZif

View File

@@ -0,0 +1,89 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.DateTime
import Std.Time.Zoned.TimeZone
import Std.Time.Zoned.ZoneRules
import Std.Time.Zoned.Database.Basic
namespace Std
namespace Time
namespace Database
set_option linter.all true
namespace Windows
/--
Fetches the next timezone transition for a given timezone identifier and timestamp.
-/
@[extern "lean_windows_get_next_transition"]
opaque getNextTransition : @&String Int64 Bool IO (Option (Int64 × TimeZone))
/--
Fetches the timezone at a timestamp.
-/
@[extern "lean_get_windows_local_timezone_id_at"]
opaque getLocalTimeZoneIdentifierAt : Int64 IO String
/--
Retrieves the timezone rules, including all transitions, for a given timezone identifier.
-/
def getZoneRules (id : String) : IO TimeZone.ZoneRules := do
let mut start := -2147483648
let mut transitions : Array TimeZone.Transition := #[]
let mut initialLocalTimeType
if let some res := Windows.getNextTransition id start true
then pure (toLocalTime res.snd)
else throw (IO.userError "cannot find first transition in zone rules")
while true do
let result Windows.getNextTransition id start false
if let some res := result then
transitions := transitions.push { time := Second.Offset.ofInt start.toInt, localTimeType := toLocalTime res.snd }
-- Avoid zone rules for more than year 3000
if res.fst start res.fst >= 32503690800 then
break
start := res.fst
else
break
return { transitions, initialLocalTimeType }
where
toLocalTime (res : TimeZone) : TimeZone.LocalTimeType :=
{
gmtOffset := res.offset,
abbreviation := res.abbreviation,
identifier := res.name,
isDst := res.isDST,
wall := .wall,
utLocal := .local
}
end Windows
/--
Represents a Time Zone Database that we get from ICU available on Windows SDK.
-/
structure WindowsDb where
namespace WindowsDb
open TimeZone
/--
Returns a default `WindowsDb` instance.
-/
@[inline]
def default : WindowsDb := {}
instance : Std.Time.Database WindowsDb where
getZoneRules _ id := Windows.getZoneRules id
getLocalZoneRules _ := Windows.getZoneRules =<< Windows.getLocalTimeZoneIdentifierAt (-2147483648)

View File

@@ -0,0 +1,516 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.DateTime
import Std.Time.Zoned.TimeZone
import Std.Internal
namespace Std
namespace Time
open Internal
set_option linter.all true
/--
Represents a specific point in time associated with a `TimeZone`.
-/
structure DateTime (tz : TimeZone) where
private mk ::
/--
`Timestamp` represents the exact moment in time. It's a UTC related `Timestamp`.
-/
timestamp : Timestamp
/--
`Date` is a `Thunk` containing the `PlainDateTime` that represents the local date and time, it's
used for accessing data like `day` and `month` without having to recompute the data everytime.
-/
date : Thunk PlainDateTime
instance : BEq (DateTime tz) where
beq x y := x.timestamp == y.timestamp
instance : Inhabited (DateTime tz) where
default := Inhabited.default, Thunk.mk fun _ => Inhabited.default
namespace DateTime
/--
Creates a new `DateTime` out of a `Timestamp` that is in a `TimeZone`.
-/
@[inline]
def ofTimestamp (tm : Timestamp) (tz : TimeZone) : DateTime tz :=
DateTime.mk tm (Thunk.mk fun _ => tm.toPlainDateTimeAssumingUTC |>.addSeconds tz.toSeconds)
/--
Converts a `DateTime` to the number of days since the UNIX epoch.
-/
def toDaysSinceUNIXEpoch (date : DateTime tz) : Day.Offset :=
date.date.get.toDaysSinceUNIXEpoch
/--
Creates a `Timestamp` out of a `DateTime`.
-/
@[inline]
def toTimestamp (date : DateTime tz) : Timestamp :=
date.timestamp
/--
Changes the `TimeZone` to a new one.
-/
@[inline]
def convertTimeZone (date : DateTime tz) (tz₁ : TimeZone) : DateTime tz₁ :=
ofTimestamp date.timestamp tz₁
/--
Creates a new `DateTime` out of a `PlainDateTime`. It assumes that the `PlainDateTime` is relative
to UTC.
-/
@[inline]
def ofPlainDateTimeAssumingUTC (date : PlainDateTime) (tz : TimeZone) : DateTime tz :=
let tm := Timestamp.ofPlainDateTimeAssumingUTC date
DateTime.mk tm (Thunk.mk fun _ => date.addSeconds tz.toSeconds)
/--
Creates a new `DateTime` from a `PlainDateTime`, assuming that the `PlainDateTime`
is relative to the given `TimeZone`.
-/
@[inline]
def ofPlainDateTime (date : PlainDateTime) (tz : TimeZone) : DateTime tz :=
let tm := date.subSeconds tz.toSeconds
DateTime.mk (Timestamp.ofPlainDateTimeAssumingUTC tm) (Thunk.mk fun _ => date)
/--
Add `Hour.Offset` to a `DateTime`.
-/
@[inline]
def addHours (dt : DateTime tz) (hours : Hour.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.addHours hours) tz
/--
Subtract `Hour.Offset` from a `DateTime`.
-/
@[inline]
def subHours (dt : DateTime tz) (hours : Hour.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.subHours hours) tz
/--
Add `Minute.Offset` to a `DateTime`.
-/
@[inline]
def addMinutes (dt : DateTime tz) (minutes : Minute.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.addMinutes minutes) tz
/--
Subtract `Minute.Offset` from a `DateTime`.
-/
@[inline]
def subMinutes (dt : DateTime tz) (minutes : Minute.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.subMinutes minutes) tz
/--
Add `Second.Offset` to a `DateTime`.
-/
@[inline]
def addSeconds (dt : DateTime tz) (seconds : Second.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.addSeconds seconds) tz
/--
Subtract `Second.Offset` from a `DateTime`.
-/
@[inline]
def subSeconds (dt : DateTime tz) (seconds : Second.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.subSeconds seconds) tz
/--
Add `Millisecond.Offset` to a `DateTime`.
-/
@[inline]
def addMilliseconds (dt : DateTime tz) (milliseconds : Millisecond.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.addMilliseconds milliseconds) tz
/--
Subtract `Millisecond.Offset` from a `DateTime`.
-/
@[inline]
def subMilliseconds (dt : DateTime tz) (milliseconds : Millisecond.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.subMilliseconds milliseconds) tz
/--
Add `Nanosecond.Offset` to a `DateTime`.
-/
@[inline]
def addNanoseconds (dt : DateTime tz) (nanoseconds : Nanosecond.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.addNanoseconds nanoseconds) tz
/--
Subtract `Nanosecond.Offset` from a `DateTime`.
-/
@[inline]
def subNanoseconds (dt : DateTime tz) (nanoseconds : Nanosecond.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.subNanoseconds nanoseconds) tz
/--
Add `Day.Offset` to a `DateTime`.
-/
@[inline]
def addDays (dt : DateTime tz) (days : Day.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.addDays days) tz
/--
Subtracts `Day.Offset` to a `DateTime`.
-/
@[inline]
def subDays (dt : DateTime tz) (days : Day.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.subDays days) tz
/--
Add `Week.Offset` to a `DateTime`.
-/
@[inline]
def addWeeks (dt : DateTime tz) (weeks : Week.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.addWeeks weeks) tz
/--
Subtracts `Week.Offset` to a `DateTime`.
-/
@[inline]
def subWeeks (dt : DateTime tz) (weeks : Week.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.subWeeks weeks) tz
/--
Add `Month.Offset` to a `DateTime`, it clips the day to the last valid day of that month.
-/
def addMonthsClip (dt : DateTime tz) (months : Month.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.addMonthsClip months) tz
/--
Subtracts `Month.Offset` from a `DateTime`, it clips the day to the last valid day of that month.
-/
@[inline]
def subMonthsClip (dt : DateTime tz) (months : Month.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.subMonthsClip months) tz
/--
Add `Month.Offset` from a `DateTime`, this function rolls over any excess days into the following
month.
-/
def addMonthsRollOver (dt : DateTime tz) (months : Month.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.addMonthsRollOver months) tz
/--
Subtract `Month.Offset` from a `DateTime`, this function rolls over any excess days into the following
month.
-/
@[inline]
def subMonthsRollOver (dt : DateTime tz) (months : Month.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.subMonthsRollOver months) tz
/--
Add `Year.Offset` to a `DateTime`, this function rolls over any excess days into the following
month.
-/
@[inline]
def addYearsRollOver (dt : DateTime tz) (years : Year.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.addYearsRollOver years) tz
/--
Add `Year.Offset` to a `DateTime`, it clips the day to the last valid day of that month.
-/
@[inline]
def addYearsClip (dt : DateTime tz) (years : Year.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.addYearsClip years) tz
/--
Subtract `Year.Offset` from a `DateTime`, this function rolls over any excess days into the following
month.
-/
@[inline]
def subYearsRollOver (dt : DateTime tz) (years : Year.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.subYearsRollOver years) tz
/--
Subtract `Year.Offset` from to a `DateTime`, it clips the day to the last valid day of that month.
-/
@[inline]
def subYearsClip (dt : DateTime tz) (years : Year.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.subYearsClip years) tz
/--
Creates a new `DateTime tz` by adjusting the day of the month to the given `days` value, with any
out-of-range days clipped to the nearest valid date.
-/
@[inline]
def withDaysClip (dt : DateTime tz) (days : Day.Ordinal) : DateTime tz :=
ofPlainDateTime (dt.date.get.withDaysClip days) tz
/--
Creates a new `DateTime tz` by adjusting the day of the month to the given `days` value, with any
out-of-range days rolled over to the next month or year as needed.
-/
@[inline]
def withDaysRollOver (dt : DateTime tz) (days : Day.Ordinal) : DateTime tz :=
ofPlainDateTime (dt.date.get.withDaysRollOver days) tz
/--
Creates a new `DateTime tz` by adjusting the month to the given `month` value.
The day remains unchanged, and any invalid days for the new month will be handled according to the `clip` behavior.
-/
@[inline]
def withMonthClip (dt : DateTime tz) (month : Month.Ordinal) : DateTime tz :=
ofPlainDateTime (dt.date.get.withMonthClip month) tz
/--
Creates a new `DateTime tz` by adjusting the month to the given `month` value.
The day is rolled over to the next valid month if necessary.
-/
@[inline]
def withMonthRollOver (dt : DateTime tz) (month : Month.Ordinal) : DateTime tz :=
ofPlainDateTime (dt.date.get.withMonthRollOver month) tz
/--
Creates a new `DateTime tz` by adjusting the year to the given `year` value. The month and day remain unchanged,
and any invalid days for the new year will be handled according to the `clip` behavior.
-/
@[inline]
def withYearClip (dt : DateTime tz) (year : Year.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.withYearClip year) tz
/--
Creates a new `DateTime tz` by adjusting the year to the given `year` value. The month and day are rolled
over to the next valid month and day if necessary.
-/
@[inline]
def withYearRollOver (dt : DateTime tz) (year : Year.Offset) : DateTime tz :=
ofPlainDateTime (dt.date.get.withYearRollOver year) tz
/--
Creates a new `DateTime tz` by adjusting the `hour` component.
-/
@[inline]
def withHours (dt : DateTime tz) (hour : Hour.Ordinal) : DateTime tz :=
ofPlainDateTime (dt.date.get.withHours hour) tz
/--
Creates a new `DateTime tz` by adjusting the `minute` component.
-/
@[inline]
def withMinutes (dt : DateTime tz) (minute : Minute.Ordinal) : DateTime tz :=
ofPlainDateTime (dt.date.get.withMinutes minute) tz
/--
Creates a new `DateTime tz` by adjusting the `second` component.
-/
@[inline]
def withSeconds (dt : DateTime tz) (second : Sigma Second.Ordinal) : DateTime tz :=
ofPlainDateTime (dt.date.get.withSeconds second) tz
/--
Creates a new `DateTime tz` by adjusting the `nano` component.
-/
@[inline]
def withNanoseconds (dt : DateTime tz) (nano : Nanosecond.Ordinal) : DateTime tz :=
ofPlainDateTime (dt.date.get.withNanoseconds nano) tz
/--
Creates a new `DateTime tz` by adjusting the `millisecond` component.
-/
@[inline]
def withMilliseconds (dt : DateTime tz) (milli : Millisecond.Ordinal) : DateTime tz :=
ofPlainDateTime (dt.date.get.withMilliseconds milli) tz
/--
Converts a `Timestamp` to a `PlainDateTime`
-/
@[inline]
def toPlainDateTime (dt : DateTime tz) : PlainDateTime :=
dt.date.get
/--
Getter for the `Year` inside of a `DateTime`
-/
@[inline]
def year (dt : DateTime tz) : Year.Offset :=
dt.date.get.year
/--
Getter for the `Month` inside of a `DateTime`
-/
@[inline]
def month (dt : DateTime tz) : Month.Ordinal :=
dt.date.get.month
/--
Getter for the `Day` inside of a `DateTime`
-/
@[inline]
def day (dt : DateTime tz) : Day.Ordinal :=
dt.date.get.day
/--
Getter for the `Hour` inside of a `DateTime`
-/
@[inline]
def hour (dt : DateTime tz) : Hour.Ordinal :=
dt.date.get.hour
/--
Getter for the `Minute` inside of a `DateTime`
-/
@[inline]
def minute (dt : DateTime tz) : Minute.Ordinal :=
dt.date.get.minute
/--
Getter for the `Second` inside of a `DateTime`
-/
@[inline]
def second (dt : DateTime tz) : Second.Ordinal dt.date.get.time.second.fst :=
dt.date.get.second
/--
Getter for the `Milliseconds` inside of a `DateTime`
-/
@[inline]
def millisecond (dt : DateTime tz) : Millisecond.Ordinal :=
dt.date.get.time.nanosecond.emod 1000 (by decide)
/--
Getter for the `Nanosecond` inside of a `DateTime`
-/
@[inline]
def nanosecond (dt : DateTime tz) : Nanosecond.Ordinal :=
dt.date.get.time.nanosecond
/--
Gets the `Weekday` of a DateTime.
-/
@[inline]
def weekday (dt : DateTime tz) : Weekday :=
dt.date.get.date.weekday
/--
Determines the era of the given `DateTime` based on its year.
-/
def era (date : DateTime tz) : Year.Era :=
date.year.era
/--
Sets the `DateTime` to the specified `desiredWeekday`.
-/
def withWeekday (dt : DateTime tz) (desiredWeekday : Weekday) : DateTime tz :=
ofPlainDateTime (dt.date.get.withWeekday desiredWeekday) tz
/--
Checks if the `DateTime` is in a leap year.
-/
def inLeapYear (date : DateTime tz) : Bool :=
date.year.isLeap
/--
Determines the ordinal day of the year for the given `DateTime`.
-/
def dayOfYear (date : DateTime tz) : Day.Ordinal.OfYear date.year.isLeap :=
ValidDate.dayOfYear date.month, date.day, date.date.get.date.valid
/--
Determines the week of the year for the given `DateTime`.
-/
@[inline]
def weekOfYear (date : DateTime tz) : Week.Ordinal :=
date.date.get.weekOfYear
/--
Returns the unaligned week of the month for a `DateTime` (day divided by 7, plus 1).
-/
def weekOfMonth (date : DateTime tz) : Bounded.LE 1 5 :=
date.date.get.weekOfMonth
/--
Determines the week of the month for the given `DateTime`. 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.
-/
@[inline]
def alignedWeekOfMonth (date : DateTime tz) : Week.Ordinal.OfMonth :=
date.date.get.alignedWeekOfMonth
/--
Determines the quarter of the year for the given `DateTime`.
-/
@[inline]
def quarter (date : DateTime tz) : Bounded.LE 1 4 :=
date.date.get.quarter
/--
Getter for the `PlainTime` inside of a `DateTime`
-/
@[inline]
def time (zdt : DateTime tz) : PlainTime :=
zdt.date.get.time
/--
Converts a `DateTime` to the number of days since the UNIX epoch.
-/
@[inline]
def ofDaysSinceUNIXEpoch (days : Day.Offset) (time : PlainTime) (tz : TimeZone) : DateTime tz :=
DateTime.ofPlainDateTime (PlainDateTime.ofDaysSinceUNIXEpoch days time) tz
instance : HAdd (DateTime tz) (Day.Offset) (DateTime tz) where
hAdd := addDays
instance : HSub (DateTime tz) (Day.Offset) (DateTime tz) where
hSub := subDays
instance : HAdd (DateTime tz) (Week.Offset) (DateTime tz) where
hAdd := addWeeks
instance : HSub (DateTime tz) (Week.Offset) (DateTime tz) where
hSub := subWeeks
instance : HAdd (DateTime tz) (Hour.Offset) (DateTime tz) where
hAdd := addHours
instance : HSub (DateTime tz) (Hour.Offset) (DateTime tz) where
hSub := subHours
instance : HAdd (DateTime tz) (Minute.Offset) (DateTime tz) where
hAdd := addMinutes
instance : HSub (DateTime tz) (Minute.Offset) (DateTime tz) where
hSub := subMinutes
instance : HAdd (DateTime tz) (Second.Offset) (DateTime tz) where
hAdd := addSeconds
instance : HSub (DateTime tz) (Second.Offset) (DateTime tz) where
hSub := subSeconds
instance : HAdd (DateTime tz) (Millisecond.Offset) (DateTime tz) where
hAdd := addMilliseconds
instance : HSub (DateTime tz) (Millisecond.Offset) (DateTime tz) where
hSub := subMilliseconds
instance : HAdd (DateTime tz) (Nanosecond.Offset) (DateTime tz) where
hAdd := addNanoseconds
instance : HSub (DateTime tz) (Nanosecond.Offset) (DateTime tz) where
hSub := subNanoseconds
instance : HSub (DateTime tz) (DateTime tz₁) Duration where
hSub x y := x.toTimestamp - y.toTimestamp
instance : HAdd (DateTime tz) Duration (DateTime tz) where
hAdd x y := x.addNanoseconds y.toNanoseconds
instance : HSub (DateTime tz) Duration (DateTime tz) where
hSub x y := x.subNanoseconds y.toNanoseconds
end DateTime
end Time
end Std

View File

@@ -0,0 +1,74 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Time
namespace Std
namespace Time
namespace TimeZone
open Internal
set_option linter.all true
/--
Represents a timezone offset with an hour and second component.
-/
structure Offset where
/--
Creates an `Offset` from a given number of seconds.
-/
ofSeconds ::
/--
The same timezone offset in seconds.
-/
second : Second.Offset
deriving Repr
instance : Inhabited Offset where
default := 0
instance : BEq Offset where
beq x y := BEq.beq x.second y.second
namespace Offset
/--
Converts an `Offset` to a string in ISO 8601 format. The `colon` parameter determines if the hour
and minute components are separated by a colon (e.g., "+01:00" or "+0100").
-/
def toIsoString (offset : Offset) (colon : Bool) : String :=
let (sign, time) := if offset.second.val 0 then ("+", offset.second) else ("-", -offset.second)
let hour : Hour.Offset := time.ediv 3600
let minute := Int.ediv (Int.tmod time.val 3600) 60
let hourStr := if hour.val < 10 then s!"0{hour.val}" else toString hour.val
let minuteStr := if minute < 10 then s!"0{minute}" else toString minute
if colon then s!"{sign}{hourStr}:{minuteStr}"
else s!"{sign}{hourStr}{minuteStr}"
/--
A zero `Offset` representing UTC (no offset).
-/
def zero : Offset :=
{ second := 0 }
/--
Creates an `Offset` from a given number of hour.
-/
def ofHours (n : Hour.Offset) : Offset :=
ofSeconds n.toSeconds
/--
Creates an `Offset` from a given number of hours and minutes.
-/
def ofHoursAndMinutes (n : Hour.Offset) (m : Minute.Offset) : Offset :=
ofSeconds (n.toSeconds + m.toSeconds)
end Offset
end TimeZone
end Time
end Std

View File

@@ -0,0 +1,71 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Zoned.Offset
namespace Std
namespace Time
set_option linter.all true
/--
A TimeZone structure that stores the timezone offset, the name, abbreviation and if it's in daylight
saving time.
-/
structure TimeZone where
/--
The `Offset` of the date time.
-/
offset : TimeZone.Offset
/--
The name of the time zone.
-/
name : String
/--
The abbreviation of the time zone.
-/
abbreviation : String
/--
Day light saving flag.
-/
isDST : Bool
deriving Inhabited, Repr, BEq
namespace TimeZone
/--
A zeroed `Timezone` representing UTC (no offset).
-/
def UTC : TimeZone :=
TimeZone.mk (Offset.zero) "UTC" "UTC" false
/--
A zeroed `Timezone` representing GMT (no offset).
-/
def GMT : TimeZone :=
TimeZone.mk (Offset.zero) "Greenwich Mean Time" "GMT" false
/--
Creates a `Timestamp` from a given number of hour.
-/
def ofHours (name : String) (abbreviation : String) (n : Hour.Offset) (isDST : Bool := false) : TimeZone :=
TimeZone.mk (Offset.ofHours n) name abbreviation isDST
/--
Creates a `Timestamp` from a given number of second.
-/
def ofSeconds (name : String) (abbreviation : String) (n : Second.Offset) (isDST : Bool := false) : TimeZone :=
TimeZone.mk (Offset.ofSeconds n) name abbreviation isDST
/--
Gets the number of seconds in a timezone offset.
-/
def toSeconds (tz : TimeZone) : Second.Offset :=
tz.offset.second

View File

@@ -0,0 +1,225 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.DateTime
import Std.Time.Zoned.TimeZone
namespace Std
namespace Time
namespace TimeZone
open Internal
set_option linter.all true
/--
Represents the type of local time in relation to UTC.
-/
inductive UTLocal
/--
Universal Time (UT), often referred to as UTC.
-/
| ut
/--
Local time that is not necessarily UTC.
-/
| local
deriving Repr, Inhabited
/--
Represents types of wall clocks or standard times.
-/
inductive StdWall
/--
Time based on a wall clock, which can include daylight saving adjustments.
-/
| wall
/--
Standard time without adjustments for daylight saving.
-/
| standard
deriving Repr, Inhabited
/--
Represents a type of local time, including offset and daylight saving information.
-/
structure LocalTimeType where
/--
The offset from GMT for this local time.
-/
gmtOffset : TimeZone.Offset
/--
Indicates if daylight saving time is observed.
-/
isDst : Bool
/--
The abbreviation for this local time type (e.g., "EST", "PDT").
-/
abbreviation : String
/--
Indicates if the time is wall clock or standard time.
-/
wall : StdWall
/--
Distinguishes between universal time and local time.
-/
utLocal : UTLocal
/--
ID of the timezone
-/
identifier : String
deriving Repr, Inhabited
namespace LocalTimeType
/--
Gets the `TimeZone` offset from a `LocalTimeType`.
-/
def getTimeZone (time : LocalTimeType) : TimeZone :=
time.gmtOffset, time.identifier, time.abbreviation, time.isDst
end LocalTimeType
/--
Represents a time zone transition, mapping a time to a local time type.
-/
structure Transition where
/--
The specific time of the transition event.
-/
time : Second.Offset
/--
The local time type associated with this transition.
-/
localTimeType : LocalTimeType
deriving Repr, Inhabited
/--
Represents the rules for a time zone.
-/
structure ZoneRules where
/--
The first `LocalTimeType` used as a fallback when no matching transition is found.
-/
initialLocalTimeType : LocalTimeType
/--
The array of transitions for the time zone.
-/
transitions : Array Transition
deriving Repr, Inhabited
namespace Transition
/--
Create a TimeZone from a Transition.
-/
def createTimeZoneFromTransition (transition : Transition) : TimeZone :=
let name := transition.localTimeType.identifier
let offset := transition.localTimeType.gmtOffset
let abbreviation := transition.localTimeType.abbreviation
TimeZone.mk offset name abbreviation transition.localTimeType.isDst
/--
Applies the transition to a Timestamp.
-/
def apply (timestamp : Timestamp) (transition : Transition) : Timestamp :=
let offsetInSeconds := transition.localTimeType.gmtOffset.second |>.add transition.localTimeType.gmtOffset.second
timestamp.addSeconds offsetInSeconds
/--
Finds the transition corresponding to a given timestamp in `Array Transition`.
If the timestamp falls between two transitions, it returns the most recent transition before the timestamp.
-/
def findTransitionIndexForTimestamp (transitions : Array Transition) (timestamp : Timestamp) : Option Nat :=
let value := timestamp.toSecondsSinceUnixEpoch
if let some idx := transitions.findIdx? (fun t => t.time.val > value.val)
then some idx
else none
/--
Finds the transition corresponding to a given timestamp in `Array Transition`.
If the timestamp falls between two transitions, it returns the most recent transition before the timestamp.
-/
def findTransitionForTimestamp (transitions : Array Transition) (timestamp : Timestamp) : Option Transition :=
if let some idx := findTransitionIndexForTimestamp transitions timestamp
then transitions.get? (idx - 1)
else transitions.back?
/--
Find the current `TimeZone` out of a `Transition` in a `Array Transition`
-/
def timezoneAt (transitions : Array Transition) (tm : Timestamp) : Except String TimeZone :=
if let some transition := findTransitionForTimestamp transitions tm
then .ok transition.createTimeZoneFromTransition
else .error "cannot find local timezone."
end Transition
namespace ZoneRules
/--
Creates ZoneRules with a fixed GMT offset.
-/
def fixedOffsetZone (second : Second.Offset) (identifier : Option String := none) (abbreviation : Option String := none) : ZoneRules :=
let offset : Offset := { second }
{
transitions := #[],
initialLocalTimeType := {
gmtOffset := offset,
isDst := false, abbreviation := abbreviation.getD (offset.toIsoString true),
wall := .standard,
utLocal := .ut,
identifier := identifier.getD (offset.toIsoString true)
}
}
/--
Creates ZoneRules with a fixed offset of UTC (GMT+0).
-/
@[inline]
def UTC : ZoneRules :=
fixedOffsetZone 0 "UTC" "UTC"
/--
Finds the `LocalTimeType` corresponding to a given `Timestamp` in `ZoneRules`.
If the timestamp falls between two transitions, it returns the most recent transition before the timestamp.
If no transition is found, it falls back to `initialLocalTimeType`.
-/
@[inline]
def findLocalTimeTypeForTimestamp (zr : ZoneRules) (timestamp : Timestamp) : LocalTimeType :=
Transition.findTransitionForTimestamp zr.transitions timestamp
|>.map (·.localTimeType)
|>.getD zr.initialLocalTimeType
/--
Find the current `TimeZone` out of a `Transition` in a `ZoneRules`
-/
@[inline]
def timezoneAt (zr : ZoneRules) (tm : Timestamp) : TimeZone :=
Transition.timezoneAt zr.transitions tm
|>.toOption
|>.getD (zr.initialLocalTimeType |>.getTimeZone)
/--
Creates `ZoneRules` for the given `TimeZone`.
-/
@[inline]
def ofTimeZone (tz : TimeZone) : ZoneRules :=
let ltt := LocalTimeType.mk tz.offset tz.isDST tz.abbreviation .wall .local tz.name
ZoneRules.mk ltt #[]
end ZoneRules

View File

@@ -0,0 +1,587 @@
/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sofia Rodrigues
-/
prelude
import Std.Time.Zoned.DateTime
import Std.Time.Zoned.ZoneRules
namespace Std
namespace Time
set_option linter.all true
/--
Represents a date and time with timezone information.
-/
structure ZonedDateTime where
private mk::
/--
The plain datetime component, evaluated lazily.
-/
date : Thunk PlainDateTime
/--
The corresponding timestamp for the datetime.
-/
timestamp : Timestamp
/--
The timezone rules applied to this datetime.
-/
rules : TimeZone.ZoneRules
/--
The timezone associated with this datetime.
-/
timezone : TimeZone
instance : Inhabited ZonedDateTime where
default := Thunk.mk Inhabited.default, Inhabited.default, Inhabited.default, Inhabited.default
namespace ZonedDateTime
open DateTime
/--
Creates a new `ZonedDateTime` out of a `Timestamp` and a `ZoneRules`.
-/
@[inline]
def ofTimestamp (tm : Timestamp) (rules : TimeZone.ZoneRules) : ZonedDateTime :=
let tz := rules.timezoneAt tm
ZonedDateTime.mk (Thunk.mk fun _ => tm.toPlainDateTimeAssumingUTC.addSeconds tz.toSeconds) tm rules tz
/--
Creates a new `ZonedDateTime` out of a `PlainDateTime` and a `ZoneRules`.
-/
@[inline]
def ofPlainDateTime (pdt : PlainDateTime) (zr : TimeZone.ZoneRules) : ZonedDateTime :=
let tm := pdt.toTimestampAssumingUTC
let transition :=
let value := tm.toSecondsSinceUnixEpoch
if let some idx := zr.transitions.findIdx? (fun t => t.time.val value.val)
then do
let last zr.transitions.get? (idx - 1)
let next zr.transitions.get? idx <|> zr.transitions.back?
let utcNext := next.time.sub last.localTimeType.gmtOffset.second.abs
if utcNext.val > tm.toSecondsSinceUnixEpoch.val
then pure last
else pure next
else zr.transitions.back?
let tz :=
transition
|>.map (·.localTimeType)
|>.getD zr.initialLocalTimeType
|>.getTimeZone
let tm := tm.subSeconds tz.toSeconds
ZonedDateTime.mk (Thunk.mk fun _ => tm.toPlainDateTimeAssumingUTC.addSeconds tz.toSeconds) tm zr tz
/--
Creates a new `ZonedDateTime` out of a `Timestamp` and a `TimeZone`.
-/
@[inline]
def ofTimestampWithZone (tm : Timestamp) (tz : TimeZone) : ZonedDateTime :=
ofTimestamp tm (TimeZone.ZoneRules.ofTimeZone tz)
/--
Creates a new `ZonedDateTime` out of a `PlainDateTime` and a `TimeZone`.
-/
@[inline]
def ofPlainDateTimeWithZone (tm : PlainDateTime) (tz : TimeZone) : ZonedDateTime :=
ofPlainDateTime tm (TimeZone.ZoneRules.ofTimeZone tz)
/--
Creates a new `Timestamp` out of a `ZonedDateTime`.
-/
@[inline]
def toTimestamp (date : ZonedDateTime) : Timestamp :=
date.timestamp
/--
Changes the `ZoleRules` to a new one.
-/
@[inline]
def convertZoneRules (date : ZonedDateTime) (tz₁ : TimeZone.ZoneRules) : ZonedDateTime :=
ofTimestamp date.toTimestamp tz₁
/--
Creates a new `ZonedDateTime` out of a `PlainDateTime`. It assumes that the `PlainDateTime` is relative
to UTC.
-/
@[inline]
def ofPlainDateTimeAssumingUTC (date : PlainDateTime) (tz : TimeZone.ZoneRules) : ZonedDateTime :=
ofTimestamp date.toTimestampAssumingUTC tz
/--
Converts a `ZonedDateTime` to a `PlainDateTime`
-/
@[inline]
def toPlainDateTime (dt : ZonedDateTime) : PlainDateTime :=
dt.date.get
/--
Converts a `ZonedDateTime` to a `PlainDateTime`
-/
@[inline]
def toDateTime (dt : ZonedDateTime) : DateTime dt.timezone :=
DateTime.ofTimestamp dt.timestamp dt.timezone
/--
Getter for the `PlainTime` inside of a `ZonedDateTime`
-/
@[inline]
def time (zdt : ZonedDateTime) : PlainTime :=
zdt.date.get.time
/--
Getter for the `Year` inside of a `ZonedDateTime`
-/
@[inline]
def year (zdt : ZonedDateTime) : Year.Offset :=
zdt.date.get.year
/--
Getter for the `Month` inside of a `ZonedDateTime`
-/
@[inline]
def month (zdt : ZonedDateTime) : Month.Ordinal :=
zdt.date.get.month
/--
Getter for the `Day` inside of a `ZonedDateTime`
-/
@[inline]
def day (zdt : ZonedDateTime) : Day.Ordinal :=
zdt.date.get.day
/--
Getter for the `Hour` inside of a `ZonedDateTime`
-/
@[inline]
def hour (zdt : ZonedDateTime) : Hour.Ordinal :=
zdt.date.get.time.hour
/--
Getter for the `Minute` inside of a `ZonedDateTime`
-/
@[inline]
def minute (zdt : ZonedDateTime) : Minute.Ordinal :=
zdt.date.get.minute
/--
Getter for the `Second` inside of a `ZonedDateTime`
-/
@[inline]
def second (zdt : ZonedDateTime) : Second.Ordinal zdt.date.get.time.second.fst :=
zdt.date.get.time.second.snd
/--
Getter for the `Millisecond` inside of a `ZonedDateTime`.
-/
@[inline]
def millisecond (dt : ZonedDateTime) : Millisecond.Ordinal :=
dt.date.get.time.millisecond
/--
Getter for the `Nanosecond` inside of a `ZonedDateTime`
-/
@[inline]
def nanosecond (zdt : ZonedDateTime) : Nanosecond.Ordinal :=
zdt.date.get.time.nanosecond
/--
Getter for the `TimeZone.Offset` inside of a `ZonedDateTime`
-/
@[inline]
def offset (zdt : ZonedDateTime) : TimeZone.Offset :=
zdt.timezone.offset
/--
Returns the weekday.
-/
@[inline]
def weekday (zdt : ZonedDateTime) : Weekday :=
zdt.date.get.weekday
/--
Transforms a tuple of a `ZonedDateTime` into a `Day.Ordinal.OfYear`.
-/
@[inline]
def dayOfYear (date : ZonedDateTime) : Day.Ordinal.OfYear date.year.isLeap :=
ValidDate.dayOfYear (date.month, date.day), date.date.get.date.valid
/--
Determines the week of the year for the given `ZonedDateTime`.
-/
@[inline]
def weekOfYear (date : ZonedDateTime) : Week.Ordinal :=
date.date.get.weekOfYear
/--
Returns the unaligned week of the month for a `ZonedDateTime` (day divided by 7, plus 1).
-/
def weekOfMonth (date : ZonedDateTime) : Internal.Bounded.LE 1 5 :=
date.date.get.weekOfMonth
/--
Determines the week of the month for the given `ZonedDateTime`. 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.
-/
@[inline]
def alignedWeekOfMonth (date : ZonedDateTime) : Week.Ordinal.OfMonth :=
date.date.get.alignedWeekOfMonth
/--
Determines the quarter of the year for the given `ZonedDateTime`.
-/
@[inline]
def quarter (date : ZonedDateTime) : Internal.Bounded.LE 1 4 :=
date.date.get.quarter
/--
Add `Day.Offset` to a `ZonedDateTime`.
-/
def addDays (dt : ZonedDateTime) (days : Day.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.addDays days).toTimestampAssumingUTC dt.rules
/--
Subtract `Day.Offset` from a `ZonedDateTime`.
-/
def subDays (dt : ZonedDateTime) (days : Day.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.subDays days).toTimestampAssumingUTC dt.rules
/--
Add `Week.Offset` to a `ZonedDateTime`.
-/
def addWeeks (dt : ZonedDateTime) (weeks : Week.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.addWeeks weeks).toTimestampAssumingUTC dt.rules
/--
Subtract `Week.Offset` from a `ZonedDateTime`.
-/
def subWeeks (dt : ZonedDateTime) (weeks : Week.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.subWeeks weeks).toTimestampAssumingUTC dt.rules
/--
Add `Month.Offset` to a `ZonedDateTime`, clipping to the last valid day.
-/
def addMonthsClip (dt : ZonedDateTime) (months : Month.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.addMonthsClip months).toTimestampAssumingUTC dt.rules
/--
Subtract `Month.Offset` from a `ZonedDateTime`, clipping to the last valid day.
-/
def subMonthsClip (dt : ZonedDateTime) (months : Month.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.subMonthsClip months).toTimestampAssumingUTC dt.rules
/--
Add `Month.Offset` to a `ZonedDateTime`, rolling over excess days.
-/
def addMonthsRollOver (dt : ZonedDateTime) (months : Month.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.addMonthsRollOver months).toTimestampAssumingUTC dt.rules
/--
Subtract `Month.Offset` from a `ZonedDateTime`, rolling over excess days.
-/
def subMonthsRollOver (dt : ZonedDateTime) (months : Month.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.subMonthsRollOver months).toTimestampAssumingUTC dt.rules
/--
Add `Year.Offset` to a `ZonedDateTime`, rolling over excess days.
-/
def addYearsRollOver (dt : ZonedDateTime) (years : Year.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.addYearsRollOver years).toTimestampAssumingUTC dt.rules
/--
Add `Year.Offset` to a `ZonedDateTime`, clipping to the last valid day.
-/
def addYearsClip (dt : ZonedDateTime) (years : Year.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.addYearsClip years).toTimestampAssumingUTC dt.rules
/--
Subtract `Year.Offset` from a `ZonedDateTime`, clipping to the last valid day.
-/
def subYearsClip (dt : ZonedDateTime) (years : Year.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.subYearsClip years).toTimestampAssumingUTC dt.rules
/--
Subtract `Year.Offset` from a `ZonedDateTime`, rolling over excess days.
-/
def subYearsRollOver (dt : ZonedDateTime) (years : Year.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.subYearsRollOver years).toTimestampAssumingUTC dt.rules
/--
Add `Hour.Offset` to a `ZonedDateTime`.
-/
def addHours (dt : ZonedDateTime) (hours : Hour.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.addHours hours).toTimestampAssumingUTC dt.rules
/--
Subtract `Hour.Offset` from a `ZonedDateTime`.
-/
def subHours (dt : ZonedDateTime) (hours : Hour.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.subHours hours).toTimestampAssumingUTC dt.rules
/--
Add `Minute.Offset` to a `ZonedDateTime`.
-/
def addMinutes (dt : ZonedDateTime) (minutes : Minute.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.addMinutes minutes).toTimestampAssumingUTC dt.rules
/--
Subtract `Minute.Offset` from a `ZonedDateTime`.
-/
def subMinutes (dt : ZonedDateTime) (minutes : Minute.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.subMinutes minutes).toTimestampAssumingUTC dt.rules
/--
Add `Millisecond.Offset` to a `DateTime`.
-/
@[inline]
def addMilliseconds (dt : ZonedDateTime) (milliseconds : Millisecond.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.addMilliseconds milliseconds).toTimestampAssumingUTC dt.rules
/--
Subtract `Millisecond.Offset` from a `DateTime`.
-/
@[inline]
def subMilliseconds (dt : ZonedDateTime) (milliseconds : Millisecond.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.subMilliseconds milliseconds).toTimestampAssumingUTC dt.rules
/--
Add `Second.Offset` to a `ZonedDateTime`.
-/
def addSeconds (dt : ZonedDateTime) (seconds : Second.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.addSeconds seconds).toTimestampAssumingUTC dt.rules
/--
Subtract `Second.Offset` from a `ZonedDateTime`.
-/
def subSeconds (dt : ZonedDateTime) (seconds : Second.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.subSeconds seconds).toTimestampAssumingUTC dt.rules
/--
Add `Nanosecond.Offset` to a `ZonedDateTime`.
-/
def addNanoseconds (dt : ZonedDateTime) (nanoseconds : Nanosecond.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.addNanoseconds nanoseconds).toTimestampAssumingUTC dt.rules
/--
Subtract `Nanosecond.Offset` from a `ZonedDateTime`.
-/
def subNanoseconds (dt : ZonedDateTime) (nanoseconds : Nanosecond.Offset) : ZonedDateTime :=
let date := dt.timestamp.toPlainDateTimeAssumingUTC
ZonedDateTime.ofTimestamp (date.subNanoseconds nanoseconds).toTimestampAssumingUTC dt.rules
/--
Determines the era of the given `ZonedDateTime` based on its year.
-/
@[inline]
def era (date : ZonedDateTime) : Year.Era :=
date.date.get.era
/--
Sets the `ZonedDateTime` to the specified `desiredWeekday`.
-/
def withWeekday (dt : ZonedDateTime) (desiredWeekday : Weekday) : ZonedDateTime :=
let date := dt.date.get
ZonedDateTime.ofPlainDateTime (date.withWeekday desiredWeekday) dt.rules
/--
Creates a new `ZonedDateTime` by adjusting the day of the month to the given `days` value, with any
out-of-range days clipped to the nearest valid date.
-/
@[inline]
def withDaysClip (dt : ZonedDateTime) (days : Day.Ordinal) : ZonedDateTime :=
let date := dt.date.get
ZonedDateTime.ofPlainDateTime (date.withDaysClip days) dt.rules
/--
Creates a new `ZonedDateTime` by adjusting the day of the month to the given `days` value, with any
out-of-range days rolled over to the next month or year as needed.
-/
@[inline]
def withDaysRollOver (dt : ZonedDateTime) (days : Day.Ordinal) : ZonedDateTime :=
let date := dt.date.get
ZonedDateTime.ofPlainDateTime (date.withDaysRollOver days) dt.rules
/--
Creates a new `ZonedDateTime` by adjusting the month to the given `month` value.
The day remains unchanged, and any invalid days for the new month will be handled according to the `clip` behavior.
-/
@[inline]
def withMonthClip (dt : ZonedDateTime) (month : Month.Ordinal) : ZonedDateTime :=
let date := dt.date.get
ZonedDateTime.ofPlainDateTime (date.withMonthClip month) dt.rules
/--
Creates a new `ZonedDateTime` by adjusting the month to the given `month` value.
The day is rolled over to the next valid month if necessary.
-/
@[inline]
def withMonthRollOver (dt : ZonedDateTime) (month : Month.Ordinal) : ZonedDateTime :=
let date := dt.date.get
ZonedDateTime.ofPlainDateTime (date.withMonthRollOver month) dt.rules
/--
Creates a new `ZonedDateTime` by adjusting the year to the given `year` value. The month and day remain unchanged,
and any invalid days for the new year will be handled according to the `clip` behavior.
-/
@[inline]
def withYearClip (dt : ZonedDateTime) (year : Year.Offset) : ZonedDateTime :=
let date := dt.date.get
ZonedDateTime.ofPlainDateTime (date.withYearClip year) dt.rules
/--
Creates a new `ZonedDateTime` by adjusting the year to the given `year` value. The month and day are rolled
over to the next valid month and day if necessary.
-/
@[inline]
def withYearRollOver (dt : ZonedDateTime) (year : Year.Offset) : ZonedDateTime :=
let date := dt.date.get
ZonedDateTime.ofPlainDateTime (date.withYearRollOver year) dt.rules
/--
Creates a new `ZonedDateTime` by adjusting the `hour` component.
-/
@[inline]
def withHours (dt : ZonedDateTime) (hour : Hour.Ordinal) : ZonedDateTime :=
let date := dt.date.get
ZonedDateTime.ofPlainDateTime (date.withHours hour) dt.rules
/--
Creates a new `ZonedDateTime` by adjusting the `minute` component.
-/
@[inline]
def withMinutes (dt : ZonedDateTime) (minute : Minute.Ordinal) : ZonedDateTime :=
let date := dt.date.get
ZonedDateTime.ofPlainDateTime (date.withMinutes minute) dt.rules
/--
Creates a new `ZonedDateTime` by adjusting the `second` component.
-/
@[inline]
def withSeconds (dt : ZonedDateTime) (second : Sigma Second.Ordinal) : ZonedDateTime :=
let date := dt.date.get
ZonedDateTime.ofPlainDateTime (date.withSeconds second) dt.rules
/--
Creates a new `ZonedDateTime` by adjusting the `nano` component with a new `millis` that will set
in the millisecond scale.
-/
@[inline]
def withMilliseconds (dt : ZonedDateTime) (millis : Millisecond.Ordinal) : ZonedDateTime :=
let date := dt.date.get
ZonedDateTime.ofPlainDateTime (date.withMilliseconds millis) dt.rules
/--
Creates a new `ZonedDateTime` by adjusting the `nano` component.
-/
@[inline]
def withNanoseconds (dt : ZonedDateTime) (nano : Nanosecond.Ordinal) : ZonedDateTime :=
let date := dt.date.get
ZonedDateTime.ofPlainDateTime (date.withNanoseconds nano) dt.rules
/--
Checks if the `ZonedDateTime` is in a leap year.
-/
def inLeapYear (date : ZonedDateTime) : Bool :=
date.year.isLeap
/--
Converts a `ZonedDateTime` to the number of days since the UNIX epoch.
-/
def toDaysSinceUNIXEpoch (date : ZonedDateTime) : Day.Offset :=
date.date.get.toDaysSinceUNIXEpoch
/--
Converts a `ZonedDateTime` to the number of days since the UNIX epoch.
-/
@[inline]
def ofDaysSinceUNIXEpoch (days : Day.Offset) (time : PlainTime) (zt : TimeZone.ZoneRules) : ZonedDateTime :=
ZonedDateTime.ofPlainDateTime (PlainDateTime.ofDaysSinceUNIXEpoch days time) zt
instance : HAdd ZonedDateTime Day.Offset ZonedDateTime where
hAdd := addDays
instance : HSub ZonedDateTime Day.Offset ZonedDateTime where
hSub := subDays
instance : HAdd ZonedDateTime Week.Offset ZonedDateTime where
hAdd := addWeeks
instance : HSub ZonedDateTime Week.Offset ZonedDateTime where
hSub := subWeeks
instance : HAdd ZonedDateTime Hour.Offset ZonedDateTime where
hAdd := addHours
instance : HSub ZonedDateTime Hour.Offset ZonedDateTime where
hSub := subHours
instance : HAdd ZonedDateTime Minute.Offset ZonedDateTime where
hAdd := addMinutes
instance : HSub ZonedDateTime Minute.Offset ZonedDateTime where
hSub := subMinutes
instance : HAdd ZonedDateTime Second.Offset ZonedDateTime where
hAdd := addSeconds
instance : HSub ZonedDateTime Second.Offset ZonedDateTime where
hSub := subSeconds
instance : HAdd ZonedDateTime Millisecond.Offset ZonedDateTime where
hAdd := addMilliseconds
instance : HSub ZonedDateTime Millisecond.Offset ZonedDateTime where
hSub := subMilliseconds
instance : HAdd ZonedDateTime Nanosecond.Offset ZonedDateTime where
hAdd := addNanoseconds
instance : HSub ZonedDateTime Nanosecond.Offset ZonedDateTime where
hSub := subNanoseconds
instance : HSub ZonedDateTime ZonedDateTime Duration where
hSub x y := x.toTimestamp - y.toTimestamp
instance : HAdd ZonedDateTime Duration ZonedDateTime where
hAdd x y := x.addNanoseconds y.toNanoseconds
instance : HSub ZonedDateTime Duration ZonedDateTime where
hSub x y := x.subNanoseconds y.toNanoseconds
end ZonedDateTime
end Time
end Std

View File

@@ -1259,6 +1259,8 @@ static inline lean_obj_res lean_nat_mod(b_lean_obj_arg a1, b_lean_obj_arg a2) {
static inline bool lean_nat_eq(b_lean_obj_arg a1, b_lean_obj_arg a2) {
if (LEAN_LIKELY(lean_is_scalar(a1) && lean_is_scalar(a2))) {
// This comparison is UB according to the standard but allowed as per the
// GCC documentation and the address sanitizer does not complain about it.
return a1 == a2;
} else {
return lean_nat_big_eq(a1, a2);
@@ -1275,6 +1277,8 @@ static inline bool lean_nat_ne(b_lean_obj_arg a1, b_lean_obj_arg a2) {
static inline bool lean_nat_le(b_lean_obj_arg a1, b_lean_obj_arg a2) {
if (LEAN_LIKELY(lean_is_scalar(a1) && lean_is_scalar(a2))) {
// This comparison is UB according to the standard but allowed as per the
// GCC documentation and the address sanitizer does not complain about it.
return a1 <= a2;
} else {
return lean_nat_big_le(a1, a2);
@@ -1287,6 +1291,8 @@ static inline uint8_t lean_nat_dec_le(b_lean_obj_arg a1, b_lean_obj_arg a2) {
static inline bool lean_nat_lt(b_lean_obj_arg a1, b_lean_obj_arg a2) {
if (LEAN_LIKELY(lean_is_scalar(a1) && lean_is_scalar(a2))) {
// This comparison is UB according to the standard but allowed as per the
// GCC documentation and the address sanitizer does not complain about it.
return a1 < a2;
} else {
return lean_nat_big_lt(a1, a2);
@@ -2685,6 +2691,8 @@ static inline size_t lean_float_to_usize(double a) {
else
return (size_t) lean_float_to_uint32(a); // NOLINT
}
LEAN_EXPORT double lean_float_from_bits(uint64_t u);
LEAN_EXPORT uint64_t lean_float_to_bits(double d);
static inline double lean_float_add(double a, double b) { return a + b; }
static inline double lean_float_sub(double a, double b) { return a - b; }
static inline double lean_float_mul(double a, double b) { return a * b; }

View File

@@ -515,7 +515,7 @@ protected def translateConfig : CliM PUnit := do
if outFile?.isNone then
IO.FS.rename pkg.configFile (pkg.configFile.addExtension "bak")
def ReservoirConfig.currentSchemaVersion : StdVer := v!"1.0.0"
def ReservoirConfig.currentSchemaVersion : StdVer := {major := 1}
structure ReservoirConfig where
name : String

View File

@@ -119,7 +119,7 @@ def PackageConfig.mkSyntax (cfg : PackageConfig)
|> addDeclFieldD `testDriverArgs cfg.testDriverArgs #[]
|> addDeclFieldD `lintDriver lintDriver ""
|> addDeclFieldD `lintDriverArgs cfg.lintDriverArgs #[]
|> addDeclFieldD `version cfg.version v!"0.0.0"
|> addDeclFieldD `version cfg.version {}
|> addDeclField? `versionTags (quoteVerTags? cfg.versionTags)
|> addDeclFieldD `description cfg.description ""
|> addDeclFieldD `keywords cfg.keywords #[]

View File

@@ -76,7 +76,7 @@ protected def PackageConfig.toToml (cfg : PackageConfig) (t : Table := {}) : Tab
|>.smartInsert `releaseRepo (cfg.releaseRepo <|> cfg.releaseRepo?)
|>.insertD `buildArchive (cfg.buildArchive?.getD cfg.buildArchive) (defaultBuildArchive cfg.name)
|>.insertD `preferReleaseBuild cfg.preferReleaseBuild false
|>.insertD `version cfg.version v!"0.0.0"
|>.insertD `version cfg.version {}
|> smartInsertVerTags cfg.versionTags
|>.smartInsert `keywords cfg.description
|>.smartInsert `keywords cfg.keywords

View File

@@ -275,7 +275,7 @@ structure PackageConfig extends WorkspaceConfig, LeanConfig where
Packages without a defined version default to `0.0.0`.
-/
version : StdVer := v!"0.0.0"
version : StdVer := {}
/--
Git tags of this package's repository that should be treated as versions.

View File

@@ -49,7 +49,7 @@ That is, Lake ignores the `-` suffix.
- `"1.0.0"`: Switches to a semantic versioning scheme
- `"1.1.0"`: Add optional `scope` package entry field
-/
@[inline] def Manifest.version : StdVer := v!"1.1.0"
@[inline] def Manifest.version : StdVer := {major := 1, minor := 1}
/-- Manifest version `0.6.0` package entry. For backwards compatibility. -/
inductive PackageEntryV6
@@ -201,14 +201,14 @@ protected def fromJson? (json : Json) : Except String Manifest := do
if ver.major > 1 then
throw s!"manifest version '{ver}' is of a higher major version than this \
Lake's '{Manifest.version}'; you may need to update your 'lean-toolchain'"
else if ver < v!"0.5.0" then
else if ver < {minor := 5} then
throw s!"incompatible manifest version '{ver}'"
else
let name obj.getD "name" Name.anonymous
let lakeDir obj.getD "lakeDir" defaultLakeDir
let packagesDir? obj.get? "packagesDir"
let packages
if ver < v!"0.7.0" then
if ver < {minor := 7} then
(·.map PackageEntry.ofV6) <$> obj.getD "packages" #[]
else
obj.getD "packages" #[]

View File

@@ -207,7 +207,7 @@ protected def PackageConfig.decodeToml (t : Table) (ref := Syntax.missing) : Exc
let testDriverArgs t.tryDecodeD `testDriverArgs #[]
let lintDriver t.tryDecodeD `lintDriver ""
let lintDriverArgs t.tryDecodeD `lintDriverArgs #[]
let version : StdVer t.tryDecodeD `version v!"0.0.0"
let version : StdVer t.tryDecodeD `version {}
let versionTags optDecodeD defaultVersionTags (t.find? `versionTags)
<| StrPat.decodeToml (presets := versionTagPresets)
let description t.tryDecodeD `description ""

View File

@@ -5,6 +5,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Sebastian Ullrich
*/
#if defined(LEAN_WINDOWS)
#include <icu.h>
#include <windows.h>
#include <io.h>
#define NOMINMAX // prevent ntdef.h from defining min/max macros
@@ -630,6 +631,176 @@ extern "C" LEAN_EXPORT obj_res lean_io_prim_handle_put_str(b_obj_arg h, b_obj_ar
}
}
/* Std.Time.Timestamp.now : IO Timestamp */
extern "C" LEAN_EXPORT obj_res lean_get_current_time(obj_arg /* w */) {
using namespace std::chrono;
std::chrono::system_clock::time_point now = std::chrono::system_clock::now();
long long timestamp = std::chrono::duration_cast<std::chrono::nanoseconds>(now.time_since_epoch()).count();
long long secs = timestamp / 1000000000;
long long nano = timestamp % 1000000000;
lean_object *lean_ts = lean_alloc_ctor(0, 2, 0);
lean_ctor_set(lean_ts, 0, lean_int64_to_int(secs));
lean_ctor_set(lean_ts, 1, lean_int64_to_int(nano));
return lean_io_result_mk_ok(lean_ts);
}
/* Std.Time.Database.Windows.getNextTransition : @&String -> Int64 -> Bool -> IO (Option (Int64 × TimeZone)) */
extern "C" LEAN_EXPORT obj_res lean_windows_get_next_transition(b_obj_arg timezone_str, uint64_t tm_obj, uint8 default_time, obj_arg /* w */) {
#if defined(LEAN_WINDOWS)
UErrorCode status = U_ZERO_ERROR;
const char* dst_name_id = lean_string_cstr(timezone_str);
UChar tzID[256];
u_strFromUTF8(tzID, sizeof(tzID) / sizeof(tzID[0]), NULL, dst_name_id, strlen(dst_name_id), &status);
if (U_FAILURE(status)) {
return lean_io_result_mk_error(lean_decode_io_error(EINVAL, mk_string("failed to read identifier")));
}
UCalendar *cal = ucal_open(tzID, -1, NULL, UCAL_GREGORIAN, &status);
if (U_FAILURE(status)) {
ucal_close(cal);
return lean_io_result_mk_error(lean_decode_io_error(EINVAL, mk_string("failed to open calendar")));
}
int64_t tm = 0;
if (!default_time) {
int64_t timestamp_secs = (int64_t)tm_obj;
ucal_setMillis(cal, timestamp_secs * 1000, &status);
if (U_FAILURE(status)) {
ucal_close(cal);
return lean_io_result_mk_error(lean_decode_io_error(EINVAL, mk_string("failed to set calendar time")));
}
UDate nextTransition;
if (!ucal_getTimeZoneTransitionDate(cal, UCAL_TZ_TRANSITION_NEXT, &nextTransition, &status)) {
ucal_close(cal);
return io_result_mk_ok(mk_option_none());
}
if (U_FAILURE(status)) {
ucal_close(cal);
return lean_io_result_mk_error(lean_decode_io_error(EINVAL, mk_string("failed to get next transation")));
}
tm = (int64_t)(nextTransition / 1000.0);
}
int32_t dst_offset = ucal_get(cal, UCAL_DST_OFFSET, &status);
if (U_FAILURE(status)) {
ucal_close(cal);
return lean_io_result_mk_error(lean_decode_io_error(EINVAL, mk_string("failed to get dst_offset")));
}
int is_dst = dst_offset != 0;
int32_t tzIDLength = ucal_getTimeZoneDisplayName(cal, is_dst ? UCAL_DST : UCAL_STANDARD, "en_US", tzID, 32, &status);
if (U_FAILURE(status)) {
ucal_close(cal);
return lean_io_result_mk_error(lean_decode_io_error(EINVAL, mk_string("failed to timezone identifier")));
}
char dst_name[256];
int32_t dst_name_len;
u_strToUTF8(dst_name, sizeof(dst_name), &dst_name_len, tzID, tzIDLength, &status);
if (U_FAILURE(status)) {
return lean_io_result_mk_error(lean_decode_io_error(EINVAL, mk_string("failed to convert DST name to UTF-8")));
}
UChar display_name[32];
int32_t display_name_len = ucal_getTimeZoneDisplayName(cal, is_dst ? UCAL_SHORT_DST : UCAL_SHORT_STANDARD, "en_US", display_name, 32, &status);
if (U_FAILURE(status)) {
ucal_close(cal);
return lean_io_result_mk_error(lean_decode_io_error(EINVAL, mk_string("failed to read abbreaviation")));
}
char display_name_str[256];
int32_t display_name_str_len;
u_strToUTF8(display_name_str, sizeof(display_name_str), &display_name_str_len, display_name, display_name_len, &status);
if (U_FAILURE(status)) {
ucal_close(cal);
return lean_io_result_mk_error(lean_decode_io_error(EINVAL, mk_string("failed to get abbreviation to cstr")));
}
int32_t zone_offset = ucal_get(cal, UCAL_ZONE_OFFSET, &status);
zone_offset += dst_offset;
if (U_FAILURE(status)) {
ucal_close(cal);
return lean_io_result_mk_error(lean_decode_io_error(EINVAL, mk_string("failed to get zone_offset")));
}
ucal_close(cal);
int offset_seconds = zone_offset / 1000;
lean_object *lean_tz = lean_alloc_ctor(0, 3, 1);
lean_ctor_set(lean_tz, 0, lean_int_to_int(offset_seconds));
lean_ctor_set(lean_tz, 1, lean_mk_string_from_bytes_unchecked(dst_name, dst_name_len));
lean_ctor_set(lean_tz, 2, lean_mk_string_from_bytes_unchecked(display_name_str, display_name_str_len));
lean_ctor_set_uint8(lean_tz, sizeof(void*)*3, is_dst);
lean_object *lean_pair = lean_alloc_ctor(0, 2, 0);
lean_ctor_set(lean_pair, 0, lean_box_uint64((uint64_t)tm));
lean_ctor_set(lean_pair, 1, lean_tz);
return lean_io_result_mk_ok(mk_option_some(lean_pair));
#else
return lean_io_result_mk_error(lean_decode_io_error(EINVAL, mk_string("failed to get timezone, its windows only.")));
#endif
}
/* Std.Time.Database.Windows.getLocalTimeZoneIdentifierAt : Int64 → IO String */
extern "C" LEAN_EXPORT obj_res lean_get_windows_local_timezone_id_at(uint64_t tm_obj, obj_arg /* w */) {
#if defined(LEAN_WINDOWS)
UErrorCode status = U_ZERO_ERROR;
UCalendar* cal = ucal_open(NULL, -1, NULL, UCAL_GREGORIAN, &status);
if (U_FAILURE(status)) {
return lean_io_result_mk_error(lean_decode_io_error(EINVAL, mk_string("failed to open calendar")));
}
int64_t timestamp_secs = (int64_t)tm_obj;
ucal_setMillis(cal, timestamp_secs * 1000, &status);
if (U_FAILURE(status)) {
ucal_close(cal);
return lean_io_result_mk_error(lean_decode_io_error(EINVAL, mk_string("failed to set calendar time")));
}
UChar tzId[256];
int32_t tzIdLength = ucal_getTimeZoneID(cal, tzId, sizeof(tzId) / sizeof(tzId[0]), &status);
ucal_close(cal);
if (U_FAILURE(status)) {
return lean_io_result_mk_error(lean_decode_io_error(EINVAL, mk_string("failed to get timezone ID")));
}
char tzIdStr[256];
u_strToUTF8(tzIdStr, sizeof(tzIdStr), NULL, tzId, tzIdLength, &status);
if (U_FAILURE(status)) {
return lean_io_result_mk_error(lean_decode_io_error(EINVAL, mk_string("failed to convert timezone ID to UTF-8")));
}
return lean_io_result_mk_ok(lean_mk_ascii_string_unchecked(tzIdStr));
#else
return lean_io_result_mk_error(lean_decode_io_error(EINVAL, mk_string("timezone retrieval is Windows-only")));
#endif
}
/* monoMsNow : BaseIO Nat */
extern "C" LEAN_EXPORT obj_res lean_io_mono_ms_now(obj_arg /* w */) {
static_assert(sizeof(std::chrono::milliseconds::rep) <= sizeof(uint64), "size of std::chrono::nanoseconds::rep may not exceed 64");

View File

@@ -1620,6 +1620,21 @@ extern "C" LEAN_EXPORT obj_res lean_float_frexp(double a) {
return r;
}
extern "C" LEAN_EXPORT double lean_float_from_bits(uint64_t u)
{
static_assert(sizeof(double) == sizeof(u), "`double` unexpected size.");
double ret;
std::memcpy(&ret, &u, sizeof(double));
return ret;
}
extern "C" LEAN_EXPORT uint64_t lean_float_to_bits(double d)
{
uint64_t ret;
std::memcpy(&ret, &d, sizeof(double));
return ret;
}
// =======================================
// Strings

Binary file not shown.

Binary file not shown.

Binary file not shown.

BIN
stage0/stdlib/Init/Data/Array/Monadic.c generated Normal file

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

BIN
stage0/stdlib/Init/Data/RArray.c generated Normal file

Binary file not shown.

Binary file not shown.

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