chore: fix apply? error reporting when out of heartbeats

This PR fixes a bug where structural recursion did not work when indices
of the recursive argument appeared as function parameters in a different
order than in the argument's type's definition.

Fixes #6015.

nix/bootstrap.nix

@@ -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

src/Init/Data.lean

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

src/Init/Data/Array/Attach.lean

@@ -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,22 @@ 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

src/Init/Data/Array/Find.lean

@@ -0,0 +1,275 @@
+/-
+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.List.Find
+import Init.Data.Array.Lemmas
+import Init.Data.Array.Attach
+
+/-!
+# Lemmas about `Array.findSome?`, `Array.find?`.
+-/
+
+namespace Array
+
+open Nat
+
+/-! ### findSome? -/
+
+@[simp] theorem findSomeRev?_push_of_isSome (l : Array α) (h : (f a).isSome) : (l.push a).findSomeRev? f = f a := by
+  cases l; simp_all
+
+@[simp] theorem findSomeRev?_push_of_isNone (l : Array α) (h : (f a).isNone) : (l.push a).findSomeRev? f = l.findSomeRev? f := by
+  cases l; simp_all
+
+theorem exists_of_findSome?_eq_some {f : α → Option β} {l : Array α} (w : l.findSome? f = some b) :
+    ∃ a, a ∈ l ∧ f a = b := by
+  cases l; simp_all [List.exists_of_findSome?_eq_some]
+
+@[simp] theorem findSome?_eq_none_iff : findSome? p l = none ↔ ∀ x ∈ l, p x = none := by
+  cases l; simp
+
+@[simp] theorem findSome?_isSome_iff {f : α → Option β} {l : Array α} :
+    (l.findSome? f).isSome ↔ ∃ x, x ∈ l ∧ (f x).isSome := by
+  cases l; simp
+
+theorem findSome?_eq_some_iff {f : α → Option β} {l : Array α} {b : β} :
+    l.findSome? f = some b ↔ ∃ (l₁ : Array α) (a : α) (l₂ : Array α), l = l₁.push a ++ l₂ ∧ f a = some b ∧ ∀ x ∈ l₁, f x = none := by
+  cases l
+  simp only [List.findSome?_toArray, List.findSome?_eq_some_iff]
+  constructor
+  · rintro ⟨l₁, a, l₂, rfl, h₁, h₂⟩
+    exact ⟨l₁.toArray, a, l₂.toArray, by simp_all⟩
+  · rintro ⟨l₁, a, l₂, h₀, h₁, h₂⟩
+    exact ⟨l₁.toList, a, l₂.toList, by simpa using congrArg toList h₀, h₁, by simpa⟩
+
+@[simp] theorem findSome?_guard (l : Array α) : findSome? (Option.guard fun x => p x) l = find? p l := by
+  cases l; simp
+
+@[simp] theorem getElem?_zero_filterMap (f : α → Option β) (l : Array α) : (l.filterMap f)[0]? = l.findSome? f := by
+  cases l; simp [← List.head?_eq_getElem?]
+
+@[simp] theorem getElem_zero_filterMap (f : α → Option β) (l : Array α) (h) :
+    (l.filterMap f)[0] = (l.findSome? f).get (by cases l; simpa [List.length_filterMap_eq_countP] using h) := by
+  cases l; simp [← List.head_eq_getElem, ← getElem?_zero_filterMap]
+
+@[simp] theorem back?_filterMap (f : α → Option β) (l : Array α) : (l.filterMap f).back? = l.findSomeRev? f := by
+  cases l; simp
+
+@[simp] theorem back!_filterMap [Inhabited β] (f : α → Option β) (l : Array α) :
+    (l.filterMap f).back! = (l.findSomeRev? f).getD default := by
+  cases l; simp
+
+@[simp] theorem map_findSome? (f : α → Option β) (g : β → γ) (l : Array α) :
+    (l.findSome? f).map g = l.findSome? (Option.map g ∘ f) := by
+  cases l; simp
+
+theorem findSome?_map (f : β → γ) (l : Array β) : findSome? p (l.map f) = l.findSome? (p ∘ f) := by
+  cases l; simp [List.findSome?_map]
+
+theorem findSome?_append {l₁ l₂ : Array α} : (l₁ ++ l₂).findSome? f = (l₁.findSome? f).or (l₂.findSome? f) := by
+  cases l₁; cases l₂; simp [List.findSome?_append]
+
+theorem getElem?_zero_flatten (L : Array (Array α)) :
+    (flatten L)[0]? = L.findSome? fun l => l[0]? := by
+  cases L using array_array_induction
+  simp [← List.head?_eq_getElem?, List.head?_flatten, List.findSome?_map, Function.comp_def]
+
+theorem getElem_zero_flatten.proof {L : Array (Array α)} (h : 0 < L.flatten.size) :
+    (L.findSome? fun l => l[0]?).isSome := by
+  cases L using array_array_induction
+  simp only [List.findSome?_toArray, List.findSome?_map, Function.comp_def, List.getElem?_toArray,
+    List.findSome?_isSome_iff, List.isSome_getElem?]
+  simp only [flatten_toArray_map_toArray, size_toArray, List.length_flatten,
+    Nat.sum_pos_iff_exists_pos, List.mem_map] at h
+  obtain ⟨_, ⟨xs, m, rfl⟩, h⟩ := h
+  exact ⟨xs, m, by simpa using h⟩
+
+theorem getElem_zero_flatten {L : Array (Array α)} (h) :
+    (flatten L)[0] = (L.findSome? fun l => l[0]?).get (getElem_zero_flatten.proof h) := by
+  have t := getElem?_zero_flatten L
+  simp [getElem?_eq_getElem, h] at t
+  simp [← t]
+
+theorem back?_flatten {L : Array (Array α)} :
+    (flatten L).back? = (L.findSomeRev? fun l => l.back?) := by
+  cases L using array_array_induction
+  simp [List.getLast?_flatten, ← List.map_reverse, List.findSome?_map, Function.comp_def]
+
+theorem findSome?_mkArray : findSome? f (mkArray n a) = if n = 0 then none else f a := by
+  simp [mkArray_eq_toArray_replicate, List.findSome?_replicate]
+
+@[simp] theorem findSome?_mkArray_of_pos (h : 0 < n) : findSome? f (mkArray n a) = f a := by
+  simp [findSome?_mkArray, Nat.ne_of_gt h]
+
+-- Argument is unused, but used to decide whether `simp` should unfold.
+@[simp] theorem findSome?_mkArray_of_isSome (_ : (f a).isSome) :
+   findSome? f (mkArray n a) = if n = 0 then none else f a := by
+  simp [findSome?_mkArray]
+
+@[simp] theorem findSome?_mkArray_of_isNone (h : (f a).isNone) :
+    findSome? f (mkArray n a) = none := by
+  rw [Option.isNone_iff_eq_none] at h
+  simp [findSome?_mkArray, h]
+
+/-! ### find? -/
+
+@[simp] theorem find?_singleton (a : α) (p : α → Bool) :
+    #[a].find? p = if p a then some a else none := by
+  simp [singleton_eq_toArray_singleton]
+
+@[simp] theorem findRev?_push_of_pos (l : Array α) (h : p a) :
+    findRev? p (l.push a) = some a := by
+  cases l; simp [h]
+
+@[simp] theorem findRev?_cons_of_neg (l : Array α) (h : ¬p a) :
+    findRev? p (l.push a) = findRev? p l := by
+  cases l; simp [h]
+
+@[simp] theorem find?_eq_none : find? p l = none ↔ ∀ x ∈ l, ¬ p x := by
+  cases l; simp
+
+theorem find?_eq_some_iff_append {xs : Array α} :
+    xs.find? p = some b ↔ p b ∧ ∃ (as bs : Array α), xs = as.push b ++ bs ∧ ∀ a ∈ as, !p a := by
+  rcases xs with ⟨xs⟩
+  simp only [List.find?_toArray, List.find?_eq_some_iff_append, Bool.not_eq_eq_eq_not,
+    Bool.not_true, exists_and_right, and_congr_right_iff]
+  intro w
+  constructor
+  · rintro ⟨as, ⟨⟨x, rfl⟩, h⟩⟩
+    exact ⟨as.toArray, ⟨x.toArray, by simp⟩ , by simpa using h⟩
+  · rintro ⟨as, ⟨⟨x, h'⟩, h⟩⟩
+    exact ⟨as.toList, ⟨x.toList, by simpa using congrArg Array.toList h'⟩,
+      by simpa using h⟩
+
+@[simp]
+theorem find?_push_eq_some {xs : Array α} :
+    (xs.push a).find? p = some b ↔ xs.find? p = some b ∨ (xs.find? p = none ∧ (p a ∧ a = b)) := by
+  cases xs; simp
+
+@[simp] theorem find?_isSome {xs : Array α} {p : α → Bool} : (xs.find? p).isSome ↔ ∃ x, x ∈ xs ∧ p x := by
+  cases xs; simp
+
+theorem find?_some {xs : Array α} (h : find? p xs = some a) : p a := by
+  cases xs
+  simp at h
+  exact List.find?_some h
+
+theorem mem_of_find?_eq_some {xs : Array α} (h : find? p xs = some a) : a ∈ xs := by
+  cases xs
+  simp at h
+  simpa using List.mem_of_find?_eq_some h
+
+theorem get_find?_mem {xs : Array α} (h) : (xs.find? p).get h ∈ xs := by
+  cases xs
+  simp [List.get_find?_mem]
+
+@[simp] theorem find?_filter {xs : Array α} (p q : α → Bool) :
+    (xs.filter p).find? q = xs.find? (fun a => p a ∧ q a) := by
+  cases xs; simp
+
+@[simp] theorem getElem?_zero_filter (p : α → Bool) (l : Array α) :
+    (l.filter p)[0]? = l.find? p := by
+  cases l; simp [← List.head?_eq_getElem?]
+
+@[simp] theorem getElem_zero_filter (p : α → Bool) (l : Array α) (h) :
+    (l.filter p)[0] =
+      (l.find? p).get (by cases l; simpa [← List.countP_eq_length_filter] using h) := by
+  cases l
+  simp [List.getElem_zero_eq_head]
+
+@[simp] theorem back?_filter (p : α → Bool) (l : Array α) : (l.filter p).back? = l.findRev? p := by
+  cases l; simp
+
+@[simp] theorem back!_filter [Inhabited α] (p : α → Bool) (l : Array α) :
+    (l.filter p).back! = (l.findRev? p).get! := by
+  cases l; simp [Option.get!_eq_getD]
+
+@[simp] theorem find?_filterMap (xs : Array α) (f : α → Option β) (p : β → Bool) :
+    (xs.filterMap f).find? p = (xs.find? (fun a => (f a).any p)).bind f := by
+  cases xs; simp
+
+@[simp] theorem find?_map (f : β → α) (xs : Array β) :
+    find? p (xs.map f) = (xs.find? (p ∘ f)).map f := by
+  cases xs; simp
+
+@[simp] theorem find?_append {l₁ l₂ : Array α} :
+    (l₁ ++ l₂).find? p = (l₁.find? p).or (l₂.find? p) := by
+  cases l₁
+  cases l₂
+  simp
+
+@[simp] theorem find?_flatten (xs : Array (Array α)) (p : α → Bool) :
+    xs.flatten.find? p = xs.findSome? (·.find? p) := by
+  cases xs using array_array_induction
+  simp [List.findSome?_map, Function.comp_def]
+
+theorem find?_flatten_eq_none {xs : Array (Array α)} {p : α → Bool} :
+    xs.flatten.find? p = none ↔ ∀ ys ∈ xs, ∀ x ∈ ys, !p x := by
+  simp
+
+/--
+If `find? p` returns `some a` from `xs.flatten`, then `p a` holds, and
+some array in `xs` contains `a`, and no earlier element of that array satisfies `p`.
+Moreover, no earlier array in `xs` has an element satisfying `p`.
+-/
+theorem find?_flatten_eq_some {xs : Array (Array α)} {p : α → Bool} {a : α} :
+    xs.flatten.find? p = some a ↔
+      p a ∧ ∃ (as : Array (Array α)) (ys zs : Array α) (bs : Array (Array α)),
+        xs = as.push (ys.push a ++ zs) ++ bs ∧
+        (∀ a ∈ as, ∀ x ∈ a, !p x) ∧ (∀ x ∈ ys, !p x) := by
+  cases xs using array_array_induction
+  simp only [flatten_toArray_map_toArray, List.find?_toArray, List.find?_flatten_eq_some]
+  simp only [Bool.not_eq_eq_eq_not, Bool.not_true, exists_and_right, and_congr_right_iff]
+  intro w
+  constructor
+  · rintro ⟨as, ys, ⟨⟨zs, bs, rfl⟩, h₁, h₂⟩⟩
+    exact ⟨as.toArray.map List.toArray, ys.toArray,
+      ⟨zs.toArray, bs.toArray.map List.toArray, by simp⟩, by simpa using h₁, by simpa using h₂⟩
+  · rintro ⟨as, ys, ⟨⟨zs, bs, h⟩, h₁, h₂⟩⟩
+    replace h := congrArg (·.map Array.toList) (congrArg Array.toList h)
+    simp [Function.comp_def] at h
+    exact ⟨as.toList.map Array.toList, ys.toList,
+      ⟨zs.toList, bs.toList.map Array.toList, by simpa using h⟩,
+        by simpa using h₁, by simpa using h₂⟩
+
+@[simp] theorem find?_flatMap (xs : Array α) (f : α → Array β) (p : β → Bool) :
+    (xs.flatMap f).find? p = xs.findSome? (fun x => (f x).find? p) := by
+  cases xs
+  simp [List.find?_flatMap, Array.flatMap_toArray]
+
+theorem find?_flatMap_eq_none {xs : Array α} {f : α → Array β} {p : β → Bool} :
+    (xs.flatMap f).find? p = none ↔ ∀ x ∈ xs, ∀ y ∈ f x, !p y := by
+  simp
+
+theorem find?_mkArray :
+    find? p (mkArray n a) = if n = 0 then none else if p a then some a else none := by
+  simp [mkArray_eq_toArray_replicate, List.find?_replicate]
+
+@[simp] theorem find?_mkArray_of_length_pos (h : 0 < n) :
+    find? p (mkArray n a) = if p a then some a else none := by
+  simp [find?_mkArray, Nat.ne_of_gt h]
+
+@[simp] theorem find?_mkArray_of_pos (h : p a) :
+    find? p (mkArray n a) = if n = 0 then none else some a := by
+  simp [find?_mkArray, h]
+
+@[simp] theorem find?_mkArray_of_neg (h : ¬ p a) : find? p (mkArray n a) = none := by
+  simp [find?_mkArray, h]
+
+-- This isn't a `@[simp]` lemma since there is already a lemma for `l.find? p = none` for any `l`.
+theorem find?_mkArray_eq_none {n : Nat} {a : α} {p : α → Bool} :
+    (mkArray n a).find? p = none ↔ n = 0 ∨ !p a := by
+  simp [mkArray_eq_toArray_replicate, List.find?_replicate_eq_none, Classical.or_iff_not_imp_left]
+
+@[simp] theorem find?_mkArray_eq_some {n : Nat} {a b : α} {p : α → Bool} :
+    (mkArray n a).find? p = some b ↔ n ≠ 0 ∧ p a ∧ a = b := by
+  simp [mkArray_eq_toArray_replicate]
+
+@[simp] theorem get_find?_mkArray (n : Nat) (a : α) (p : α → Bool) (h) :
+    ((mkArray n a).find? p).get h = a := by
+  simp [mkArray_eq_toArray_replicate]
+
+end Array

src/Init/Data/Array/Lemmas.lean

@@ -601,7 +601,7 @@ theorem getElem?_mkArray (n : Nat) (v : α) (i : Nat) :
 
 /-- # mem -/
 
-theorem mem_toList {a : α} {l : Array α} : a ∈ l.toList ↔ a ∈ l := mem_def.symm
+@[simp] theorem mem_toList {a : α} {l : Array α} : a ∈ l.toList ↔ a ∈ l := mem_def.symm
 
 theorem not_mem_nil (a : α) : ¬ a ∈ #[] := nofun
 
@@ -620,19 +620,19 @@ theorem getElem?_of_mem {a : α} {as : Array α} :
 
 @[simp] theorem mem_dite_empty_left {x : α} [Decidable p] {l : ¬ p → Array α} :
     (x ∈ if h : p then #[] else l h) ↔ ∃ h : ¬ p, x ∈ l h := by
-  split <;> simp_all [mem_def]
+  split <;> simp_all
 
 @[simp] theorem mem_dite_empty_right {x : α} [Decidable p] {l : p → Array α} :
     (x ∈ if h : p then l h else #[]) ↔ ∃ h : p, x ∈ l h := by
-  split <;> simp_all [mem_def]
+  split <;> simp_all
 
 @[simp] theorem mem_ite_empty_left {x : α} [Decidable p] {l : Array α} :
     (x ∈ if p then #[] else l) ↔ ¬ p ∧ x ∈ l := by
-  split <;> simp_all [mem_def]
+  split <;> simp_all
 
 @[simp] theorem mem_ite_empty_right {x : α} [Decidable p] {l : Array α} :
     (x ∈ if p then l else #[]) ↔ p ∧ x ∈ l := by
-  split <;> simp_all [mem_def]
+  split <;> simp_all
 
 /-- # get lemmas -/
 
@@ -1218,6 +1218,14 @@ theorem push_eq_append_singleton (as : Array α) (x) : as.push x = as ++ #[x] :=
 @[simp] theorem size_append (as bs : Array α) : (as ++ bs).size = as.size + bs.size := by
   simp only [size, toList_append, List.length_append]
 
+@[simp] theorem empty_append (as : Array α) : #[] ++ as = as := by
+  cases as
+  simp
+
+@[simp] theorem append_empty (as : Array α) : as ++ #[] = as := by
+  cases as
+  simp
+
 theorem getElem_append {as bs : Array α} (h : i < (as ++ bs).size) :
     (as ++ bs)[i] = if h' : i < as.size then as[i] else bs[i - as.size]'(by simp at h; omega) := by
   cases as; cases bs
@@ -1876,6 +1884,50 @@ namespace Array
   induction as
   simp
 
+/-! ### map -/
+
+@[simp] theorem map_map {f : α → β} {g : β → γ} {as : Array α} :
+    (as.map f).map g = as.map (g ∘ f) := by
+  cases as; simp
+
+@[simp] theorem map_id_fun : map (id : α → α) = id := by
+  funext l
+  induction l <;> simp_all
+
+/-- `map_id_fun'` differs from `map_id_fun` by representing the identity function as a lambda, rather than `id`. -/
+@[simp] theorem map_id_fun' : map (fun (a : α) => a) = id := map_id_fun
+
+-- This is not a `@[simp]` lemma because `map_id_fun` will apply.
+theorem map_id (as : Array α) : map (id : α → α) as = as := by
+  cases as <;> simp_all
+
+/-- `map_id'` differs from `map_id` by representing the identity function as a lambda, rather than `id`. -/
+-- This is not a `@[simp]` lemma because `map_id_fun'` will apply.
+theorem map_id' (as : Array α) : map (fun (a : α) => a) as = as := map_id as
+
+/-- Variant of `map_id`, with a side condition that the function is pointwise the identity. -/
+theorem map_id'' {f : α → α} (h : ∀ x, f x = x) (as : Array α) : map f as = as := by
+  simp [show f = id from funext h]
+
+theorem array_array_induction (P : Array (Array α) → Prop) (h : ∀ (xss : List (List α)), P (xss.map List.toArray).toArray)
+    (ass : Array (Array α)) : P ass := by
+  specialize h (ass.toList.map toList)
+  simpa [← toList_map, Function.comp_def, map_id] using h
+
+/-! ### flatten -/
+
+@[simp] theorem flatten_empty : flatten (#[] : Array (Array α)) = #[] := rfl
+
+@[simp] theorem flatten_toArray_map_toArray (xss : List (List α)) :
+    (xss.map List.toArray).toArray.flatten = xss.flatten.toArray := by
+  simp [flatten]
+  suffices ∀ as, List.foldl (fun r a => r ++ a) as (List.map List.toArray xss) = as ++ xss.flatten.toArray by
+    simpa using this #[]
+  intro as
+  induction xss generalizing as with
+  | nil => simp
+  | cons xs xss ih => simp [ih]
+
 /-! ### findSomeRevM?, findRevM?, findSomeRev?, findRev? -/
 
 @[simp] theorem findSomeRevM?_eq_findSomeM?_reverse
@@ -1940,6 +1992,27 @@ namespace Array
   cases as
   simp
 
+@[simp] theorem flatMap_empty {β} (f : α → Array β) : (#[] : Array α).flatMap f = #[] := rfl
+
+@[simp] theorem flatMap_toArray_cons {β} (f : α → Array β) (a : α) (as : List α) :
+    (a :: as).toArray.flatMap f = f a ++ as.toArray.flatMap f := by
+  simp [flatMap]
+  suffices ∀ cs, List.foldl (fun bs a => bs ++ f a) (f a ++ cs) as =
+      f a ++ List.foldl (fun bs a => bs ++ f a) cs as by
+    erw [empty_append] -- Why doesn't this work via `simp`?
+    simpa using this #[]
+  intro cs
+  induction as generalizing cs <;> simp_all
+
+@[simp] theorem flatMap_toArray {β} (f : α → Array β) (as : List α) :
+    as.toArray.flatMap f = (as.flatMap (fun a => (f a).toList)).toArray := by
+  induction as with
+  | nil => simp
+  | cons a as ih =>
+    apply ext'
+    simp [ih]
+
+
 end Array
 
 /-! ### Deprecations -/

src/Init/Data/BitVec/Bitblast.lean

@@ -403,7 +403,7 @@ theorem getLsbD_neg {i : Nat} {x : BitVec w} :
       rw [carry_succ_one _ _ (by omega), ← Bool.xor_not, ← decide_not]
       simp only [add_one_ne_zero, decide_false, getLsbD_not, and_eq_true, decide_eq_true_eq,
         not_eq_eq_eq_not, Bool.not_true, false_bne, not_exists, _root_.not_and, not_eq_true,
-        bne_left_inj, decide_eq_decide]
+        bne_right_inj, decide_eq_decide]
       constructor
       · rintro h j hj; exact And.right <| h j (by omega)
       · rintro h j hj; exact ⟨by omega, h j (by omega)⟩
@@ -419,7 +419,7 @@ theorem getMsbD_neg {i : Nat} {x : BitVec w} :
     simp [hi]; omega
   case pos =>
     have h₁ : w - 1 - i < w := by omega
-    simp only [hi, decide_true, h₁, Bool.true_and, Bool.bne_left_inj, decide_eq_decide]
+    simp only [hi, decide_true, h₁, Bool.true_and, Bool.bne_right_inj, decide_eq_decide]
     constructor
     · rintro ⟨j, hj, h⟩
       refine ⟨w - 1 - j, by omega, by omega, by omega, _root_.cast ?_ h⟩

src/Init/Data/Bool.lean

@@ -238,8 +238,8 @@ theorem not_bne_not : ∀ (x y : Bool), ((!x) != (!y)) = (x != y) := by simp
 @[simp] theorem bne_assoc : ∀ (x y z : Bool), ((x != y) != z) = (x != (y != z)) := by decide
 instance : Std.Associative (· != ·) := ⟨bne_assoc⟩
 
-@[simp] theorem bne_left_inj  : ∀ {x y z : Bool}, (x != y) = (x != z) ↔ y = z := by decide
-@[simp] theorem bne_right_inj : ∀ {x y z : Bool}, (x != z) = (y != z) ↔ x = y := by decide
+@[simp] theorem bne_right_inj  : ∀ {x y z : Bool}, (x != y) = (x != z) ↔ y = z := by decide
+@[simp] theorem bne_left_inj : ∀ {x y z : Bool}, (x != z) = (y != z) ↔ x = y := by decide
 
 theorem eq_not_of_ne : ∀ {x y : Bool}, x ≠ y → x = !y := by decide
 
@@ -295,9 +295,9 @@ theorem xor_right_comm : ∀ (x y z : Bool), ((x ^^ y) ^^ z) = ((x ^^ z) ^^ y) :
 
 theorem xor_assoc : ∀ (x y z : Bool), ((x ^^ y) ^^ z) = (x ^^ (y ^^ z)) := bne_assoc
 
-theorem xor_left_inj : ∀ {x y z : Bool}, (x ^^ y) = (x ^^ z) ↔ y = z := bne_left_inj
+theorem xor_right_inj : ∀ {x y z : Bool}, (x ^^ y) = (x ^^ z) ↔ y = z := bne_right_inj
 
-theorem xor_right_inj : ∀ {x y z : Bool}, (x ^^ z) = (y ^^ z) ↔ x = y := bne_right_inj
+theorem xor_left_inj : ∀ {x y z : Bool}, (x ^^ z) = (y ^^ z) ↔ x = y := bne_left_inj
 
 /-! ### le/lt -/
 

src/Init/Data/Float.lean

@@ -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_of_bits"] opaque Float.ofBits : 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⟩

src/Init/Data/Int/Lemmas.lean

@@ -329,22 +329,22 @@ theorem toNat_sub (m n : Nat) : toNat (m - n) = m - n := by
 /- ## add/sub injectivity -/
 
 @[simp]
-protected theorem add_right_inj {i j : Int} (k : Int) : (i + k = j + k) ↔ i = j := by
+protected theorem add_left_inj {i j : Int} (k : Int) : (i + k = j + k) ↔ i = j := by
   apply Iff.intro
   · intro p
     rw [←Int.add_sub_cancel i k, ←Int.add_sub_cancel j k, p]
   · exact congrArg (· + k)
 
 @[simp]
-protected theorem add_left_inj {i j : Int} (k : Int) : (k + i = k + j) ↔ i = j := by
+protected theorem add_right_inj {i j : Int} (k : Int) : (k + i = k + j) ↔ i = j := by
   simp [Int.add_comm k]
 
 @[simp]
-protected theorem sub_left_inj {i j : Int} (k : Int) : (k - i = k - j) ↔ i = j := by
+protected theorem sub_right_inj {i j : Int} (k : Int) : (k - i = k - j) ↔ i = j := by
   simp [Int.sub_eq_add_neg, Int.neg_inj]
 
 @[simp]
-protected theorem sub_right_inj {i j : Int} (k : Int) : (i - k = j - k) ↔ i = j := by
+protected theorem sub_left_inj {i j : Int} (k : Int) : (i - k = j - k) ↔ i = j := by
   simp [Int.sub_eq_add_neg]
 
 /- ## Ring properties -/

src/Init/Data/List/Basic.lean

@@ -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 α

src/Init/Data/List/Lemmas.lean

@@ -372,6 +372,17 @@ theorem getElem?_concat_length (l : List α) (a : α) : (l ++ [a])[l.length]? =
 @[deprecated getElem?_concat_length (since := "2024-06-12")]
 theorem get?_concat_length (l : List α) (a : α) : (l ++ [a]).get? l.length = some a := by simp
 
+@[simp] theorem isSome_getElem? {l : List α} {n : Nat} : l[n]?.isSome ↔ n < l.length := by
+  by_cases h : n < l.length
+  · simp_all
+  · simp [h]
+    simp_all
+
+@[simp] theorem isNone_getElem? {l : List α} {n : Nat} : l[n]?.isNone ↔ l.length ≤ n := by
+  by_cases h : n < l.length
+  · simp_all
+  · simp [h]
+
 /-! ### mem -/
 
 @[simp] theorem not_mem_nil (a : α) : ¬ a ∈ [] := nofun
@@ -1025,6 +1036,10 @@ theorem getLast_eq_getElem : ∀ (l : List α) (h : l ≠ []),
   | _ :: _ :: _, _ => by
     simp [getLast, get, Nat.succ_sub_succ, getLast_eq_getElem]
 
+theorem getElem_length_sub_one_eq_getLast (l : List α) (h) :
+    l[l.length - 1] = getLast l (by cases l; simp at h; simp) := by
+  rw [← getLast_eq_getElem]
+
 @[deprecated getLast_eq_getElem (since := "2024-07-15")]
 theorem getLast_eq_get (l : List α) (h : l ≠ []) :
     getLast l h = l.get ⟨l.length - 1, by
@@ -1149,6 +1164,11 @@ theorem head_eq_getElem (l : List α) (h : l ≠ []) : head l h = l[0]'(length_p
   | nil => simp at h
   | cons _ _ => simp
 
+theorem getElem_zero_eq_head (l : List α) (h) : l[0] = head l (by simpa [length_pos] using h) := by
+  cases l with
+  | nil => simp at h
+  | cons _ _ => simp
+
 theorem head_eq_iff_head?_eq_some {xs : List α} (h) : xs.head h = a ↔ xs.head? = some a := by
   cases xs with
   | nil => simp at h

src/Init/Data/Nat/Lemmas.lean

@@ -1029,3 +1029,12 @@ instance decidableExistsLT [h : DecidablePred p] : DecidablePred fun n => ∃ m
 instance decidableExistsLE [DecidablePred p] : DecidablePred fun n => ∃ m : Nat, m ≤ n ∧ p m :=
   fun n => decidable_of_iff (∃ m, m < n + 1 ∧ p m)
     (exists_congr fun _ => and_congr_left' Nat.lt_succ_iff)
+
+/-! ### Results about `List.sum` specialized to `Nat` -/
+
+protected theorem sum_pos_iff_exists_pos {l : List Nat} : 0 < l.sum ↔ ∃ x ∈ l, 0 < x := by
+  induction l with
+  | nil => simp
+  | cons x xs ih =>
+    simp [← ih]
+    omega

src/Init/Data/Nat/Linear.lean

@@ -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)

src/Init/Data/Option/Lemmas.lean

@@ -55,7 +55,9 @@ theorem get_eq_getD {fallback : α} : (o : Option α) → {h : o.isSome} → o.g
 theorem some_get! [Inhabited α] : (o : Option α) → o.isSome → some (o.get!) = o
   | some _, _ => rfl
 
-theorem get!_eq_getD_default [Inhabited α] (o : Option α) : o.get! = o.getD default := rfl
+theorem get!_eq_getD [Inhabited α] (o : Option α) : o.get! = o.getD default := rfl
+
+@[deprecated get!_eq_getD (since := "2024-11-18")] abbrev get!_eq_getD_default := @get!_eq_getD
 
 theorem mem_unique {o : Option α} {a b : α} (ha : a ∈ o) (hb : b ∈ o) : a = b :=
   some.inj <| ha ▸ hb

src/Init/Data/RArray.lean

@@ -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

src/Init/System/IO.lean

@@ -802,6 +802,9 @@ def run (args : SpawnArgs) : IO String := do
 
 end Process
 
+/-- Returns the thread ID of the calling thread. -/
+@[extern "lean_io_get_tid"] opaque getTID : BaseIO UInt64
+
 structure AccessRight where
   read : Bool := false
   write : Bool := false

src/Init/Tactics.lean

@@ -1155,7 +1155,7 @@ Configuration for the `decide` tactic family.
 structure DecideConfig where
   /-- If true (default: false), then use only kernel reduction when reducing the `Decidable` instance.
   This is more efficient, since the default mode reduces twice (once in the elaborator and again in the kernel),
-  however kernel reduction ignores transparency settings. The `decide!` tactic is a synonym for `decide +kernel`. -/
+  however kernel reduction ignores transparency settings. -/
   kernel : Bool := false
   /-- If true (default: false), then uses the native code compiler to evaluate the `Decidable` instance,
   admitting the result via the axiom `Lean.ofReduceBool`.  This can be significantly more efficient,
@@ -1165,7 +1165,9 @@ structure DecideConfig where
   native : Bool := false
   /-- If true (default: true), then when preprocessing the goal, do zeta reduction to attempt to eliminate free variables. -/
   zetaReduce : Bool := true
-  /-- If true (default: false), then when preprocessing reverts free variables. -/
+  /-- If true (default: false), then when preprocessing, removes irrelevant variables and reverts the local context.
+  A variable is *relevant* if it appears in the target, if it appears in a relevant variable,
+  or if it is a proposition that refers to a relevant variable. -/
   revert : Bool := false
 
 /--
@@ -1240,17 +1242,6 @@ example : 1 + 1 = 2 := by rfl
 -/
 syntax (name := decide) "decide" optConfig : tactic
 
-/--
-`decide!` is a variant of the `decide` tactic that uses kernel reduction to prove the goal.
-It has the following properties:
-- Since it uses kernel reduction instead of elaborator reduction, it ignores transparency and can unfold everything.
-- While `decide` needs to reduce the `Decidable` instance twice (once during elaboration to verify whether the tactic succeeds,
-  and once during kernel type checking), the `decide!` tactic reduces it exactly once.
-
-The `decide!` syntax is short for `decide +kernel`.
--/
-syntax (name := decideBang) "decide!" optConfig : tactic
-
 /--
 `native_decide` is a synonym for `decide +native`.
 It will attempt to prove a goal of type `p` by synthesizing an instance

src/Lean/Compiler/ConstFolding.lean

@@ -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),

src/Lean/Data.lean

@@ -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

src/Lean/Data/RArray.lean

@@ -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

src/Lean/Elab/Command.lean

@@ -555,7 +555,11 @@ private def getVarDecls (s : State) : Array Syntax :=
 instance {α} : Inhabited (CommandElabM α) where
   default := throw default
 
-private def mkMetaContext : Meta.Context := {
+/--
+The environment linter framework needs to be able to run linters with the same context
+as `liftTermElabM`, so we expose that context as a public function here.
+-/
+def mkMetaContext : Meta.Context := {
   config := { foApprox := true, ctxApprox := true, quasiPatternApprox := true }
 }
 

src/Lean/Elab/PreDefinition/Structural/FindRecArg.lean

@@ -243,7 +243,7 @@ def tryAllArgs (fnNames : Array Name) (xs : Array Expr) (values : Array Expr)
     recArgInfoss := recArgInfoss.push recArgInfos
   -- Put non-indices first
   recArgInfoss := recArgInfoss.map nonIndicesFirst
-  trace[Elab.definition.structural] "recArgInfoss: {recArgInfoss.map (·.map (·.recArgPos))}"
+  trace[Elab.definition.structural] "recArgInfos:{indentD (.joinSep (recArgInfoss.flatten.toList.map (repr ·)) Format.line)}"
   -- Inductive groups to consider
   let groups ← inductiveGroups recArgInfoss.flatten
   trace[Elab.definition.structural] "inductive groups: {groups}"

src/Lean/Elab/PreDefinition/Structural/IndGroupInfo.lean

@@ -27,7 +27,7 @@ constituents.
 structure IndGroupInfo where
   all       : Array Name
   numNested : Nat
-deriving BEq, Inhabited
+deriving BEq, Inhabited, Repr
 
 def IndGroupInfo.ofInductiveVal (indInfo : InductiveVal) : IndGroupInfo where
   all       := indInfo.all.toArray
@@ -56,7 +56,7 @@ mutual structural recursion on such incompatible types.
 structure IndGroupInst extends IndGroupInfo where
   levels    : List Level
   params    : Array Expr
-deriving Inhabited
+deriving Inhabited, Repr
 
 def IndGroupInst.toMessageData (igi : IndGroupInst) : MessageData :=
   mkAppN (.const igi.all[0]! igi.levels) igi.params

src/Lean/Elab/PreDefinition/Structural/RecArgInfo.lean

@@ -23,9 +23,9 @@ structure RecArgInfo where
   fnName       : Name
   /-- the fixed prefix of arguments of the function we are trying to justify termination using structural recursion. -/
   numFixed     : Nat
-  /-- position of the argument (counted including fixed prefix) we are recursing on -/
+  /-- position (counted including fixed prefix) of the argument we are recursing on -/
   recArgPos    : Nat
-  /-- position of the indices (counted including fixed prefix) of the inductive datatype indices we are recursing on -/
+  /-- position (counted including fixed prefix) of the indices of the inductive datatype we are recursing on -/
   indicesPos   : Array Nat
   /-- The inductive group (with parameters) of the argument's type -/
   indGroupInst : IndGroupInst
@@ -34,20 +34,23 @@ structure RecArgInfo where
   If `< indAll.all`, a normal data type, else an auxiliary data type due to nested recursion
   -/
   indIdx       : Nat
-deriving Inhabited
+deriving Inhabited, Repr
 
 /--
 If `xs` are the parameters of the functions (excluding fixed prefix), partitions them
 into indices and major arguments, and other parameters.
 -/
 def RecArgInfo.pickIndicesMajor (info : RecArgInfo) (xs : Array Expr) : (Array Expr × Array Expr) := Id.run do
+  -- First indices and major arg, using the order they appear in `info.indicesPos`
   let mut indexMajorArgs := #[]
+  let indexMajorPos := info.indicesPos.push info.recArgPos
+  for j in indexMajorPos do
+    assert! info.numFixed ≤ j && j - info.numFixed < xs.size
+    indexMajorArgs := indexMajorArgs.push xs[j - info.numFixed]!
+  -- Then the other arguments, in the order they appear in `xs`
   let mut otherArgs := #[]
   for h : i in [:xs.size] do
-    let j := i + info.numFixed
-    if j = info.recArgPos || info.indicesPos.contains j then
-      indexMajorArgs := indexMajorArgs.push xs[i]
-    else
+    unless indexMajorPos.contains (i + info.numFixed) do
       otherArgs := otherArgs.push xs[i]
   return (indexMajorArgs, otherArgs)
 

src/Lean/Elab/StructInst.lean

@@ -11,21 +11,40 @@ import Lean.Elab.App
 import Lean.Elab.Binders
 import Lean.PrettyPrinter
 
+/-!
+# Structure instance elaborator
+
+A *structure instance* is notation to construct a term of a `structure`.
+Examples: `{ x := 2, y.z := true }`, `{ s with cache := c' }`, and `{ s with values[2] := v }`.
+Structure instances are the preferred way to invoke a `structure`'s constructor,
+since they hide Lean implementation details such as whether parents are represented as subobjects,
+and also they do correct processing of default values, which are complicated due to the fact that `structure`s can override default values of their parents.
+
+This module elaborates structure instance notation.
+Note that the `where` syntax to define structures (`Lean.Parser.Command.whereStructInst`)
+macro expands into the structure instance notation elaborated by this module.
+-/
+
 namespace Lean.Elab.Term.StructInst
 
 open Meta
 open TSyntax.Compat
 
-/-
-  Structure instances are of the form:
-
-      "{" >> optional (atomic (sepBy1 termParser ", " >> " with "))
-          >> manyIndent (group ((structInstFieldAbbrev <|> structInstField) >> optional ", "))
-          >> optEllipsis
-          >> optional (" : " >> termParser)
-          >> " }"
+/-!
+Recall that structure instances are of the form:
+```
+"{" >> optional (atomic (sepBy1 termParser ", " >> " with "))
+    >> manyIndent (group ((structInstFieldAbbrev <|> structInstField) >> optional ", "))
+    >> optEllipsis
+    >> optional (" : " >> termParser)
+    >> " }"
+```
 -/
 
+/--
+Transforms structure instances such as `{ x := 0 : Foo }` into `({ x := 0 } : Foo)`.
+Structure instance notation makes use of the expected type.
+-/
 @[builtin_macro Lean.Parser.Term.structInst] def expandStructInstExpectedType : Macro := fun stx =>
   let expectedArg := stx[4]
   if expectedArg.isNone then
@@ -35,7 +54,10 @@ open TSyntax.Compat
     let stxNew   := stx.setArg 4 mkNullNode
     `(($stxNew : $expected))
 
-/-- Expand field abbreviations. Example: `{ x, y := 0 }` expands to `{ x := x, y := 0 }` -/
+/--
+Expands field abbreviation notation.
+Example: `{ x, y := 0 }` expands to `{ x := x, y := 0 }`.
+-/
 @[builtin_macro Lean.Parser.Term.structInst] def expandStructInstFieldAbbrev : Macro
   | `({ $[$srcs,* with]? $fields,* $[..%$ell]? $[: $ty]? }) =>
     if fields.getElems.raw.any (·.getKind == ``Lean.Parser.Term.structInstFieldAbbrev) then do
@@ -49,9 +71,12 @@ open TSyntax.Compat
   | _ => Macro.throwUnsupported
 
 /--
-  If `stx` is of the form `{ s₁, ..., sₙ with ... }` and `sᵢ` is not a local variable, expand into `let src := sᵢ; { ..., src, ... with ... }`.
+If `stx` is of the form `{ s₁, ..., sₙ with ... }` and `sᵢ` is not a local variable,
+expands into `let __src := sᵢ; { ..., __src, ... with ... }`.
+The significance of `__src` is that the variable is treated as an implementation-detail local variable,
+which can be unfolded by `simp` when `zetaDelta := false`.
 
-  Note that this one is not a `Macro` because we need to access the local context.
+Note that this one is not a `Macro` because we need to access the local context.
 -/
 private def expandNonAtomicExplicitSources (stx : Syntax) : TermElabM (Option Syntax) := do
   let sourcesOpt := stx[1]
@@ -100,27 +125,44 @@ where
           let r ← go sources (sourcesNew.push sourceNew)
           `(let __src := $source; $r)
 
-structure ExplicitSourceInfo where
+/--
+An *explicit source* is one of the structures `sᵢ` that appear in `{ s₁, …, sₙ with … }`.
+-/
+structure ExplicitSourceView where
+  /-- The syntax of the explicit source. -/
   stx        : Syntax
+  /-- The name of the structure for the type of the explicit source. -/
   structName : Name
   deriving Inhabited
 
-structure Source where
-  explicit : Array ExplicitSourceInfo -- `s₁ ... sₙ with`
-  implicit : Option Syntax -- `..`
+/--
+A view of the sources of fields for the structure instance notation.
+-/
+structure SourcesView where
+  /-- Explicit sources (i.e., one of the structures `sᵢ` that appear in `{ s₁, …, sₙ with … }`). -/
+  explicit : Array ExplicitSourceView
+  /-- The syntax for a trailing `..`. This is "ellipsis mode" for missing fields, similar to ellipsis mode for applications. -/
+  implicit : Option Syntax
   deriving Inhabited
 
-def Source.isNone : Source → Bool
+/-- Returns `true` if the structure instance has no sources (neither explicit sources nor a `..`). -/
+def SourcesView.isNone : SourcesView → Bool
   | { explicit := #[], implicit := none } => true
   | _ => false
 
-/-- `optional (atomic (sepBy1 termParser ", " >> " with ")` -/
+/--
+Given an array of explicit sources, returns syntax of the form
+`optional (atomic (sepBy1 termParser ", " >> " with ")`
+-/
 private def mkSourcesWithSyntax (sources : Array Syntax) : Syntax :=
   let ref := sources[0]!
   let stx := Syntax.mkSep sources (mkAtomFrom ref ", ")
   mkNullNode #[stx, mkAtomFrom ref "with "]
 
-private def getStructSource (structStx : Syntax) : TermElabM Source :=
+/--
+Creates a structure source view from structure instance notation.
+-/
+private def getStructSources (structStx : Syntax) : TermElabM SourcesView :=
   withRef structStx do
     let explicitSource := structStx[1]
     let implicitSource := structStx[3]
@@ -138,10 +180,10 @@ private def getStructSource (structStx : Syntax) : TermElabM Source :=
     return { explicit, implicit }
 
 /--
-  We say a `{ ... }` notation is a `modifyOp` if it contains only one
-  ```
-  def structInstArrayRef := leading_parser "[" >> termParser >>"]"
-  ```
+We say a structure instance notation is a "modifyOp" if it contains only a single array update.
+```lean
+def structInstArrayRef := leading_parser "[" >> termParser >>"]"
+```
 -/
 private def isModifyOp? (stx : Syntax) : TermElabM (Option Syntax) := do
   let s? ← stx[2].getSepArgs.foldlM (init := none) fun s? arg => do
@@ -177,7 +219,11 @@ private def isModifyOp? (stx : Syntax) : TermElabM (Option Syntax) := do
   | none   => return none
   | some s => if s[0][0].getKind == ``Lean.Parser.Term.structInstArrayRef then return s? else return none
 
-private def elabModifyOp (stx modifyOp : Syntax) (sources : Array ExplicitSourceInfo) (expectedType? : Option Expr) : TermElabM Expr := do
+/--
+Given a `stx` that is a structure instance notation that's a modifyOp (according to `isModifyOp?`), elaborates it.
+Only supports structure instances with a single source.
+-/
+private def elabModifyOp (stx modifyOp : Syntax) (sources : Array ExplicitSourceView) (expectedType? : Option Expr) : TermElabM Expr := do
   if sources.size > 1 then
     throwError "invalid \{...} notation, multiple sources and array update is not supported."
   let cont (val : Syntax) : TermElabM Expr := do
@@ -204,12 +250,13 @@ private def elabModifyOp (stx modifyOp : Syntax) (sources : Array ExplicitSource
     cont val
 
 /--
-  Get structure name.
-  This method triest to postpone execution if the expected type is not available.
+Gets the structure name for the structure instance from the expected type and the sources.
+This method tries to postpone execution if the expected type is not available.
 
-  If the expected type is available and it is a structure, then we use it.
-  Otherwise, we use the type of the first source. -/
-private def getStructName (expectedType? : Option Expr) (sourceView : Source) : TermElabM Name := do
+If the expected type is available and it is a structure, then we use it.
+Otherwise, we use the type of the first source.
+-/
+private def getStructName (expectedType? : Option Expr) (sourceView : SourcesView) : TermElabM Name := do
   tryPostponeIfNoneOrMVar expectedType?
   let useSource : Unit → TermElabM Name := fun _ => do
     unless sourceView.explicit.isEmpty do
@@ -226,7 +273,7 @@ private def getStructName (expectedType? : Option Expr) (sourceView : Source) :
       unless isStructure (← getEnv) constName do
         throwError "invalid \{...} notation, structure type expected{indentExpr expectedType}"
       return constName
-    | _                        => useSource ()
+    | _ => useSource ()
 where
   throwUnknownExpectedType :=
     throwError "invalid \{...} notation, expected type is not known"
@@ -237,72 +284,92 @@ where
     else
       throwError "invalid \{...} notation, {kind} type is not of the form (C ...){indentExpr type}"
 
+/--
+A component of a left-hand side for a field appearing in structure instance syntax.
+-/
 inductive FieldLHS where
+  /-- A name component for a field left-hand side. For example, `x` and `y` in `{ x.y := v }`. -/
   | fieldName  (ref : Syntax) (name : Name)
+  /-- A numeric index component for a field left-hand side. For example `3` in `{ x.3 := v }`. -/
   | fieldIndex (ref : Syntax) (idx : Nat)
+  /-- An array indexing component for a field left-hand side. For example `[3]` in `{ arr[3] := v }`. -/
   | modifyOp   (ref : Syntax) (index : Syntax)
   deriving Inhabited
 
-instance : ToFormat FieldLHS := ⟨fun lhs =>
-  match lhs with
-  | .fieldName _ n  => format n
-  | .fieldIndex _ i => format i
-  | .modifyOp _ i   => "[" ++ i.prettyPrint ++ "]"⟩
+instance : ToFormat FieldLHS where
+  format
+    | .fieldName _ n  => format n
+    | .fieldIndex _ i => format i
+    | .modifyOp _ i   => "[" ++ i.prettyPrint ++ "]"
 
+/--
+`FieldVal StructInstView` is a representation of a field value in the structure instance.
+-/
 inductive FieldVal (σ : Type) where
-  | term  (stx : Syntax) : FieldVal σ
+  /-- A `term` to use for the value of the field. -/
+  | term (stx : Syntax)  : FieldVal σ
+  /-- A `StructInstView` to use for the value of a subobject field. -/
   | nested (s : σ)       : FieldVal σ
-  | default              : FieldVal σ -- mark that field must be synthesized using default value
+  /-- A field that was not provided and should be synthesized using default values. -/
+  | default              : FieldVal σ
   deriving Inhabited
 
+/--
+`Field StructInstView` is a representation of a field in the structure instance.
+-/
 structure Field (σ : Type) where
+  /-- The whole field syntax. -/
   ref   : Syntax
+  /-- The LHS decomposed into components. -/
   lhs   : List FieldLHS
+  /-- The value of the field. -/
   val   : FieldVal σ
+  /-- The elaborated field value, filled in at `elabStruct`.
+  Missing fields use a metavariable for the elaborated value and are later solved for in `DefaultFields.propagate`. -/
   expr? : Option Expr := none
   deriving Inhabited
 
+/--
+Returns if the field has a single component in its LHS.
+-/
 def Field.isSimple {σ} : Field σ → Bool
   | { lhs := [_], .. } => true
   | _                  => false
 
-inductive Struct where
-  /-- Remark: the field `params` is use for default value propagation. It is initially empty, and then set at `elabStruct`. -/
-  | mk (ref : Syntax) (structName : Name) (params : Array (Name × Expr)) (fields : List (Field Struct)) (source : Source)
+/--
+The view for structure instance notation.
+-/
+structure StructInstView where
+  /-- The syntax for the whole structure instance. -/
+  ref : Syntax
+  /-- The name of the structure for the type of the structure instance. -/
+  structName : Name
+  /-- Used for default values, to propagate structure type parameters. It is initially empty, and then set at `elabStruct`. -/
+  params : Array (Name × Expr)
+  /-- The fields of the structure instance. -/
+  fields : List (Field StructInstView)
+  /-- The additional sources for fields for the structure instance. -/
+  sources : SourcesView
   deriving Inhabited
 
-abbrev Fields := List (Field Struct)
-
-def Struct.ref : Struct → Syntax
-  | ⟨ref, _, _, _, _⟩ => ref
-
-def Struct.structName : Struct → Name
-  | ⟨_, structName, _, _, _⟩ => structName
-
-def Struct.params : Struct → Array (Name × Expr)
-  | ⟨_, _, params, _, _⟩ => params
-
-def Struct.fields : Struct → Fields
-  | ⟨_, _, _, fields, _⟩ => fields
-
-def Struct.source : Struct → Source
-  | ⟨_, _, _, _, s⟩ => s
+/-- Abbreviation for the type of `StructInstView.fields`, namely `List (Field StructInstView)`. -/
+abbrev Fields := List (Field StructInstView)
 
 /-- `true` iff all fields of the given structure are marked as `default` -/
-partial def Struct.allDefault (s : Struct) : Bool :=
+partial def StructInstView.allDefault (s : StructInstView) : Bool :=
   s.fields.all fun { val := val,  .. } => match val with
     | .term _   => false
     | .default  => true
     | .nested s => allDefault s
 
-def formatField (formatStruct : Struct → Format) (field : Field Struct) : Format :=
+def formatField (formatStruct : StructInstView → Format) (field : Field StructInstView) : Format :=
   Format.joinSep field.lhs " . " ++ " := " ++
     match field.val with
     | .term v   => v.prettyPrint
     | .nested s => formatStruct s
     | .default  => "<default>"
 
-partial def formatStruct : Struct → Format
+partial def formatStruct : StructInstView → Format
   | ⟨_, _,          _, fields, source⟩ =>
     let fieldsFmt := Format.joinSep (fields.map (formatField formatStruct)) ", "
     let implicitFmt := if source.implicit.isSome then " .. " else ""
@@ -311,31 +378,39 @@ partial def formatStruct : Struct → Format
     else
       "{" ++ format (source.explicit.map (·.stx)) ++ " with " ++ fieldsFmt ++ implicitFmt ++ "}"
 
-instance : ToFormat Struct     := ⟨formatStruct⟩
-instance : ToString Struct := ⟨toString ∘ format⟩
+instance : ToFormat StructInstView     := ⟨formatStruct⟩
+instance : ToString StructInstView := ⟨toString ∘ format⟩
 
-instance : ToFormat (Field Struct) := ⟨formatField formatStruct⟩
-instance : ToString (Field Struct) := ⟨toString ∘ format⟩
+instance : ToFormat (Field StructInstView) := ⟨formatField formatStruct⟩
+instance : ToString (Field StructInstView) := ⟨toString ∘ format⟩
+
+/--
+Converts a `FieldLHS` back into syntax. This assumes the `ref` fields have the correct structure.
 
-/-
 Recall that `structInstField` elements have the form
-```
-   def structInstField  := leading_parser structInstLVal >> " := " >> termParser
-   def structInstLVal   := leading_parser (ident <|> numLit <|> structInstArrayRef) >> many (("." >> (ident <|> numLit)) <|> structInstArrayRef)
-   def structInstArrayRef := leading_parser "[" >> termParser >>"]"
+```lean
+def structInstField  := leading_parser structInstLVal >> " := " >> termParser
+def structInstLVal   := leading_parser (ident <|> numLit <|> structInstArrayRef) >> many (("." >> (ident <|> numLit)) <|> structInstArrayRef)
+def structInstArrayRef := leading_parser "[" >> termParser >>"]"
 ```
 -/
 -- Remark: this code relies on the fact that `expandStruct` only transforms `fieldLHS.fieldName`
-def FieldLHS.toSyntax (first : Bool) : FieldLHS → Syntax
+private def FieldLHS.toSyntax (first : Bool) : FieldLHS → Syntax
   | .modifyOp   stx _    => stx
   | .fieldName  stx name => if first then mkIdentFrom stx name else mkGroupNode #[mkAtomFrom stx ".", mkIdentFrom stx name]
   | .fieldIndex stx _    => if first then stx else mkGroupNode #[mkAtomFrom stx ".", stx]
 
-def FieldVal.toSyntax : FieldVal Struct → Syntax
+/--
+Converts a `FieldVal StructInstView` back into syntax. Only supports `.term`, and it assumes the `stx` field has the correct structure.
+-/
+private def FieldVal.toSyntax : FieldVal Struct → Syntax
   | .term stx => stx
-  | _                 => unreachable!
+  | _         => unreachable!
 
-def Field.toSyntax : Field Struct → Syntax
+/--
+Converts a `Field StructInstView` back into syntax. Used to construct synthetic structure instance notation for subobjects in `StructInst.expandStruct` processing.
+-/
+private def Field.toSyntax : Field Struct → Syntax
   | field =>
     let stx := field.ref
     let stx := stx.setArg 2 field.val.toSyntax
@@ -343,6 +418,7 @@ def Field.toSyntax : Field Struct → Syntax
     | first::rest => stx.setArg 0 <| mkNullNode #[first.toSyntax true, mkNullNode <| rest.toArray.map (FieldLHS.toSyntax false) ]
     | _ => unreachable!
 
+/-- Creates a view of a field left-hand side. -/
 private def toFieldLHS (stx : Syntax) : MacroM FieldLHS :=
   if stx.getKind == ``Lean.Parser.Term.structInstArrayRef then
     return FieldLHS.modifyOp stx stx[1]
@@ -355,7 +431,12 @@ private def toFieldLHS (stx : Syntax) : MacroM FieldLHS :=
       | some idx => return FieldLHS.fieldIndex stx idx
       | none     => Macro.throwError "unexpected structure syntax"
 
-private def mkStructView (stx : Syntax) (structName : Name) (source : Source) : MacroM Struct := do
+/--
+Creates a structure instance view from structure instance notation
+and the computed structure name (from `Lean.Elab.Term.StructInst.getStructName`)
+and structure source view (from `Lean.Elab.Term.StructInst.getStructSources`).
+-/
+private def mkStructView (stx : Syntax) (structName : Name) (sources : SourcesView) : MacroM StructInstView := do
   /- Recall that `stx` is of the form
      ```
      leading_parser "{" >> optional (atomic (sepBy1 termParser ", " >> " with "))
@@ -371,24 +452,18 @@ private def mkStructView (stx : Syntax) (structName : Name) (source : Source) :
     let val      := fieldStx[2]
     let first    ← toFieldLHS fieldStx[0][0]
     let rest     ← fieldStx[0][1].getArgs.toList.mapM toFieldLHS
-    return { ref := fieldStx, lhs := first :: rest, val := FieldVal.term val : Field Struct }
-  return ⟨stx, structName, #[], fields, source⟩
+    return { ref := fieldStx, lhs := first :: rest, val := FieldVal.term val : Field StructInstView }
+  return { ref := stx, structName, params := #[], fields, sources }
 
-def Struct.modifyFieldsM {m : Type → Type} [Monad m] (s : Struct) (f : Fields → m Fields) : m Struct :=
+def StructInstView.modifyFieldsM {m : Type → Type} [Monad m] (s : StructInstView) (f : Fields → m Fields) : m StructInstView :=
   match s with
-  | ⟨ref, structName, params, fields, source⟩ => return ⟨ref, structName, params, (← f fields), source⟩
+  | { ref, structName, params, fields, sources } => return { ref, structName, params, fields := (← f fields), sources }
 
-def Struct.modifyFields (s : Struct) (f : Fields → Fields) : Struct :=
+def StructInstView.modifyFields (s : StructInstView) (f : Fields → Fields) : StructInstView :=
   Id.run <| s.modifyFieldsM f
 
-def Struct.setFields (s : Struct) (fields : Fields) : Struct :=
-  s.modifyFields fun _ => fields
-
-def Struct.setParams (s : Struct) (ps : Array (Name × Expr)) : Struct :=
-  match s with
-  | ⟨ref, structName, _, fields, source⟩ => ⟨ref, structName, ps, fields, source⟩
-
-private def expandCompositeFields (s : Struct) : Struct :=
+/-- Expands name field LHSs with multi-component names into multi-component LHSs. -/
+private def expandCompositeFields (s : StructInstView) : StructInstView :=
   s.modifyFields fun fields => fields.map fun field => match field with
     | { lhs := .fieldName _ (.str Name.anonymous ..) :: _, .. } => field
     | { lhs := .fieldName ref n@(.str ..) :: rest, .. } =>
@@ -396,7 +471,8 @@ private def expandCompositeFields (s : Struct) : Struct :=
       { field with lhs := newEntries ++ rest }
     | _ => field
 
-private def expandNumLitFields (s : Struct) : TermElabM Struct :=
+/-- Replaces numeric index field LHSs with the corresponding named field, or throws an error if no such field exists. -/
+private def expandNumLitFields (s : StructInstView) : TermElabM StructInstView :=
   s.modifyFieldsM fun fields => do
     let env ← getEnv
     let fieldNames := getStructureFields env s.structName
@@ -407,28 +483,31 @@ private def expandNumLitFields (s : Struct) : TermElabM Struct :=
         else return { field with lhs := .fieldName ref fieldNames[idx - 1]! :: rest }
       | _ => return field
 
-/-- For example, consider the following structures:
-   ```
-   structure A where
-     x : Nat
+/--
+Expands fields that are actually represented as fields of subobject fields.
 
-   structure B extends A where
-     y : Nat
+For example, consider the following structures:
+```
+structure A where
+  x : Nat
 
-   structure C extends B where
-     z : Bool
-   ```
-   This method expands parent structure fields using the path to the parent structure.
-   For example,
-   ```
-   { x := 0, y := 0, z := true : C }
-   ```
-   is expanded into
-   ```
-   { toB.toA.x := 0, toB.y := 0, z := true : C }
-   ```
+structure B extends A where
+  y : Nat
+
+structure C extends B where
+  z : Bool
+```
+This method expands parent structure fields using the path to the parent structure.
+For example,
+```
+{ x := 0, y := 0, z := true : C }
+```
+is expanded into
+```
+{ toB.toA.x := 0, toB.y := 0, z := true : C }
+```
 -/
-private def expandParentFields (s : Struct) : TermElabM Struct := do
+private def expandParentFields (s : StructInstView) : TermElabM StructInstView := do
   let env ← getEnv
   s.modifyFieldsM fun fields => fields.mapM fun field => do match field with
     | { lhs := .fieldName ref fieldName :: _,    .. } =>
@@ -448,6 +527,11 @@ private def expandParentFields (s : Struct) : TermElabM Struct := do
 
 private abbrev FieldMap := Std.HashMap Name Fields
 
+/--
+Creates a hash map collecting all fields with the same first name component.
+Throws an error if there are multiple simple fields with the same name.
+Used by `StructInst.expandStruct` processing.
+-/
 private def mkFieldMap (fields : Fields) : TermElabM FieldMap :=
   fields.foldlM (init := {}) fun fieldMap field =>
     match field.lhs with
@@ -461,15 +545,16 @@ private def mkFieldMap (fields : Fields) : TermElabM FieldMap :=
       | _ => return fieldMap.insert fieldName [field]
     | _ => unreachable!
 
-private def isSimpleField? : Fields → Option (Field Struct)
+/--
+Given a value of the hash map created by `mkFieldMap`, returns true if the value corresponds to a simple field.
+-/
+private def isSimpleField? : Fields → Option (Field StructInstView)
   | [field] => if field.isSimple then some field else none
   | _       => none
 
-private def getFieldIdx (structName : Name) (fieldNames : Array Name) (fieldName : Name) : TermElabM Nat := do
-  match fieldNames.findIdx? fun n => n == fieldName with
-  | some idx => return idx
-  | none     => throwError "field '{fieldName}' is not a valid field of '{structName}'"
-
+/--
+Creates projection notation for the given structure field. Used
+-/
 def mkProjStx? (s : Syntax) (structName : Name) (fieldName : Name) : TermElabM (Option Syntax) := do
   if (findField? (← getEnv) structName fieldName).isNone then
     return none
@@ -478,7 +563,10 @@ def mkProjStx? (s : Syntax) (structName : Name) (fieldName : Name) : TermElabM (
       #[mkAtomFrom s "@",
         mkNode ``Parser.Term.proj #[s, mkAtomFrom s ".", mkIdentFrom s fieldName]]
 
-def findField? (fields : Fields) (fieldName : Name) : Option (Field Struct) :=
+/--
+Finds a simple field of the given name.
+-/
+def findField? (fields : Fields) (fieldName : Name) : Option (Field StructInstView) :=
   fields.find? fun field =>
     match field.lhs with
     | [.fieldName _ n] => n == fieldName
@@ -486,7 +574,10 @@ def findField? (fields : Fields) (fieldName : Name) : Option (Field Struct) :=
 
 mutual
 
-  private partial def groupFields (s : Struct) : TermElabM Struct := do
+  /--
+  Groups compound fields according to which subobject they are from.
+  -/
+  private partial def groupFields (s : StructInstView) : TermElabM StructInstView := do
     let env ← getEnv
     withRef s.ref do
     s.modifyFieldsM fun fields => do
@@ -499,14 +590,14 @@ mutual
           let field := fields.head!
           match Lean.isSubobjectField? env s.structName fieldName with
           | some substructName =>
-            let substruct := Struct.mk s.ref substructName #[] substructFields s.source
+            let substruct := { ref := s.ref, structName := substructName, params := #[], fields := substructFields, sources := s.sources }
             let substruct ← expandStruct substruct
             pure { field with lhs := [field.lhs.head!], val := FieldVal.nested substruct }
           | none =>
             let updateSource (structStx : Syntax) : TermElabM Syntax := do
-              let sourcesNew ← s.source.explicit.filterMapM fun source => mkProjStx? source.stx source.structName fieldName
+              let sourcesNew ← s.sources.explicit.filterMapM fun source => mkProjStx? source.stx source.structName fieldName
               let explicitSourceStx := if sourcesNew.isEmpty then mkNullNode else mkSourcesWithSyntax sourcesNew
-              let implicitSourceStx := s.source.implicit.getD mkNullNode
+              let implicitSourceStx := s.sources.implicit.getD mkNullNode
               return (structStx.setArg 1 explicitSourceStx).setArg 3 implicitSourceStx
             let valStx := s.ref -- construct substructure syntax using s.ref as template
             let valStx := valStx.setArg 4 mkNullNode -- erase optional expected type
@@ -518,7 +609,7 @@ mutual
   Adds in the missing fields using the explicit sources.
   Invariant: a missing field always comes from the first source that can provide it.
   -/
-  private partial def addMissingFields (s : Struct) : TermElabM Struct := do
+  private partial def addMissingFields (s : StructInstView) : TermElabM StructInstView := do
     let env ← getEnv
     let fieldNames := getStructureFields env s.structName
     let ref := s.ref.mkSynthetic
@@ -527,7 +618,7 @@ mutual
         match findField? s.fields fieldName with
         | some field => return field::fields
         | none       =>
-          let addField (val : FieldVal Struct) : TermElabM Fields := do
+          let addField (val : FieldVal StructInstView) : TermElabM Fields := do
             return { ref, lhs := [FieldLHS.fieldName ref fieldName], val := val } :: fields
           match Lean.isSubobjectField? env s.structName fieldName with
           | some substructName =>
@@ -535,8 +626,8 @@ mutual
             let downFields := getStructureFieldsFlattened env substructName false
             -- Filter out all explicit sources that do not share a leaf field keeping
             -- structure with no fields
-            let filtered := s.source.explicit.filter fun source =>
-              let sourceFields := getStructureFieldsFlattened env source.structName false
+            let filtered := s.sources.explicit.filter fun sources =>
+              let sourceFields := getStructureFieldsFlattened env sources.structName false
               sourceFields.any (fun name => downFields.contains name) || sourceFields.isEmpty
             -- Take the first such one remaining
             match filtered[0]? with
@@ -550,27 +641,30 @@ mutual
               -- No sources could provide this subobject in the proper order.
               -- Recurse to handle default values for fields.
               else
-                let substruct := Struct.mk ref substructName #[] [] s.source
+                let substruct := { ref, structName := substructName, params := #[], fields := [], sources := s.sources }
                 let substruct ← expandStruct substruct
                 addField (FieldVal.nested substruct)
             -- No sources could provide this subobject.
             -- Recurse to handle default values for fields.
             | none =>
-              let substruct := Struct.mk ref substructName #[] [] s.source
+              let substruct := { ref, structName := substructName, params := #[], fields := [], sources := s.sources }
               let substruct ← expandStruct substruct
               addField (FieldVal.nested substruct)
           -- Since this is not a subobject field, we are free to use the first source that can
             -- provide it.
           | none =>
-            if let some val ← s.source.explicit.findSomeM? fun source => mkProjStx? source.stx source.structName fieldName then
+            if let some val ← s.sources.explicit.findSomeM? fun source => mkProjStx? source.stx source.structName fieldName then
               addField (FieldVal.term val)
-            else if s.source.implicit.isSome then
+            else if s.sources.implicit.isSome then
               addField (FieldVal.term (mkHole ref))
             else
               addField FieldVal.default
-      return s.setFields fields.reverse
+      return { s with fields := fields.reverse }
 
-  private partial def expandStruct (s : Struct) : TermElabM Struct := do
+  /--
+  Expands all fields of the structure instance, consolidates compound fields into subobject fields, and adds missing fields.
+  -/
+  private partial def expandStruct (s : StructInstView) : TermElabM StructInstView := do
     let s := expandCompositeFields s
     let s ← expandNumLitFields s
     let s ← expandParentFields s
@@ -579,10 +673,17 @@ mutual
 
 end
 
+/--
+The constructor to use for the structure instance notation.
+-/
 structure CtorHeaderResult where
+  /-- The constructor function with applied structure parameters. -/
   ctorFn     : Expr
+  /-- The type of `ctorFn` -/
   ctorFnType : Expr
+  /-- Instance metavariables for structure parameters that are instance implicit. -/
   instMVars  : Array MVarId
+  /-- Type parameter names and metavariables for each parameter. Used to seed `StructInstView.params`. -/
   params     : Array (Name × Expr)
 
 private def mkCtorHeaderAux : Nat → Expr → Expr → Array MVarId → Array (Name × Expr) → TermElabM CtorHeaderResult
@@ -604,6 +705,7 @@ private partial def getForallBody : Nat → Expr → Option Expr
   | _+1, _                => none
   | 0,   type             => type
 
+/-- Attempts to use the expected type to solve for structure parameters. -/
 private def propagateExpectedType (type : Expr) (numFields : Nat) (expectedType? : Option Expr) : TermElabM Unit := do
   match expectedType? with
   | none              => return ()
@@ -614,6 +716,7 @@ private def propagateExpectedType (type : Expr) (numFields : Nat) (expectedType?
         unless typeBody.hasLooseBVars do
           discard <| isDefEq expectedType typeBody
 
+/-- Elaborates the structure constructor using the expected type, filling in all structure parameters. -/
 private def mkCtorHeader (ctorVal : ConstructorVal) (expectedType? : Option Expr) : TermElabM CtorHeaderResult := do
   let us ← mkFreshLevelMVars ctorVal.levelParams.length
   let val  := Lean.mkConst ctorVal.name us
@@ -623,32 +726,43 @@ private def mkCtorHeader (ctorVal : ConstructorVal) (expectedType? : Option Expr
   synthesizeAppInstMVars r.instMVars r.ctorFn
   return r
 
+/-- Annotates an expression that it is a value for a missing field. -/
 def markDefaultMissing (e : Expr) : Expr :=
   mkAnnotation `structInstDefault e
 
+/-- If the expression has been annotated by `markDefaultMissing`, returns the unannotated expression. -/
 def defaultMissing? (e : Expr) : Option Expr :=
   annotation? `structInstDefault e
 
+/-- Throws "failed to elaborate field" error. -/
 def throwFailedToElabField {α} (fieldName : Name) (structName : Name) (msgData : MessageData) : TermElabM α :=
   throwError "failed to elaborate field '{fieldName}' of '{structName}, {msgData}"
 
-def trySynthStructInstance? (s : Struct) (expectedType : Expr) : TermElabM (Option Expr) := do
+/-- If the struct has all-missing fields, tries to synthesize the structure using typeclass inference. -/
+def trySynthStructInstance? (s : StructInstView) (expectedType : Expr) : TermElabM (Option Expr) := do
   if !s.allDefault then
     return none
   else
     try synthInstance? expectedType catch _ => return none
 
+/-- The result of elaborating a `StructInstView` structure instance view. -/
 structure ElabStructResult where
+  /-- The elaborated value. -/
   val       : Expr
-  struct    : Struct
+  /-- The modified `StructInstView` view after elaboration. -/
+  struct    : StructInstView
+  /-- Metavariables for instance implicit fields. These will be registered after default value propagation. -/
   instMVars : Array MVarId
 
-private partial def elabStruct (s : Struct) (expectedType? : Option Expr) : TermElabM ElabStructResult := withRef s.ref do
+/--
+Main elaborator for structure instances.
+-/
+private partial def elabStructInstView (s : StructInstView) (expectedType? : Option Expr) : TermElabM ElabStructResult := withRef s.ref do
   let env ← getEnv
   let ctorVal := getStructureCtor env s.structName
   if isPrivateNameFromImportedModule env ctorVal.name then
     throwError "invalid \{...} notation, constructor for `{s.structName}` is marked as private"
-  -- We store the parameters at the resulting `Struct`. We use this information during default value propagation.
+  -- We store the parameters at the resulting `StructInstView`. We use this information during default value propagation.
   let { ctorFn, ctorFnType, params, .. } ← mkCtorHeader ctorVal expectedType?
   let (e, _, fields, instMVars) ← s.fields.foldlM (init := (ctorFn, ctorFnType, [], #[])) fun (e, type, fields, instMVars) field => do
     match field.lhs with
@@ -657,7 +771,7 @@ private partial def elabStruct (s : Struct) (expectedType? : Option Expr) : Term
       trace[Elab.struct] "elabStruct {field}, {type}"
       match type with
       | .forallE _ d b bi =>
-        let cont (val : Expr) (field : Field Struct) (instMVars := instMVars) : TermElabM (Expr × Expr × Fields × Array MVarId) := do
+        let cont (val : Expr) (field : Field StructInstView) (instMVars := instMVars) : TermElabM (Expr × Expr × Fields × Array MVarId) := do
           pushInfoTree <| InfoTree.node (children := {}) <| Info.ofFieldInfo {
             projName := s.structName.append fieldName, fieldName, lctx := (← getLCtx), val, stx := ref }
           let e     := mkApp e val
@@ -671,7 +785,7 @@ private partial def elabStruct (s : Struct) (expectedType? : Option Expr) : Term
           match (← trySynthStructInstance? s d) with
           | some val => cont val { field with val := FieldVal.term (mkHole field.ref) }
           | none     =>
-            let { val, struct := sNew, instMVars := instMVarsNew } ← elabStruct s (some d)
+            let { val, struct := sNew, instMVars := instMVarsNew } ← elabStructInstView s (some d)
             let val ← ensureHasType d val
             cont val { field with val := FieldVal.nested sNew } (instMVars ++ instMVarsNew)
         | .default  =>
@@ -700,17 +814,21 @@ private partial def elabStruct (s : Struct) (expectedType? : Option Expr) : Term
               cont (markDefaultMissing val) field
       | _ => withRef field.ref <| throwFailedToElabField fieldName s.structName m!"unexpected constructor type{indentExpr type}"
     | _ => throwErrorAt field.ref "unexpected unexpanded structure field"
-  return { val := e, struct := s.setFields fields.reverse |>.setParams params, instMVars }
+  return { val := e, struct := { s with fields := fields.reverse, params }, instMVars }
 
 namespace DefaultFields
 
+/--
+Context for default value propagation.
+-/
 structure Context where
-  -- We must search for default values overridden in derived structures
-  structs : Array Struct := #[]
+  /-- The current path through `.nested` subobject structures. We must search for default values overridden in derived structures. -/
+  structs : Array StructInstView := #[]
+  /-- The collection of structures that could provide a default value. -/
   allStructNames : Array Name := #[]
   /--
   Consider the following example:
-  ```
+  ```lean
   structure A where
     x : Nat := 1
 
@@ -736,22 +854,29 @@ structure Context where
   -/
   maxDistance : Nat := 0
 
+/--
+State for default value propagation
+-/
 structure State where
+  /-- Whether progress has been made so far on this round of the propagation loop. -/
   progress : Bool := false
 
-partial def collectStructNames (struct : Struct) (names : Array Name) : Array Name :=
+/-- Collects all structures that may provide default values for fields. -/
+partial def collectStructNames (struct : StructInstView) (names : Array Name) : Array Name :=
   let names := names.push struct.structName
   struct.fields.foldl (init := names) fun names field =>
     match field.val with
     | .nested struct => collectStructNames struct names
     | _ => names
 
-partial def getHierarchyDepth (struct : Struct) : Nat :=
+/-- Gets the maximum nesting depth of subobjects. -/
+partial def getHierarchyDepth (struct : StructInstView) : Nat :=
   struct.fields.foldl (init := 0) fun max field =>
     match field.val with
     | .nested struct => Nat.max max (getHierarchyDepth struct + 1)
     | _ => max
 
+/-- Returns whether the field is still missing. -/
 def isDefaultMissing? [Monad m] [MonadMCtx m] (field : Field Struct) : m Bool := do
   if let some expr := field.expr? then
     if let some (.mvar mvarId) := defaultMissing? expr then
@@ -759,40 +884,51 @@ def isDefaultMissing? [Monad m] [MonadMCtx m] (field : Field Struct) : m Bool :=
         return true
   return false
 
-partial def findDefaultMissing? [Monad m] [MonadMCtx m] (struct : Struct) : m (Option (Field Struct)) :=
+/-- Returns a field that is still missing. -/
+partial def findDefaultMissing? [Monad m] [MonadMCtx m] (struct : StructInstView) : m (Option (Field StructInstView)) :=
   struct.fields.findSomeM? fun field => do
    match field.val with
    | .nested struct => findDefaultMissing? struct
    | _ => return if (← isDefaultMissing? field) then field else none
 
-partial def allDefaultMissing [Monad m] [MonadMCtx m] (struct : Struct) : m (Array (Field Struct)) :=
+/-- Returns all fields that are still missing. -/
+partial def allDefaultMissing [Monad m] [MonadMCtx m] (struct : StructInstView) : m (Array (Field StructInstView)) :=
   go struct *> get |>.run' #[]
 where
-  go (struct : Struct) : StateT (Array (Field Struct)) m Unit :=
+  go (struct : StructInstView) : StateT (Array (Field StructInstView)) m Unit :=
     for field in struct.fields do
       if let .nested struct := field.val then
         go struct
       else if (← isDefaultMissing? field) then
         modify (·.push field)
 
-def getFieldName (field : Field Struct) : Name :=
+/-- Returns the name of the field. Assumes all fields under consideration are simple and named. -/
+def getFieldName (field : Field StructInstView) : Name :=
   match field.lhs with
   | [.fieldName _ fieldName] => fieldName
   | _ => unreachable!
 
 abbrev M := ReaderT Context (StateRefT State TermElabM)
 
+/-- Returns whether we should interrupt the round because we have made progress allowing nonzero depth. -/
 def isRoundDone : M Bool := do
   return (← get).progress && (← read).maxDistance > 0
 
-def getFieldValue? (struct : Struct) (fieldName : Name) : Option Expr :=
+/-- Returns the `expr?` for the given field. -/
+def getFieldValue? (struct : StructInstView) (fieldName : Name) : Option Expr :=
   struct.fields.findSome? fun field =>
     if getFieldName field == fieldName then
       field.expr?
     else
       none
 
-partial def mkDefaultValueAux? (struct : Struct) : Expr → TermElabM (Option Expr)
+/-- Instantiates a default value from the given default value declaration, if applicable. -/
+partial def mkDefaultValue? (struct : StructInstView) (cinfo : ConstantInfo) : TermElabM (Option Expr) :=
+  withRef struct.ref do
+  let us ← mkFreshLevelMVarsFor cinfo
+  process (← instantiateValueLevelParams cinfo us)
+where
+  process : Expr → TermElabM (Option Expr)
   | .lam n d b c => withRef struct.ref do
     if c.isExplicit then
       let fieldName := n
@@ -801,29 +937,26 @@ partial def mkDefaultValueAux? (struct : Struct) : Expr → TermElabM (Option Ex
       | some val =>
         let valType ← inferType val
         if (← isDefEq valType d) then
-          mkDefaultValueAux? struct (b.instantiate1 val)
+          process (b.instantiate1 val)
         else
           return none
     else
       if let some (_, param) := struct.params.find? fun (paramName, _) => paramName == n then
         -- Recall that we did not use to have support for parameter propagation here.
         if (← isDefEq (← inferType param) d) then
-          mkDefaultValueAux? struct (b.instantiate1 param)
+          process (b.instantiate1 param)
         else
           return none
       else
         let arg ← mkFreshExprMVar d
-        mkDefaultValueAux? struct (b.instantiate1 arg)
+        process (b.instantiate1 arg)
   | e =>
     let_expr id _ a := e | return some e
     return some a
 
-def mkDefaultValue? (struct : Struct) (cinfo : ConstantInfo) : TermElabM (Option Expr) :=
-  withRef struct.ref do
-  let us ← mkFreshLevelMVarsFor cinfo
-  mkDefaultValueAux? struct (← instantiateValueLevelParams cinfo us)
-
-/-- Reduce default value. It performs beta reduction and projections of the given structures. -/
+/--
+Reduces a default value. It performs beta reduction and projections of the given structures to reduce them to the provided values for fields.
+-/
 partial def reduce (structNames : Array Name) (e : Expr) : MetaM Expr := do
   match e with
   | .forallE ..   =>
@@ -880,7 +1013,10 @@ where
     else
       k
 
-partial def tryToSynthesizeDefault (structs : Array Struct) (allStructNames : Array Name) (maxDistance : Nat) (fieldName : Name) (mvarId : MVarId) : TermElabM Bool :=
+/--
+Attempts to synthesize a default value for a missing field `fieldName` using default values from each structure in `structs`.
+-/
+def tryToSynthesizeDefault (structs : Array StructInstView) (allStructNames : Array Name) (maxDistance : Nat) (fieldName : Name) (mvarId : MVarId) : TermElabM Bool :=
   let rec loop (i : Nat) (dist : Nat) := do
     if dist > maxDistance then
       return false
@@ -900,14 +1036,25 @@ partial def tryToSynthesizeDefault (structs : Array Struct) (allStructNames : Ar
           | none   =>
             let mvarDecl ← getMVarDecl mvarId
             let val ← ensureHasType mvarDecl.type val
-            mvarId.assign val
-            return true
+            /-
+            We must use `checkedAssign` here to ensure we do not create a cyclic
+            assignment. See #3150.
+            This can happen when there are holes in the the fields the default value
+            depends on.
+            Possible improvement: create a new `_` instead of returning `false` when
+            `checkedAssign` fails. Reason: the field will not be needed after the
+            other `_` are resolved by the user.
+            -/
+            mvarId.checkedAssign val
       | _ => loop (i+1) dist
     else
       return false
   loop 0 0
 
-partial def step (struct : Struct) : M Unit :=
+/--
+Performs one step of default value synthesis.
+-/
+partial def step (struct : StructInstView) : M Unit :=
   unless (← isRoundDone) do
     withReader (fun ctx => { ctx with structs := ctx.structs.push struct }) do
       for field in struct.fields do
@@ -924,7 +1071,10 @@ partial def step (struct : Struct) : M Unit :=
                   modify fun _ => { progress := true }
             | _ => pure ()
 
-partial def propagateLoop (hierarchyDepth : Nat) (d : Nat) (struct : Struct) : M Unit := do
+/--
+Main entry point to default value synthesis in the `M` monad.
+-/
+partial def propagateLoop (hierarchyDepth : Nat) (d : Nat) (struct : StructInstView) : M Unit := do
   match (← findDefaultMissing? struct) with
   | none       => return () -- Done
   | some field =>
@@ -947,16 +1097,22 @@ partial def propagateLoop (hierarchyDepth : Nat) (d : Nat) (struct : Struct) : M
       else
         propagateLoop hierarchyDepth (d+1) struct
 
-def propagate (struct : Struct) : TermElabM Unit :=
+/--
+Synthesizes default values for all missing fields, if possible.
+-/
+def propagate (struct : StructInstView) : TermElabM Unit :=
   let hierarchyDepth := getHierarchyDepth struct
   let structNames := collectStructNames struct #[]
   propagateLoop hierarchyDepth 0 struct { allStructNames := structNames } |>.run' {}
 
 end DefaultFields
 
-private def elabStructInstAux (stx : Syntax) (expectedType? : Option Expr) (source : Source) : TermElabM Expr := do
-  let structName ← getStructName expectedType? source
-  let struct ← liftMacroM <| mkStructView stx structName source
+/--
+Main entry point to elaborator for structure instance notation, unless the structure instance is a modifyOp.
+-/
+private def elabStructInstAux (stx : Syntax) (expectedType? : Option Expr) (sources : SourcesView) : TermElabM Expr := do
+  let structName ← getStructName expectedType? sources
+  let struct ← liftMacroM <| mkStructView stx structName sources
   let struct ← expandStruct struct
   trace[Elab.struct] "{struct}"
   /- We try to synthesize pending problems with `withSynthesize` combinator before trying to use default values.
@@ -974,7 +1130,7 @@ private def elabStructInstAux (stx : Syntax) (expectedType? : Option Expr) (sour
 
      TODO: investigate whether this design decision may have unintended side effects or produce confusing behavior.
   -/
-  let { val := r, struct, instMVars } ← withSynthesize (postpone := .yes) <| elabStruct struct expectedType?
+  let { val := r, struct, instMVars } ← withSynthesize (postpone := .yes) <| elabStructInstView struct expectedType?
   trace[Elab.struct] "before propagate {r}"
   DefaultFields.propagate struct
   synthesizeAppInstMVars instMVars r
@@ -984,13 +1140,13 @@ private def elabStructInstAux (stx : Syntax) (expectedType? : Option Expr) (sour
   match (← expandNonAtomicExplicitSources stx) with
   | some stxNew => withMacroExpansion stx stxNew <| elabTerm stxNew expectedType?
   | none =>
-    let sourceView ← getStructSource stx
+    let sourcesView ← getStructSources stx
     if let some modifyOp ← isModifyOp? stx then
-      if sourceView.explicit.isEmpty then
+      if sourcesView.explicit.isEmpty then
         throwError "invalid \{...} notation, explicit source is required when using '[<index>] := <value>'"
-      elabModifyOp stx modifyOp sourceView.explicit expectedType?
+      elabModifyOp stx modifyOp sourcesView.explicit expectedType?
     else
-      elabStructInstAux stx expectedType? sourceView
+      elabStructInstAux stx expectedType? sourcesView
 
 builtin_initialize
   registerTraceClass `Elab.struct

src/Lean/Elab/Syntax.lean

@@ -233,11 +233,15 @@ 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 != '\'' || "''".isPrefixOf s) &&
     s.front != '\"' &&
+    !(isIdBeginEscape 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

src/Lean/Elab/Tactic/BVDecide/Frontend/Normalize.lean

@@ -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

src/Lean/Elab/Tactic/Change.lean

@@ -13,6 +13,31 @@ open Meta
 # Implementation of the `change` tactic
 -/
 
+/--
+Elaborates the pattern `p` and ensures that it is defeq to `e`.
+Emulates `(show p from ?m : e)`, returning the type of `?m`, but `e` and `p` do not need to be types.
+Unlike `(show p from ?m : e)`, this can assign synthetic opaque metavariables appearing in `p`.
+-/
+def elabChange (e : Expr) (p : Term) : TacticM Expr := do
+  let p ← runTermElab do
+    let p ← Term.elabTermEnsuringType p (← inferType e)
+    unless ← isDefEq p e do
+      /-
+      Sometimes isDefEq can fail due to postponed elaboration problems.
+      We synthesize pending synthetic mvars while allowing typeclass instances to be postponed,
+      which might enable solving for them with an additional `isDefEq`.
+      -/
+      Term.synthesizeSyntheticMVars (postpone := .partial)
+      discard <| isDefEq p e
+    pure p
+  withAssignableSyntheticOpaque do
+    unless ← isDefEq p e do
+      let (p, tgt) ← addPPExplicitToExposeDiff p e
+      throwError "\
+        'change' tactic failed, pattern{indentExpr p}\n\
+        is not definitionally equal to target{indentExpr tgt}"
+    instantiateMVars p
+
 /-- `change` can be used to replace the main goal or its hypotheses with
 different, yet definitionally equal, goal or hypotheses.
 
@@ -38,15 +63,13 @@ the main goal. -/
   | `(tactic| change $newType:term $[$loc:location]?) => do
     withLocation (expandOptLocation (Lean.mkOptionalNode loc))
       (atLocal := fun h => do
-        let hTy ← h.getType
-        -- This is a hack to get the new type to elaborate in the same sort of way that
-        -- it would for a `show` expression for the goal.
-        let mvar ← mkFreshExprMVar none
-        let (_, mvars) ← elabTermWithHoles
-                          (← `(term | show $newType from $(← Term.exprToSyntax mvar))) hTy `change
+        let (hTy', mvars) ← withCollectingNewGoalsFrom (elabChange (← h.getType) newType) (← getMainTag) `change
         liftMetaTactic fun mvarId => do
-          return (← mvarId.changeLocalDecl h (← inferType mvar)) :: mvars)
-      (atTarget := evalTactic <| ← `(tactic| refine_lift show $newType from ?_))
-      (failed := fun _ => throwError "change tactic failed")
+          return (← mvarId.changeLocalDecl h hTy') :: mvars)
+      (atTarget := do
+        let (tgt', mvars) ← withCollectingNewGoalsFrom (elabChange (← getMainTarget) newType) (← getMainTag) `change
+        liftMetaTactic fun mvarId => do
+          return (← mvarId.replaceTargetDefEq tgt') :: mvars)
+      (failed := fun _ => throwError "'change' tactic failed")
 
 end Lean.Elab.Tactic

src/Lean/Elab/Tactic/Conv/Change.lean

@@ -5,6 +5,7 @@ Authors: Leonardo de Moura
 -/
 prelude
 import Lean.Elab.Tactic.ElabTerm
+import Lean.Elab.Tactic.Change
 import Lean.Elab.Tactic.Conv.Basic
 
 namespace Lean.Elab.Tactic.Conv
@@ -15,11 +16,9 @@ open Meta
   | `(conv| change $e) => withMainContext do
     let lhs ← getLhs
     let mvarCounterSaved := (← getMCtx).mvarCounter
-    let r ← elabTermEnsuringType e (← inferType lhs)
-    logUnassignedAndAbort (← filterOldMVars (← getMVars r) mvarCounterSaved)
-    unless (← isDefEqGuarded r lhs) do
-      throwError "invalid 'change' conv tactic, term{indentExpr r}\nis not definitionally equal to current left-hand-side{indentExpr lhs}"
-    changeLhs r
+    let lhs' ← elabChange lhs e
+    logUnassignedAndAbort (← filterOldMVars (← getMVars lhs') mvarCounterSaved)
+    changeLhs lhs'
   | _ => throwUnsupportedSyntax
 
 end Lean.Elab.Tactic.Conv

src/Lean/Elab/Tactic/DiscrTreeKey.lean

@@ -18,21 +18,22 @@ private def mkKey (e : Expr) (simp : Bool) : MetaM (Array Key) := do
   let (_, _, type) ← withReducible <| forallMetaTelescopeReducing e
   let type ← whnfR type
   if simp then
-    if let some (_, lhs, _) := type.eq? then
-      mkPath lhs simpDtConfig
-    else if let some (lhs, _) := type.iff? then
-      mkPath lhs simpDtConfig
-    else if let some (_, lhs, _) := type.ne? then
-      mkPath lhs simpDtConfig
-    else if let some p := type.not? then
-      match p.eq? with
-      | some (_, lhs, _) =>
-        mkPath lhs simpDtConfig
-      | _ => mkPath p simpDtConfig
-    else
-      mkPath type simpDtConfig
+    withSimpGlobalConfig do
+      if let some (_, lhs, _) := type.eq? then
+        mkPath lhs
+      else if let some (lhs, _) := type.iff? then
+        mkPath lhs
+      else if let some (_, lhs, _) := type.ne? then
+        mkPath lhs
+      else if let some p := type.not? then
+        match p.eq? with
+        | some (_, lhs, _) =>
+          mkPath lhs
+        | _ => mkPath p
+      else
+        mkPath type
   else
-    mkPath type {}
+    mkPath type
 
 private def getType (t : TSyntax `term) : TermElabM Expr := do
   if let `($id:ident) := t then

src/Lean/Elab/Tactic/ElabTerm.lean

@@ -542,11 +542,6 @@ declare_config_elab elabDecideConfig Parser.Tactic.DecideConfig
   let cfg ← elabDecideConfig stx[1]
   evalDecideCore `decide cfg
 
-@[builtin_tactic Lean.Parser.Tactic.decideBang] def evalDecideBang : Tactic := fun stx => do
-  let cfg ← elabDecideConfig stx[1]
-  let cfg := { cfg with kernel := true }
-  evalDecideCore `decide! cfg
-
 @[builtin_tactic Lean.Parser.Tactic.nativeDecide] def evalNativeDecide : Tactic := fun stx => do
   let cfg ← elabDecideConfig stx[1]
   let cfg := { cfg with native := true }

src/Lean/Elab/Tactic/Ext.lean

@@ -195,9 +195,6 @@ structure ExtTheorems where
   erased  : PHashSet Name := {}
   deriving Inhabited
 
-/-- Discrimation tree settings for the `ext` extension. -/
-def extExt.config : WhnfCoreConfig := {}
-
 /-- The environment extension to track `@[ext]` theorems. -/
 builtin_initialize extExtension :
     SimpleScopedEnvExtension ExtTheorem ExtTheorems ←
@@ -211,7 +208,7 @@ builtin_initialize extExtension :
 ordered from high priority to low. -/
 @[inline] def getExtTheorems (ty : Expr) : MetaM (Array ExtTheorem) := do
   let extTheorems := extExtension.getState (← getEnv)
-  let arr ← extTheorems.tree.getMatch ty extExt.config
+  let arr ← extTheorems.tree.getMatch ty
   let erasedArr := arr.filter fun thm => !extTheorems.erased.contains thm.declName
   -- Using insertion sort because it is stable and the list of matches should be mostly sorted.
   -- Most ext theorems have default priority.
@@ -258,7 +255,7 @@ builtin_initialize registerBuiltinAttribute {
       but this theorem proves{indentD declTy}"
     let some (ty, lhs, rhs) := declTy.eq? | failNotEq
     unless lhs.isMVar && rhs.isMVar do failNotEq
-    let keys ← withReducible <| DiscrTree.mkPath ty extExt.config
+    let keys ← withReducible <| DiscrTree.mkPath ty
     let priority ← liftCommandElabM <| Elab.liftMacroM do evalPrio (prio.getD (← `(prio| default)))
     extExtension.add {declName, keys, priority} kind
     -- Realize iff theorem

src/Lean/Elab/Tactic/LibrarySearch.lean

@@ -40,7 +40,7 @@ def exact? (ref : Syntax) (required : Option (Array (TSyntax `term))) (requireCl
     | some suggestions =>
       if requireClose then throwError
         "`exact?` could not close the goal. Try `apply?` to see partial suggestions."
-      reportOutOfHeartbeats `library_search ref
+      reportOutOfHeartbeats `apply? ref
       for (_, suggestionMCtx) in suggestions do
         withMCtx suggestionMCtx do
           addExactSuggestion ref (← instantiateMVars (mkMVar mvar)).headBeta (addSubgoalsMsg := true)

src/Lean/Elab/Tactic/Simp.lean

@@ -91,7 +91,7 @@ def elabSimpConfig (optConfig : Syntax) (kind : SimpKind) : TacticM Meta.Simp.Co
   | .simpAll => return (← elabSimpConfigCtxCore optConfig).toConfig
   | .dsimp   => return { (← elabDSimpConfigCore optConfig) with }
 
-private def addDeclToUnfoldOrTheorem (thms : SimpTheorems) (id : Origin) (e : Expr) (post : Bool) (inv : Bool) (kind : SimpKind) : MetaM SimpTheorems := do
+private def addDeclToUnfoldOrTheorem (config : Meta.ConfigWithKey) (thms : SimpTheorems) (id : Origin) (e : Expr) (post : Bool) (inv : Bool) (kind : SimpKind) : MetaM SimpTheorems := do
   if e.isConst then
     let declName := e.constName!
     let info ← getConstInfo declName
@@ -108,7 +108,7 @@ private def addDeclToUnfoldOrTheorem (thms : SimpTheorems) (id : Origin) (e : Ex
     let fvarId := e.fvarId!
     let decl ← fvarId.getDecl
     if (← isProp decl.type) then
-      thms.add id #[] e (post := post) (inv := inv)
+      thms.add id #[] e (post := post) (inv := inv) (config := config)
     else if !decl.isLet then
       throwError "invalid argument, variable is not a proposition or let-declaration"
     else if inv then
@@ -116,9 +116,9 @@ private def addDeclToUnfoldOrTheorem (thms : SimpTheorems) (id : Origin) (e : Ex
     else
       return thms.addLetDeclToUnfold fvarId
   else
-    thms.add id #[] e (post := post) (inv := inv)
+    thms.add id #[] e (post := post) (inv := inv) (config := config)
 
-private def addSimpTheorem (thms : SimpTheorems) (id : Origin) (stx : Syntax) (post : Bool) (inv : Bool) : TermElabM SimpTheorems := do
+private def addSimpTheorem (config : Meta.ConfigWithKey) (thms : SimpTheorems) (id : Origin) (stx : Syntax) (post : Bool) (inv : Bool) : TermElabM SimpTheorems := do
   let thm? ← Term.withoutModifyingElabMetaStateWithInfo <| withRef stx do
     let e ← Term.elabTerm stx none
     Term.synthesizeSyntheticMVars (postpone := .no) (ignoreStuckTC := true)
@@ -132,7 +132,7 @@ private def addSimpTheorem (thms : SimpTheorems) (id : Origin) (stx : Syntax) (p
     else
       return some (#[], e)
   if let some (levelParams, proof) := thm? then
-    thms.add id levelParams proof (post := post) (inv := inv)
+    thms.add id levelParams proof (post := post) (inv := inv) (config := config)
   else
     return thms
 
@@ -212,7 +212,7 @@ def elabSimpArgs (stx : Syntax) (ctx : Simp.Context) (simprocs : Simp.SimprocsAr
             match (← resolveSimpIdTheorem? term) with
             | .expr e  =>
               let name ← mkFreshId
-              thms ← addDeclToUnfoldOrTheorem thms (.stx name arg) e post inv kind
+              thms ← addDeclToUnfoldOrTheorem ctx.indexConfig thms (.stx name arg) e post inv kind
             | .simproc declName =>
               simprocs ← simprocs.add declName post
             | .ext (some ext₁) (some ext₂) _ =>
@@ -224,7 +224,7 @@ def elabSimpArgs (stx : Syntax) (ctx : Simp.Context) (simprocs : Simp.SimprocsAr
               simprocs  := simprocs.push (← ext₂.getSimprocs)
             | .none    =>
               let name ← mkFreshId
-              thms ← addSimpTheorem thms (.stx name arg) term post inv
+              thms ← addSimpTheorem ctx.indexConfig thms (.stx name arg) term post inv
           else if arg.getKind == ``Lean.Parser.Tactic.simpStar then
             starArg := true
           else
@@ -329,7 +329,7 @@ def mkSimpContext (stx : Syntax) (eraseLocal : Bool) (kind := SimpKind.simp)
     let hs ← getPropHyps
     for h in hs do
       unless simpTheorems.isErased (.fvar h) do
-        simpTheorems ← simpTheorems.addTheorem (.fvar h) (← h.getDecl).toExpr
+        simpTheorems ← simpTheorems.addTheorem (.fvar h) (← h.getDecl).toExpr (config := ctx.indexConfig)
     let ctx := ctx.setSimpTheorems simpTheorems
     return { ctx, simprocs, dischargeWrapper }
 

src/Lean/Elab/Tactic/Simproc.lean

@@ -25,7 +25,7 @@ def elabSimprocPattern (stx : Syntax) : MetaM Expr := do
 
 def elabSimprocKeys (stx : Syntax) : MetaM (Array Meta.SimpTheoremKey) := do
   let pattern ← elabSimprocPattern stx
-  DiscrTree.mkPath pattern simpDtConfig
+  withSimpGlobalConfig <| DiscrTree.mkPath pattern
 
 def checkSimprocType (declName : Name) : CoreM Bool := do
   let decl ← getConstInfo declName

src/Lean/Meta/ACLt.lean

@@ -32,6 +32,9 @@ inductive ReduceMode where
   | reduceSimpleOnly
   | none
 
+private def config : ConfigWithKey :=
+  { transparency := .reducible, iota := false, proj := .no : Config }.toConfigWithKey
+
 mutual
 
 /--
@@ -61,8 +64,8 @@ where
       -- Drawback: cost.
       return e
     else match mode with
-      | .reduce => DiscrTree.reduce e {}
-      | .reduceSimpleOnly => DiscrTree.reduce e { iota := false, proj := .no }
+      | .reduce => DiscrTree.reduce e
+      | .reduceSimpleOnly => withConfigWithKey config <| DiscrTree.reduce e
       | .none => return e
 
   lt (a b : Expr) : MetaM Bool := do

src/Lean/Meta/ArgsPacker.lean

@@ -196,13 +196,13 @@ where
       let packedArg := Unary.pack packedDomain args
       return e.beta #[packedArg]
   | [n] => do
-    withLocalDecl n .default domain fun x => do
+    withLocalDeclD n domain fun x => do
       let dummy := Expr.const ``Unit []
       mkLambdaFVars #[x] (← go packedDomain dummy (args.push x) [])
   | n :: ns =>
     match_expr domain with
     | PSigma a b =>
-      withLocalDecl n .default a fun x => do
+      withLocalDeclD n a fun x => do
         mkLambdaFVars #[x] (← go packedDomain (b.beta #[x]) (args.push x) ns)
     | _ => throwError "curryPSigma: Expected PSigma type, got {domain}"
 
@@ -319,7 +319,7 @@ def uncurryType (types : Array Expr) : MetaM Expr := do
     unless type.isForall do
       throwError "Mutual.uncurryType: Expected forall type, got {type}"
   let domain ← packType (types.map (·.bindingDomain!))
-  withLocalDeclD `x domain fun x => do
+  withLocalDeclD (← mkFreshUserName `x) domain fun x => do
     let codomain ← Mutual.mkCodomain types x
     mkForallFVars #[x] codomain
 
@@ -485,13 +485,14 @@ projects to the `i`th function of type,
 -/
 def curryProj (argsPacker : ArgsPacker) (e : Expr) (i : Nat) : MetaM Expr := do
   let n := argsPacker.numFuncs
-  let packedDomain := (← inferType e).bindingDomain!
+  let t ← inferType e
+  let packedDomain := t.bindingDomain!
   let unaryTypes ← Mutual.unpackType n packedDomain
   unless i < unaryTypes.length do
     throwError "curryProj: index out of range"
   let unaryType := unaryTypes[i]!
   -- unary : (x : a ⊗ b) → e[inl x]
-  let unary ← withLocalDecl `x .default unaryType fun x => do
+  let unary ← withLocalDeclD t.bindingName! unaryType fun x => do
       let packedArg ← Mutual.pack unaryTypes.length packedDomain i x
       mkLambdaFVars #[x] (e.beta #[packedArg])
   -- nary : (x : a) → (y : b) → e[inl (x,y)]

src/Lean/Meta/Basic.lean

@@ -27,6 +27,51 @@ namespace Lean.Meta
 
 builtin_initialize isDefEqStuckExceptionId : InternalExceptionId ← registerInternalExceptionId `isDefEqStuck
 
+def TransparencyMode.toUInt64 : TransparencyMode → UInt64
+  | .all       => 0
+  | .default   => 1
+  | .reducible => 2
+  | .instances => 3
+
+def EtaStructMode.toUInt64 : EtaStructMode → UInt64
+  | .all        => 0
+  | .notClasses => 1
+  | .none       => 2
+
+/--
+Configuration for projection reduction. See `whnfCore`.
+-/
+inductive ProjReductionKind where
+  /-- Projections `s.i` are not reduced at `whnfCore`. -/
+  | no
+  /--
+  Projections `s.i` are reduced at `whnfCore`, and `whnfCore` is used at `s` during the process.
+  Recall that `whnfCore` does not perform `delta` reduction (i.e., it will not unfold constant declarations).
+  -/
+  | yes
+  /--
+  Projections `s.i` are reduced at `whnfCore`, and `whnf` is used at `s` during the process.
+  Recall that `whnfCore` does not perform `delta` reduction (i.e., it will not unfold constant declarations), but `whnf` does.
+  -/
+  | yesWithDelta
+  /--
+  Projections `s.i` are reduced at `whnfCore`, and `whnfAtMostI` is used at `s` during the process.
+  Recall that `whnfAtMostI` is like `whnf` but uses transparency at most `instances`.
+  This option is stronger than `yes`, but weaker than `yesWithDelta`.
+  We use this option to ensure we reduce projections to prevent expensive defeq checks when unifying TC operations.
+  When unifying e.g. `(@Field.toNeg α inst1).1 =?= (@Field.toNeg α inst2).1`,
+  we only want to unify negation (and not all other field operations as well).
+  Unifying the field instances slowed down unification: https://github.com/leanprover/lean4/issues/1986
+  -/
+  | yesWithDeltaI
+  deriving DecidableEq, Inhabited, Repr
+
+def ProjReductionKind.toUInt64 : ProjReductionKind → UInt64
+  | .no  => 0
+  | .yes => 1
+  | .yesWithDelta => 2
+  | .yesWithDeltaI => 3
+
 /--
 Configuration flags for the `MetaM` monad.
 Many of them are used to control the `isDefEq` function that checks whether two terms are definitionally equal or not.
@@ -118,9 +163,64 @@ structure Config where
   - `max u w =?= mav u ?v` is solved with `?v := w` ignoring the solution `?v := max u w`
   -/
   univApprox : Bool := true
+  /-- If `true`, reduce recursor/matcher applications, e.g., `Nat.rec true (fun _ _ => false) Nat.zero` reduces to `true` -/
+  iota : Bool := true
+  /-- If `true`, reduce terms such as `(fun x => t[x]) a` into `t[a]` -/
+  beta : Bool := true
+  /-- Control projection reduction at `whnfCore`. -/
+  proj : ProjReductionKind := .yesWithDelta
+  /--
+  Zeta reduction: `let x := v; e[x]` reduces to `e[v]`.
+  We say a let-declaration `let x := v; e` is non dependent if it is equivalent to `(fun x => e) v`.
+  Recall that
+  ```
+  fun x : BitVec 5 => let n := 5; fun y : BitVec n => x = y
+  ```
+  is type correct, but
+  ```
+  fun x : BitVec 5 => (fun n => fun y : BitVec n => x = y) 5
+  ```
+  is not.
+  -/
+  zeta : Bool := true
+  /--
+  Zeta-delta reduction: given a local context containing entry `x : t := e`, free variable `x` reduces to `e`.
+  -/
+  zetaDelta : Bool := true
+  deriving Inhabited
+
+/-- Convert `isDefEq` and `WHNF` relevant parts into a key for caching results -/
+private def Config.toKey (c : Config) : UInt64 :=
+  c.transparency.toUInt64 |||
+  (c.foApprox.toUInt64 <<< 2) |||
+  (c.ctxApprox.toUInt64 <<< 3) |||
+  (c.quasiPatternApprox.toUInt64 <<< 4) |||
+  (c.constApprox.toUInt64 <<< 5) |||
+  (c.isDefEqStuckEx.toUInt64 <<< 6) |||
+  (c.unificationHints.toUInt64 <<< 7) |||
+  (c.proofIrrelevance.toUInt64 <<< 8) |||
+  (c.assignSyntheticOpaque.toUInt64 <<< 9) |||
+  (c.offsetCnstrs.toUInt64 <<< 10) |||
+  (c.iota.toUInt64 <<< 11) |||
+  (c.beta.toUInt64 <<< 12) |||
+  (c.zeta.toUInt64 <<< 13) |||
+  (c.zetaDelta.toUInt64 <<< 14) |||
+  (c.univApprox.toUInt64 <<< 15) |||
+  (c.etaStruct.toUInt64 <<< 16) |||
+  (c.proj.toUInt64 <<< 18)
+
+/-- Configuration with key produced by `Config.toKey`. -/
+structure ConfigWithKey where
+  private mk ::
+  config : Config
+  key    : UInt64
+  deriving Inhabited
+
+def Config.toConfigWithKey (c : Config) : ConfigWithKey :=
+  { config := c, key := c.toKey }
 
 /--
-  Function parameter information cache.
+Function parameter information cache.
 -/
 structure ParamInfo where
   /-- The binder annotation for the parameter. -/
@@ -178,7 +278,6 @@ def ParamInfo.isStrictImplicit (p : ParamInfo) : Bool :=
 def ParamInfo.isExplicit (p : ParamInfo) : Bool :=
   p.binderInfo == BinderInfo.default
 
-
 /--
   Function information cache. See `ParamInfo`.
 -/
@@ -192,11 +291,12 @@ structure FunInfo where
   resultDeps : Array Nat       := #[]
 
 /--
-  Key for the function information cache.
+Key for the function information cache.
 -/
 structure InfoCacheKey where
-  /-- The transparency mode used to compute the `FunInfo`. -/
-  transparency : TransparencyMode
+  private mk ::
+  /-- key produced using `Config.toKey`. -/
+  configKey : UInt64
   /-- The function being cached information about. It is quite often an `Expr.const`. -/
   expr         : Expr
   /--
@@ -207,11 +307,10 @@ structure InfoCacheKey where
   nargs?       : Option Nat
   deriving Inhabited, BEq
 
-namespace InfoCacheKey
-instance : Hashable InfoCacheKey :=
-  ⟨fun ⟨transparency, expr, nargs⟩ => mixHash (hash transparency) <| mixHash (hash expr) (hash nargs)⟩
-end InfoCacheKey
+instance : Hashable InfoCacheKey where
+  hash := fun { configKey, expr, nargs? } => mixHash (hash configKey) <| mixHash (hash expr) (hash nargs?)
 
+-- Remark: we don't need to store `Config.toKey` because typeclass resolution uses a fixed configuration.
 structure SynthInstanceCacheKey where
   localInsts        : LocalInstances
   type              : Expr
@@ -231,38 +330,50 @@ structure AbstractMVarsResult where
 
 abbrev SynthInstanceCache := PersistentHashMap SynthInstanceCacheKey (Option AbstractMVarsResult)
 
-abbrev InferTypeCache := PersistentExprStructMap Expr
+-- Key for `InferType` and `WHNF` caches
+structure ExprConfigCacheKey where
+  private mk ::
+  expr      : Expr
+  configKey : UInt64
+  deriving Inhabited
+
+instance : BEq ExprConfigCacheKey where
+  beq a b :=
+    Expr.equal a.expr b.expr &&
+    a.configKey == b.configKey
+
+instance : Hashable ExprConfigCacheKey where
+  hash := fun { expr, configKey } => mixHash (hash expr) (hash configKey)
+
+abbrev InferTypeCache := PersistentHashMap ExprConfigCacheKey Expr
 abbrev FunInfoCache   := PersistentHashMap InfoCacheKey FunInfo
-abbrev WhnfCache      := PersistentExprStructMap Expr
+abbrev WhnfCache      := PersistentHashMap ExprConfigCacheKey Expr
+
+structure DefEqCacheKey where
+  private mk ::
+  lhs       : Expr
+  rhs       : Expr
+  configKey : UInt64
+  deriving Inhabited, BEq
+
+instance : Hashable DefEqCacheKey where
+  hash := fun { lhs, rhs, configKey } => mixHash (hash lhs) <| mixHash (hash rhs) (hash configKey)
 
 /--
-  A mapping `(s, t) ↦ isDefEq s t` per transparency level.
-  TODO: consider more efficient representations (e.g., a proper set) and caching policies (e.g., imperfect cache).
-  We should also investigate the impact on memory consumption. -/
-structure DefEqCache where
-  reducible : PersistentHashMap (Expr × Expr) Bool := {}
-  instances : PersistentHashMap (Expr × Expr) Bool := {}
-  default   : PersistentHashMap (Expr × Expr) Bool := {}
-  all       : PersistentHashMap (Expr × Expr) Bool := {}
-  deriving Inhabited
-
-/--
-  A cache for `inferType` at transparency levels `.default` an `.all`.
+A mapping `(s, t) ↦ isDefEq s t`.
+TODO: consider more efficient representations (e.g., a proper set) and caching policies (e.g., imperfect cache).
+We should also investigate the impact on memory consumption.
 -/
-structure InferTypeCaches where
-  default   : InferTypeCache
-  all       : InferTypeCache
-  deriving Inhabited
+abbrev DefEqCache := PersistentHashMap DefEqCacheKey Bool
 
 /--
-  Cache datastructures for type inference, type class resolution, whnf, and definitional equality.
+Cache datastructures for type inference, type class resolution, whnf, and definitional equality.
 -/
 structure Cache where
-  inferType      : InferTypeCaches := ⟨{}, {}⟩
+  inferType      : InferTypeCache := {}
   funInfo        : FunInfoCache := {}
   synthInstance  : SynthInstanceCache := {}
-  whnfDefault    : WhnfCache := {} -- cache for closed terms and `TransparencyMode.default`
-  whnfAll        : WhnfCache := {} -- cache for closed terms and `TransparencyMode.all`
+  whnf           : WhnfCache := {}
   defEqTrans     : DefEqCache := {} -- transient cache for terms containing mvars or using nonstandard configuration options, it is frequently reset.
   defEqPerm      : DefEqCache := {} -- permanent cache for terms not containing mvars and using standard configuration options
   deriving Inhabited
@@ -333,6 +444,7 @@ register_builtin_option maxSynthPendingDepth : Nat := {
 -/
 structure Context where
   private config    : Config               := {}
+  private configKey : UInt64               := config.toKey
   /-- Local context -/
   lctx              : LocalContext         := {}
   /-- Local instances in `lctx`. -/
@@ -483,17 +595,27 @@ variable [MonadControlT MetaM n] [Monad n]
 @[inline] def modifyCache (f : Cache → Cache) : MetaM Unit :=
   modify fun { mctx, cache, zetaDeltaFVarIds, postponed, diag } => { mctx, cache := f cache, zetaDeltaFVarIds, postponed, diag }
 
-@[inline] def modifyInferTypeCacheDefault (f : InferTypeCache → InferTypeCache) : MetaM Unit :=
-  modifyCache fun ⟨⟨icd, ica⟩, c1, c2, c3, c4, c5, c6⟩ => ⟨⟨f icd, ica⟩, c1, c2, c3, c4, c5, c6⟩
-
-@[inline] def modifyInferTypeCacheAll (f : InferTypeCache → InferTypeCache) : MetaM Unit :=
-  modifyCache fun ⟨⟨icd, ica⟩, c1, c2, c3, c4, c5, c6⟩ => ⟨⟨icd, f ica⟩, c1, c2, c3, c4, c5, c6⟩
+@[inline] def modifyInferTypeCache (f : InferTypeCache → InferTypeCache) : MetaM Unit :=
+  modifyCache fun ⟨ic, c1, c2, c3, c4, c5⟩ => ⟨f ic, c1, c2, c3, c4, c5⟩
 
 @[inline] def modifyDefEqTransientCache (f : DefEqCache → DefEqCache) : MetaM Unit :=
-  modifyCache fun ⟨c1, c2, c3, c4, c5, defeqTrans, c6⟩ => ⟨c1, c2, c3, c4, c5, f defeqTrans, c6⟩
+  modifyCache fun ⟨c1, c2, c3, c4, defeqTrans, c5⟩ => ⟨c1, c2, c3, c4, f defeqTrans, c5⟩
 
 @[inline] def modifyDefEqPermCache (f : DefEqCache → DefEqCache) : MetaM Unit :=
-  modifyCache fun ⟨c1, c2, c3, c4, c5, c6, defeqPerm⟩ => ⟨c1, c2, c3, c4, c5, c6, f defeqPerm⟩
+  modifyCache fun ⟨c1, c2, c3, c4, c5, defeqPerm⟩ => ⟨c1, c2, c3, c4, c5, f defeqPerm⟩
+
+def mkExprConfigCacheKey (expr : Expr) : MetaM ExprConfigCacheKey :=
+  return { expr, configKey := (← read).configKey }
+
+def mkDefEqCacheKey (lhs rhs : Expr) : MetaM DefEqCacheKey := do
+  let configKey := (← read).configKey
+  if Expr.quickLt lhs rhs then
+    return { lhs, rhs, configKey }
+  else
+    return { lhs := rhs, rhs := lhs, configKey }
+
+def mkInfoCacheKey (expr : Expr) (nargs? : Option Nat) : MetaM InfoCacheKey :=
+  return { expr, nargs?, configKey := (← read).configKey }
 
 @[inline] def resetDefEqPermCaches : MetaM Unit :=
   modifyDefEqPermCache fun _ => {}
@@ -538,6 +660,9 @@ def getLocalInstances : MetaM LocalInstances :=
 def getConfig : MetaM Config :=
   return (← read).config
 
+def getConfigWithKey : MetaM ConfigWithKey :=
+  return (← getConfig).toConfigWithKey
+
 def resetZetaDeltaFVarIds : MetaM Unit :=
   modify fun s => { s with zetaDeltaFVarIds := {} }
 
@@ -941,7 +1066,16 @@ def elimMVarDeps (xs : Array Expr) (e : Expr) (preserveOrder : Bool := false) :
 
 /-- `withConfig f x` executes `x` using the updated configuration object obtained by applying `f`. -/
 @[inline] def withConfig (f : Config → Config) : n α → n α :=
-  mapMetaM <| withReader (fun ctx => { ctx with config := f ctx.config })
+  mapMetaM <| withReader fun ctx =>
+    let config := f ctx.config
+    let configKey := config.toKey
+    { ctx with config, configKey }
+
+@[inline] def withConfigWithKey (c : ConfigWithKey) : n α → n α :=
+  mapMetaM <| withReader fun ctx =>
+    let config := c.config
+    let configKey := c.key
+    { ctx with config, configKey }
 
 @[inline] def withCanUnfoldPred (p : Config → ConstantInfo → CoreM Bool) : n α → n α :=
   mapMetaM <| withReader (fun ctx => { ctx with canUnfold? := p })
@@ -961,8 +1095,15 @@ Executes `x` tracking zetaDelta reductions `Config.trackZetaDelta := true`
 @[inline] def withoutProofIrrelevance (x : n α) : n α :=
   withConfig (fun cfg => { cfg with proofIrrelevance := false }) x
 
+@[inline] private def Context.setTransparency (ctx : Context) (transparency : TransparencyMode) : Context :=
+  let config := { ctx.config with transparency }
+  -- Recall that `transparency` is stored in the first 2 bits
+  let configKey : UInt64 := ((ctx.configKey >>> (2 : UInt64)) <<< 2) ||| transparency.toUInt64
+  { ctx with config, configKey }
+
 @[inline] def withTransparency (mode : TransparencyMode) : n α → n α :=
-  withConfig (fun config => { config with transparency := mode })
+  -- We avoid `withConfig` for performance reasons.
+  mapMetaM <| withReader (·.setTransparency mode)
 
 /-- `withDefault x` executes `x` using the default transparency setting. -/
 @[inline] def withDefault (x : n α) : n α :=
@@ -983,13 +1124,10 @@ or type class instances are unfolded.
 Execute `x` ensuring the transparency setting is at least `mode`.
 Recall that `.all > .default > .instances > .reducible`.
 -/
-@[inline] def withAtLeastTransparency (mode : TransparencyMode) (x : n α) : n α :=
-  withConfig
-    (fun config =>
-      let oldMode := config.transparency
-      let mode    := if oldMode.lt mode then mode else oldMode
-      { config with transparency := mode })
-    x
+@[inline] def withAtLeastTransparency (mode : TransparencyMode) : n α → n α :=
+  mapMetaM <| withReader fun ctx =>
+    let modeOld := ctx.config.transparency
+    ctx.setTransparency <| if modeOld.lt mode then mode else modeOld
 
 /-- Execute `x` allowing `isDefEq` to assign synthetic opaque metavariables. -/
 @[inline] def withAssignableSyntheticOpaque (x : n α) : n α :=
@@ -1011,8 +1149,8 @@ def getTheoremInfo (info : ConstantInfo) : MetaM (Option ConstantInfo) := do
 
 private def getDefInfoTemp (info : ConstantInfo) : MetaM (Option ConstantInfo) := do
   match (← getTransparency) with
-  | TransparencyMode.all => return some info
-  | TransparencyMode.default => return some info
+  | .all => return some info
+  | .default => return some info
   | _ =>
     if (← isReducible info.name) then
       return some info

src/Lean/Meta/Canonicalizer.lean

@@ -91,7 +91,15 @@ private partial def mkKey (e : Expr) : CanonM UInt64 := do
           let eNew ← instantiateMVars e
           unless eNew == e do
             return (← mkKey eNew)
-        let info ← getFunInfo f
+        let info ← if f.hasLooseBVars then
+          -- If `f` has loose bound variables, `getFunInfo` will fail.
+          -- This can only happen if `f` contains local variables.
+          -- Instead we use an empty `FunInfo`, which results in the
+          -- `i < info.paramInfo.size` check below failing for all indices,
+          -- and hence mixing in the hash for all arguments.
+          pure {}
+        else
+          getFunInfo f
         let mut k ← mkKey f
         for i in [:e.getAppNumArgs] do
           if h : i < info.paramInfo.size then
@@ -101,10 +109,13 @@ private partial def mkKey (e : Expr) : CanonM UInt64 := do
           else
               k := mixHash k (← mkKey (e.getArg! i))
         return k
-      | .lam _ t b _
-      | .forallE _ t b _ =>
+      | .lam n t b bi
+      | .forallE n t b bi =>
+        -- Note that we do not use `withLocalDecl` here, for performance reasons.
+        -- Instead we have a guard for loose bound variables in the `.app` case above.
         return mixHash (← mkKey t) (← mkKey b)
-      | .letE _ _ v b _ =>
+      | .letE n t v b _ =>
+        -- Similarly, we do not use `withLetDecl` here.
         return mixHash (← mkKey v) (← mkKey b)
       | .proj _ i s =>
         return mixHash i.toUInt64 (← mkKey s)
@@ -124,11 +135,11 @@ def canon (e : Expr) : CanonM Expr := do
         if (← isDefEq e e') then
           return e'
       -- `e` is not definitionally equal to any expression in `es'`. We claim this should be rare.
-      unsafe modify fun { cache, keyToExprs } => { cache, keyToExprs := keyToExprs.insert k (e :: es') }
+      modify fun { cache, keyToExprs } => { cache, keyToExprs := keyToExprs.insert k (e :: es') }
       return e
   else
     -- `e` is the first expression we found with key `k`.
-    unsafe modify fun { cache, keyToExprs } => { cache, keyToExprs := keyToExprs.insert k [e] }
+    modify fun { cache, keyToExprs } => { cache, keyToExprs := keyToExprs.insert k [e] }
     return e
 
 end Canonicalizer

src/Lean/Meta/DiscrTree.lean

@@ -305,16 +305,13 @@ def hasNoindexAnnotation (e : Expr) : Bool :=
 
 /--
 Reduction procedure for the discrimination tree indexing.
-The parameter `config` controls how aggressively the term is reduced.
-The parameter at type `DiscrTree` controls this value.
-See comment at `DiscrTree`.
 -/
-partial def reduce (e : Expr) (config : WhnfCoreConfig) : MetaM Expr := do
-  let e ← whnfCore e config
+partial def reduce (e : Expr) : MetaM Expr := do
+  let e ← whnfCore e
   match (← unfoldDefinition? e) with
-  | some e => reduce e config
+  | some e => reduce e
   | none => match e.etaExpandedStrict? with
-    | some e => reduce e config
+    | some e => reduce e
     | none   => return e
 
 /--
@@ -333,24 +330,24 @@ private def isBadKey (fn : Expr) : Bool :=
   | _           => true
 
 /--
-  Reduce `e` until we get an irreducible term (modulo current reducibility setting) or the resulting term
-  is a bad key (see comment at `isBadKey`).
-  We use this method instead of `reduce` for root terms at `pushArgs`. -/
-private partial def reduceUntilBadKey (e : Expr) (config : WhnfCoreConfig) : MetaM Expr := do
+Reduce `e` until we get an irreducible term (modulo current reducibility setting) or the resulting term
+is a bad key (see comment at `isBadKey`).
+We use this method instead of `reduce` for root terms at `pushArgs`. -/
+private partial def reduceUntilBadKey (e : Expr) : MetaM Expr := do
   let e ← step e
   match e.etaExpandedStrict? with
-  | some e => reduceUntilBadKey e config
+  | some e => reduceUntilBadKey e
   | none   => return e
 where
   step (e : Expr) := do
-    let e ← whnfCore e config
+    let e ← whnfCore e
     match (← unfoldDefinition? e) with
     | some e' => if isBadKey e'.getAppFn then return e else step e'
     | none    => return e
 
 /-- whnf for the discrimination tree module -/
-def reduceDT (e : Expr) (root : Bool) (config : WhnfCoreConfig) : MetaM Expr :=
-  if root then reduceUntilBadKey e config else reduce e config
+def reduceDT (e : Expr) (root : Bool) : MetaM Expr :=
+  if root then reduceUntilBadKey e else reduce e
 
 /- Remark: we use `shouldAddAsStar` only for nested terms, and `root == false` for nested terms -/
 
@@ -372,11 +369,11 @@ In this issue, we have a local hypotheses `(h : ∀ p : α × β, f p p.2 = p.2)
 For example, it was introduced by another tactic. Thus, when populating the discrimination tree explicit arguments provided to `simp` (e.g., `simp [h]`),
 we use `noIndexAtArgs := true`. See comment: https://github.com/leanprover/lean4/issues/2670#issuecomment-1758889365
 -/
-private def pushArgs (root : Bool) (todo : Array Expr) (e : Expr) (config : WhnfCoreConfig) (noIndexAtArgs : Bool) : MetaM (Key × Array Expr) := do
+private def pushArgs (root : Bool) (todo : Array Expr) (e : Expr) (noIndexAtArgs : Bool) : MetaM (Key × Array Expr) := do
   if hasNoindexAnnotation e then
     return (.star, todo)
   else
-    let e ← reduceDT e root config
+    let e ← reduceDT e root
     let fn := e.getAppFn
     let push (k : Key) (nargs : Nat) (todo : Array Expr): MetaM (Key × Array Expr) := do
       let info ← getFunInfoNArgs fn nargs
@@ -422,23 +419,23 @@ private def pushArgs (root : Bool) (todo : Array Expr) (e : Expr) (config : Whnf
     | _ => return (.other, todo)
 
 @[inherit_doc pushArgs]
-partial def mkPathAux (root : Bool) (todo : Array Expr) (keys : Array Key) (config : WhnfCoreConfig) (noIndexAtArgs : Bool) : MetaM (Array Key) := do
+partial def mkPathAux (root : Bool) (todo : Array Expr) (keys : Array Key) (noIndexAtArgs : Bool) : MetaM (Array Key) := do
   if todo.isEmpty then
     return keys
   else
     let e    := todo.back!
     let todo := todo.pop
-    let (k, todo) ← pushArgs root todo e config noIndexAtArgs
-    mkPathAux false todo (keys.push k) config noIndexAtArgs
+    let (k, todo) ← pushArgs root todo e noIndexAtArgs
+    mkPathAux false todo (keys.push k) noIndexAtArgs
 
 private def initCapacity := 8
 
 @[inherit_doc pushArgs]
-def mkPath (e : Expr) (config : WhnfCoreConfig) (noIndexAtArgs := false) : MetaM (Array Key) := do
+def mkPath (e : Expr) (noIndexAtArgs := false) : MetaM (Array Key) := do
   withReducible do
     let todo : Array Expr := .mkEmpty initCapacity
     let keys : Array Key := .mkEmpty initCapacity
-    mkPathAux (root := true) (todo.push e) keys config noIndexAtArgs
+    mkPathAux (root := true) (todo.push e) keys noIndexAtArgs
 
 private partial def createNodes (keys : Array Key) (v : α) (i : Nat) : Trie α :=
   if h : i < keys.size then
@@ -492,23 +489,23 @@ def insertCore [BEq α] (d : DiscrTree α) (keys : Array Key) (v : α) : DiscrTr
       let c := insertAux keys v 1 c
       { root := d.root.insert k c }
 
-def insert [BEq α] (d : DiscrTree α) (e : Expr) (v : α) (config : WhnfCoreConfig) (noIndexAtArgs := false) : MetaM (DiscrTree α) := do
-  let keys ← mkPath e config noIndexAtArgs
+def insert [BEq α] (d : DiscrTree α) (e : Expr) (v : α) (noIndexAtArgs := false) : MetaM (DiscrTree α) := do
+  let keys ← mkPath e noIndexAtArgs
   return d.insertCore keys v
 
 /--
 Inserts a value into a discrimination tree,
 but only if its key is not of the form `#[*]` or `#[=, *, *, *]`.
 -/
-def insertIfSpecific [BEq α] (d : DiscrTree α) (e : Expr) (v : α) (config : WhnfCoreConfig) (noIndexAtArgs := false) : MetaM (DiscrTree α) := do
-  let keys ← mkPath e config noIndexAtArgs
+def insertIfSpecific [BEq α] (d : DiscrTree α) (e : Expr) (v : α) (noIndexAtArgs := false) : MetaM (DiscrTree α) := do
+  let keys ← mkPath e noIndexAtArgs
   return if keys == #[Key.star] || keys == #[Key.const `Eq 3, Key.star, Key.star, Key.star] then
     d
   else
     d.insertCore keys v
 
-private def getKeyArgs (e : Expr) (isMatch root : Bool) (config : WhnfCoreConfig) : MetaM (Key × Array Expr) := do
-  let e ← reduceDT e root config
+private def getKeyArgs (e : Expr) (isMatch root : Bool) : MetaM (Key × Array Expr) := do
+  let e ← reduceDT e root
   unless root do
     -- See pushArgs
     if let some v := toNatLit? e then
@@ -580,11 +577,11 @@ private def getKeyArgs (e : Expr) (isMatch root : Bool) (config : WhnfCoreConfig
   | .forallE _ d _ _ => return (.arrow, #[d])
   | _ => return (.other, #[])
 
-private abbrev getMatchKeyArgs (e : Expr) (root : Bool) (config : WhnfCoreConfig) : MetaM (Key × Array Expr) :=
-  getKeyArgs e (isMatch := true) (root := root) (config := config)
+private abbrev getMatchKeyArgs (e : Expr) (root : Bool) : MetaM (Key × Array Expr) :=
+  getKeyArgs e (isMatch := true) (root := root)
 
-private abbrev getUnifyKeyArgs (e : Expr) (root : Bool) (config : WhnfCoreConfig) : MetaM (Key × Array Expr) :=
-  getKeyArgs e (isMatch := false) (root := root) (config := config)
+private abbrev getUnifyKeyArgs (e : Expr) (root : Bool) : MetaM (Key × Array Expr) :=
+  getKeyArgs e (isMatch := false) (root := root)
 
 private def getStarResult (d : DiscrTree α) : Array α :=
   let result : Array α := .mkEmpty initCapacity
@@ -595,7 +592,7 @@ private def getStarResult (d : DiscrTree α) : Array α :=
 private abbrev findKey (cs : Array (Key × Trie α)) (k : Key) : Option (Key × Trie α) :=
   cs.binSearch (k, default) (fun a b => a.1 < b.1)
 
-private partial def getMatchLoop (todo : Array Expr) (c : Trie α) (result : Array α) (config : WhnfCoreConfig) : MetaM (Array α) := do
+private partial def getMatchLoop (todo : Array Expr) (c : Trie α) (result : Array α) : MetaM (Array α) := do
   match c with
   | .node vs cs =>
     if todo.isEmpty then
@@ -606,48 +603,48 @@ private partial def getMatchLoop (todo : Array Expr) (c : Trie α) (result : Arr
       let e     := todo.back!
       let todo  := todo.pop
       let first := cs[0]! /- Recall that `Key.star` is the minimal key -/
-      let (k, args) ← getMatchKeyArgs e (root := false) config
+      let (k, args) ← getMatchKeyArgs e (root := false)
       /- We must always visit `Key.star` edges since they are wildcards.
          Thus, `todo` is not used linearly when there is `Key.star` edge
          and there is an edge for `k` and `k != Key.star`. -/
       let visitStar (result : Array α) : MetaM (Array α) :=
         if first.1 == .star then
-          getMatchLoop todo first.2 result config
+          getMatchLoop todo first.2 result
         else
           return result
       let visitNonStar (k : Key) (args : Array Expr) (result : Array α) : MetaM (Array α) :=
         match findKey cs k with
         | none   => return result
-        | some c => getMatchLoop (todo ++ args) c.2 result config
+        | some c => getMatchLoop (todo ++ args) c.2 result
       let result ← visitStar result
       match k with
       | .star  => return result
       | _      => visitNonStar k args result
 
-private def getMatchRoot (d : DiscrTree α) (k : Key) (args : Array Expr) (result : Array α) (config : WhnfCoreConfig) : MetaM (Array α) :=
+private def getMatchRoot (d : DiscrTree α) (k : Key) (args : Array Expr) (result : Array α) : MetaM (Array α) :=
   match d.root.find? k with
   | none   => return result
-  | some c => getMatchLoop args c result config
+  | some c => getMatchLoop args c result
 
-private def getMatchCore (d : DiscrTree α) (e : Expr) (config : WhnfCoreConfig) : MetaM (Key × Array α) :=
+private def getMatchCore (d : DiscrTree α) (e : Expr) : MetaM (Key × Array α) :=
   withReducible do
     let result := getStarResult d
-    let (k, args) ← getMatchKeyArgs e (root := true) config
+    let (k, args) ← getMatchKeyArgs e (root := true)
     match k with
     | .star  => return (k, result)
-    | _      => return (k, (← getMatchRoot d k args result config))
+    | _      => return (k, (← getMatchRoot d k args result))
 
 /--
   Find values that match `e` in `d`.
 -/
-def getMatch (d : DiscrTree α) (e : Expr) (config : WhnfCoreConfig) : MetaM (Array α) :=
-  return (← getMatchCore d e config).2
+def getMatch (d : DiscrTree α) (e : Expr) : MetaM (Array α) :=
+  return (← getMatchCore d e).2
 
 /--
   Similar to `getMatch`, but returns solutions that are prefixes of `e`.
   We store the number of ignored arguments in the result.-/
-partial def getMatchWithExtra (d : DiscrTree α) (e : Expr) (config : WhnfCoreConfig) : MetaM (Array (α × Nat)) := do
-  let (k, result) ← getMatchCore d e config
+partial def getMatchWithExtra (d : DiscrTree α) (e : Expr) : MetaM (Array (α × Nat)) := do
+  let (k, result) ← getMatchCore d e
   let result := result.map (·, 0)
   if !e.isApp then
     return result
@@ -669,7 +666,7 @@ where
     | _               => return false
 
   go (e : Expr) (numExtra : Nat) (result : Array (α × Nat)) : MetaM (Array (α × Nat)) := do
-    let result := result ++ (← getMatchCore d e config).2.map (., numExtra)
+    let result := result ++ (← getMatchCore d e).2.map (., numExtra)
     if e.isApp then
       go e.appFn! (numExtra + 1) result
     else
@@ -678,8 +675,8 @@ where
 /--
 Return the root symbol for `e`, and the number of arguments after `reduceDT`.
 -/
-def getMatchKeyRootFor (e : Expr) (config : WhnfCoreConfig) : MetaM (Key × Nat) := do
-  let e ← reduceDT e (root := true) config
+def getMatchKeyRootFor (e : Expr) : MetaM (Key × Nat) := do
+  let e ← reduceDT e (root := true)
   let numArgs := e.getAppNumArgs
   let key := match e.getAppFn with
     | .lit v         => .lit v
@@ -716,17 +713,17 @@ We use this method to simulate Lean 3's indexing.
 
 The natural number in the result is the number of arguments in `e` after `reduceDT`.
 -/
-def getMatchLiberal (d : DiscrTree α) (e : Expr) (config : WhnfCoreConfig) : MetaM (Array α × Nat) := do
+def getMatchLiberal (d : DiscrTree α) (e : Expr) : MetaM (Array α × Nat) := do
   withReducible do
     let result := getStarResult d
-    let (k, numArgs) ← getMatchKeyRootFor e config
+    let (k, numArgs) ← getMatchKeyRootFor e
     match k with
     | .star  => return (result, numArgs)
     | _      => return (getAllValuesForKey d k result, numArgs)
 
-partial def getUnify (d : DiscrTree α) (e : Expr) (config : WhnfCoreConfig) : MetaM (Array α) :=
+partial def getUnify (d : DiscrTree α) (e : Expr) : MetaM (Array α) :=
   withReducible do
-    let (k, args) ← getUnifyKeyArgs e (root := true) config
+    let (k, args) ← getUnifyKeyArgs e (root := true)
     match k with
     | .star => d.root.foldlM (init := #[]) fun result k c => process k.arity #[] c result
     | _ =>
@@ -750,7 +747,7 @@ where
       else
         let e     := todo.back!
         let todo  := todo.pop
-        let (k, args) ← getUnifyKeyArgs e (root := false) config
+        let (k, args) ← getUnifyKeyArgs e (root := false)
         let visitStar (result : Array α) : MetaM (Array α) :=
           let first := cs[0]!
           if first.1 == .star then

src/Lean/Meta/ExprDefEq.lean

@@ -2079,50 +2079,37 @@ Structure for storing defeq cache key information.
 -/
 structure DefEqCacheKeyInfo where
   kind : DefEqCacheKind
-  key  : Expr × Expr
+  key  : DefEqCacheKey
 
 private def mkCacheKey (t s : Expr) : MetaM DefEqCacheKeyInfo := do
   let kind ← getDefEqCacheKind t s
-  let key := if Expr.quickLt t s then (t, s) else (s, t)
+  let key ← mkDefEqCacheKey t s
   return { key, kind }
 
 private def getCachedResult (keyInfo : DefEqCacheKeyInfo) : MetaM LBool := do
   let cache ← match keyInfo.kind with
     | .transient => pure (← get).cache.defEqTrans
     | .permanent => pure (← get).cache.defEqPerm
-  let cache := match (← getTransparency) with
-    | .reducible => cache.reducible
-    | .instances => cache.instances
-    | .default   => cache.default
-    | .all       => cache.all
   match cache.find? keyInfo.key with
   | some val => return val.toLBool
   | none => return .undef
 
-def DefEqCache.update (cache : DefEqCache) (mode : TransparencyMode) (key : Expr × Expr) (result : Bool) : DefEqCache :=
-  match mode with
-  | .reducible => { cache with reducible := cache.reducible.insert key result }
-  | .instances => { cache with instances := cache.instances.insert key result }
-  | .default   => { cache with default   := cache.default.insert key result }
-  | .all       => { cache with all       := cache.all.insert key result }
-
 private def cacheResult (keyInfo : DefEqCacheKeyInfo) (result : Bool) : MetaM Unit := do
-  let mode ← getTransparency
   let key := keyInfo.key
   match keyInfo.kind with
-  | .permanent => modifyDefEqPermCache fun c => c.update mode key result
+  | .permanent => modifyDefEqPermCache fun c => c.insert key result
   | .transient =>
     /-
     We must ensure that all assigned metavariables in the key are replaced by their current assignments.
     Otherwise, the key is invalid after the assignment is "backtracked".
     See issue #1870 for an example.
     -/
-    let key := (← instantiateMVars key.1, ← instantiateMVars key.2)
-    modifyDefEqTransientCache fun c => c.update mode key result
+    let key ← mkDefEqCacheKey (← instantiateMVars key.lhs) (← instantiateMVars key.rhs)
+    modifyDefEqTransientCache fun c => c.insert key result
 
 private def whnfCoreAtDefEq (e : Expr) : MetaM Expr := do
   if backward.isDefEq.lazyWhnfCore.get (← getOptions) then
-    whnfCore e (config := { proj := .yesWithDeltaI })
+    withConfig (fun ctx => { ctx with proj := .yesWithDeltaI }) <| whnfCore e
   else
     whnfCore e
 

src/Lean/Meta/FunInfo.lean

@@ -10,13 +10,13 @@ import Lean.Meta.InferType
 namespace Lean.Meta
 
 @[inline] private def checkFunInfoCache (fn : Expr) (maxArgs? : Option Nat) (k : MetaM FunInfo) : MetaM FunInfo := do
-  let t ← getTransparency
-  match (← get).cache.funInfo.find? ⟨t, fn, maxArgs?⟩ with
-  | some finfo => pure finfo
+  let key ← mkInfoCacheKey fn maxArgs?
+  match (← get).cache.funInfo.find? key with
+  | some finfo => return finfo
   | none       => do
     let finfo ← k
-    modify fun s => { s with cache := { s.cache with funInfo := s.cache.funInfo.insert ⟨t, fn, maxArgs?⟩ finfo } }
-    pure finfo
+    modify fun s => { s with cache := { s.cache with funInfo := s.cache.funInfo.insert key finfo } }
+    return finfo
 
 @[inline] private def whenHasVar {α} (e : Expr) (deps : α) (k : α → α) : α :=
   if e.hasFVar then k deps else deps

src/Lean/Meta/InferType.lean

@@ -97,8 +97,8 @@ private def inferConstType (c : Name) (us : List Level) : MetaM Expr := do
 private def inferProjType (structName : Name) (idx : Nat) (e : Expr) : MetaM Expr := do
   let structType ← inferType e
   let structType ← whnf structType
-  let failed {α} : Unit → MetaM α := fun _ =>
-    throwError "invalid projection{indentExpr (mkProj structName idx e)} from type {structType}"
+  let failed {α} : Unit → MetaM α := fun _ => do
+    throwError "invalid projection{indentExpr (mkProj structName idx e)}\nfrom type{indentExpr structType}"
   matchConstStructure structType.getAppFn failed fun structVal structLvls ctorVal =>
     let structTypeArgs := structType.getAppArgs
     if structVal.numParams + structVal.numIndices != structTypeArgs.size then
@@ -165,24 +165,27 @@ private def inferFVarType (fvarId : FVarId) : MetaM Expr := do
   | none   => fvarId.throwUnknown
 
 @[inline] private def checkInferTypeCache (e : Expr) (inferType : MetaM Expr) : MetaM Expr := do
-  match (← getTransparency) with
-  | .default =>
-    match (← get).cache.inferType.default.find? e with
+  if e.hasMVar then
+    inferType
+  else
+    let key ← mkExprConfigCacheKey e
+    match (← get).cache.inferType.find? key with
     | some type => return type
     | none =>
       let type ← inferType
-      unless e.hasMVar || type.hasMVar do
-        modifyInferTypeCacheDefault fun c => c.insert e type
+      unless type.hasMVar do
+        modifyInferTypeCache fun c => c.insert key type
       return type
-  | .all =>
-    match (← get).cache.inferType.all.find? e with
-    | some type => return type
-    | none =>
-      let type ← inferType
-      unless e.hasMVar || type.hasMVar do
-        modifyInferTypeCacheAll fun c => c.insert e type
-      return type
-  | _ => panic! "checkInferTypeCache: transparency mode not default or all"
+
+private def defaultConfig : ConfigWithKey :=
+  { : Config }.toConfigWithKey
+
+private def allConfig : ConfigWithKey :=
+  { transparency := .all : Config }.toConfigWithKey
+
+@[inline] def withInferTypeConfig (x : MetaM α) : MetaM α := do
+  let cfg := if (← getTransparency) == .all then allConfig else defaultConfig
+  withConfigWithKey cfg x
 
 @[export lean_infer_type]
 def inferTypeImp (e : Expr) : MetaM Expr :=
@@ -201,7 +204,7 @@ def inferTypeImp (e : Expr) : MetaM Expr :=
     | .forallE ..    => checkInferTypeCache e (inferForallType e)
     | .lam ..        => checkInferTypeCache e (inferLambdaType e)
     | .letE ..       => checkInferTypeCache e (inferLambdaType e)
-  withIncRecDepth <| withAtLeastTransparency TransparencyMode.default (infer e)
+  withIncRecDepth <| withInferTypeConfig (infer e)
 
 /--
   Return `LBool.true` if given level is always equivalent to universe level zero.

src/Lean/Meta/Instances.lean

@@ -72,9 +72,6 @@ structure Instances where
   erased        : PHashSet Name := {}
   deriving Inhabited
 
-/-- Configuration for the discrimination tree module -/
-def tcDtConfig : WhnfCoreConfig := {}
-
 def addInstanceEntry (d : Instances) (e : InstanceEntry) : Instances :=
   match e.globalName? with
   | some n => { d with discrTree := d.discrTree.insertCore e.keys e, instanceNames := d.instanceNames.insert n e, erased := d.erased.erase n }
@@ -98,7 +95,7 @@ private def mkInstanceKey (e : Expr) : MetaM (Array InstanceKey) := do
   let type ← inferType e
   withNewMCtxDepth do
     let (_, _, type) ← forallMetaTelescopeReducing type
-    DiscrTree.mkPath type tcDtConfig
+    DiscrTree.mkPath type
 
 /--
 Compute the order the arguments of `inst` should be synthesized.

src/Lean/Meta/LazyDiscrTree.lean

@@ -184,9 +184,9 @@ private def elimLooseBVarsByBeta (e : Expr) : CoreM Expr :=
       else
         return .continue)
 
-private def getKeyArgs (e : Expr) (isMatch root : Bool) (config : WhnfCoreConfig) :
+private def getKeyArgs (e : Expr) (isMatch root : Bool) :
     MetaM (Key × Array Expr) := do
-  let e ← DiscrTree.reduceDT e root config
+  let e ← DiscrTree.reduceDT e root
   unless root do
     -- See pushArgs
     if let some v := toNatLit? e then
@@ -259,9 +259,9 @@ private def getKeyArgs (e : Expr) (isMatch root : Bool) (config : WhnfCoreConfig
 /-
 Given an expression we are looking for patterns that match, return the key and sub-expressions.
 -/
-private abbrev getMatchKeyArgs (e : Expr) (root : Bool) (config : WhnfCoreConfig) :
+private abbrev getMatchKeyArgs (e : Expr) (root : Bool) :
     MetaM (Key × Array Expr) :=
-  getKeyArgs e (isMatch := true) (root := root) (config := config)
+  getKeyArgs e (isMatch := true) (root := root)
 
 end MatchClone
 
@@ -313,8 +313,6 @@ discriminator key is computed and processing the remaining
 terms is deferred until demanded by a match.
 -/
 structure LazyDiscrTree (α : Type) where
-  /-- Configuration for normalization. -/
-  config : Lean.Meta.WhnfCoreConfig := {}
   /-- Backing array of trie entries.  Should be owned by this trie. -/
   tries : Array (LazyDiscrTree.Trie α) := #[default]
   /-- Map from discriminator trie roots to the index. -/
@@ -332,12 +330,12 @@ open Lean.Meta.DiscrTree (mkNoindexAnnotation hasNoindexAnnotation reduceDT)
 /--
 Specialization of Lean.Meta.DiscrTree.pushArgs
 -/
-private def pushArgs (root : Bool) (todo : Array Expr) (e : Expr) (config : WhnfCoreConfig) :
+private def pushArgs (root : Bool) (todo : Array Expr) (e : Expr) :
     MetaM (Key × Array Expr) := do
   if hasNoindexAnnotation e then
     return (.star, todo)
   else
-    let e ← reduceDT e root config
+    let e ← reduceDT e root
     let fn := e.getAppFn
     let push (k : Key) (nargs : Nat) (todo : Array Expr) : MetaM (Key × Array Expr) := do
       let info ← getFunInfoNArgs fn nargs
@@ -389,8 +387,8 @@ private def initCapacity := 8
 /--
 Get the root key and rest of terms of an expression using the specified config.
 -/
-private def rootKey (cfg: WhnfCoreConfig) (e : Expr) : MetaM (Key × Array Expr) :=
-  pushArgs true (Array.mkEmpty initCapacity) e cfg
+private def rootKey (e : Expr) : MetaM (Key × Array Expr) :=
+  pushArgs true (Array.mkEmpty initCapacity) e
 
 private partial def buildPath (op : Bool → Array Expr → Expr → MetaM (Key × Array Expr)) (root : Bool) (todo : Array Expr) (keys : Array Key) : MetaM (Array Key) := do
   if todo.isEmpty then
@@ -407,9 +405,9 @@ Create a key path from an expression using the function used for patterns.
 This differs from Lean.Meta.DiscrTree.mkPath and targetPath in that the expression
 should uses free variables rather than meta-variables for holes.
 -/
-def patternPath (e : Expr) (config : WhnfCoreConfig) : MetaM (Array Key) := do
+def patternPath (e : Expr) : MetaM (Array Key) := do
   let todo : Array Expr := .mkEmpty initCapacity
-  let op root todo e := pushArgs root todo e config
+  let op root todo e := pushArgs root todo e
   buildPath op (root := true) (todo.push e) (.mkEmpty initCapacity)
 
 /--
@@ -417,21 +415,21 @@ Create a key path from an expression we are matching against.
 
 This should have mvars instantiated where feasible.
 -/
-def targetPath (e : Expr) (config : WhnfCoreConfig) : MetaM (Array Key) := do
+def targetPath (e : Expr) : MetaM (Array Key) := do
   let todo : Array Expr := .mkEmpty initCapacity
   let op root todo e := do
-        let (k, args) ← MatchClone.getMatchKeyArgs e root config
+        let (k, args) ← MatchClone.getMatchKeyArgs e root
         pure (k, todo ++ args)
   buildPath op (root := true) (todo.push e) (.mkEmpty initCapacity)
 
 /- Monad for finding matches while resolving deferred patterns. -/
 @[reducible]
-private def MatchM α := ReaderT WhnfCoreConfig (StateRefT (Array (Trie α)) MetaM)
+private def MatchM α := StateRefT (Array (Trie α)) MetaM
 
 private def runMatch (d : LazyDiscrTree α) (m : MatchM α β)  : MetaM (β × LazyDiscrTree α) := do
-  let { config := c, tries := a, roots := r } := d
-  let (result, a) ← withReducible $ (m.run c).run a
-  pure (result, { config := c, tries := a, roots := r})
+  let { tries := a, roots := r } := d
+  let (result, a) ← withReducible <| m.run a
+  return (result, { tries := a, roots := r})
 
 private def setTrie (i : TrieIndex) (v : Trie α) : MatchM α Unit :=
   modify (·.set! i v)
@@ -444,7 +442,7 @@ private def newTrie [Monad m] [MonadState (Array (Trie α)) m] (e : LazyEntry α
 private def addLazyEntryToTrie (i:TrieIndex) (e : LazyEntry α) : MatchM α Unit :=
   modify (·.modify i (·.pushPending e))
 
-private def evalLazyEntry (config : WhnfCoreConfig)
+private def evalLazyEntry
     (p : Array α × TrieIndex × Std.HashMap Key TrieIndex)
     (entry : LazyEntry α)
     : MatchM α (Array α × TrieIndex × Std.HashMap Key TrieIndex) := do
@@ -456,7 +454,7 @@ private def evalLazyEntry (config : WhnfCoreConfig)
   else
     let e    := todo.back!
     let todo := todo.pop
-    let (k, todo) ← withLCtx lctx.1 lctx.2 $ pushArgs false todo e config
+    let (k, todo) ← withLCtx lctx.1 lctx.2 <| pushArgs false todo e
     if k == .star then
       if starIdx = 0 then
         let starIdx ← newTrie (todo, lctx, v)
@@ -477,26 +475,25 @@ private def evalLazyEntry (config : WhnfCoreConfig)
 This evaluates all lazy entries in a trie and updates `values`, `starIdx`, and `children`
 accordingly.
 -/
-private partial def evalLazyEntries (config : WhnfCoreConfig)
+private partial def evalLazyEntries
     (values : Array α) (starIdx : TrieIndex) (children : Std.HashMap Key TrieIndex)
     (entries : Array (LazyEntry α)) :
     MatchM α (Array α × TrieIndex × Std.HashMap Key TrieIndex) := do
   let mut values := values
   let mut starIdx := starIdx
   let mut children := children
-  entries.foldlM (init := (values, starIdx, children)) (evalLazyEntry config)
+  entries.foldlM (init := (values, starIdx, children)) evalLazyEntry
 
 private def evalNode (c : TrieIndex) :
     MatchM α (Array α × TrieIndex × Std.HashMap Key TrieIndex) := do
   let .node vs star cs pending := (←get).get! c
   if pending.size = 0 then
-    pure (vs, star, cs)
+    return (vs, star, cs)
   else
-    let config ← read
     setTrie c default
-    let (vs, star, cs) ← evalLazyEntries config vs star cs pending
+    let (vs, star, cs) ← evalLazyEntries vs star cs pending
     setTrie c <| .node vs star cs #[]
-    pure (vs, star, cs)
+    return (vs, star, cs)
 
 def dropKeyAux (next : TrieIndex) (rest : List Key) :
     MatchM α Unit :=
@@ -723,11 +720,11 @@ private def push (d : PreDiscrTree α) (k : Key) (e : LazyEntry α) : PreDiscrTr
   d.modifyAt k (·.push e)
 
 /-- Convert a pre-discrimination tree to a lazy discrimination tree. -/
-private def toLazy (d : PreDiscrTree α) (config : WhnfCoreConfig := {}) : LazyDiscrTree α :=
+private def toLazy (d : PreDiscrTree α) : LazyDiscrTree α :=
   let { roots, tries } := d
   -- Adjust trie indices so the first value is reserved (so 0 is never a valid trie index)
   let roots := roots.fold (init := roots) (fun m k n => m.insert k (n+1))
-  { config, roots, tries := #[default] ++ tries.map (.node {} 0 {}) }
+  { roots, tries := #[default] ++ tries.map (.node {} 0 {}) }
 
 /-- Merge two discrimination trees. -/
 protected def append (x y : PreDiscrTree α) : PreDiscrTree α :=
@@ -756,12 +753,12 @@ namespace InitEntry
 /--
 Constructs an initial entry from an expression and value.
 -/
-def fromExpr (expr : Expr) (value : α) (config : WhnfCoreConfig := {}) : MetaM (InitEntry α) := do
+def fromExpr (expr : Expr) (value : α) : MetaM (InitEntry α) := do
   let lctx ← getLCtx
   let linst ← getLocalInstances
   let lctx := (lctx, linst)
-  let (key, todo) ← LazyDiscrTree.rootKey config expr
-  pure <| { key, entry := (todo, lctx, value) }
+  let (key, todo) ← LazyDiscrTree.rootKey expr
+  return { key, entry := (todo, lctx, value) }
 
 /--
 Creates an entry for a subterm of an initial entry.
@@ -769,11 +766,11 @@ Creates an entry for a subterm of an initial entry.
 This is slightly more efficient than using `fromExpr` on subterms since it avoids a redundant call
 to `whnf`.
 -/
-def mkSubEntry (e : InitEntry α) (idx : Nat) (value : α) (config : WhnfCoreConfig := {}) :
+def mkSubEntry (e : InitEntry α) (idx : Nat) (value : α) :
     MetaM (InitEntry α) := do
   let (todo, lctx, _) := e.entry
-  let (key, todo) ← LazyDiscrTree.rootKey config todo[idx]!
-  pure <| { key, entry := (todo, lctx, value) }
+  let (key, todo) ← LazyDiscrTree.rootKey todo[idx]!
+  return { key, entry := (todo, lctx, value) }
 
 end InitEntry
 

src/Lean/Meta/SynthInstance.lean

@@ -207,7 +207,7 @@ def getInstances (type : Expr) : MetaM (Array Instance) := do
     | none   => throwError "type class instance expected{indentExpr type}"
     | some className =>
       let globalInstances ← getGlobalInstancesIndex
-      let result ← globalInstances.getUnify type tcDtConfig
+      let result ← globalInstances.getUnify type
       -- Using insertion sort because it is stable and the array `result` should be mostly sorted.
       -- Most instances have default priority.
       let result := result.insertionSort fun e₁ e₂ => e₁.priority < e₂.priority

src/Lean/Meta/Tactic/FunInd.lean

@@ -776,7 +776,8 @@ In the type of `value`, reduces
 and then wraps `value` in an appropriate type hint.
 -/
 def cleanPackedArgs (eqnInfo : WF.EqnInfo) (value : Expr) : MetaM Expr := do
-  let t ← Meta.transform (← inferType value) (skipConstInApp := true) (pre := fun e => do
+  let type ← inferType value
+  let cleanType ← Meta.transform type (skipConstInApp := true) (pre := fun e => do
     -- Need to beta-reduce first
     let e' := e.headBeta
     if e' != e then
@@ -819,7 +820,7 @@ def cleanPackedArgs (eqnInfo : WF.EqnInfo) (value : Expr) : MetaM Expr := do
           return .continue e'
 
     return .continue e)
-  mkExpectedTypeHint value t
+  mkExpectedTypeHint value cleanType
 
 /--
 Takes `foo._unary.induct`, where the motive is a `PSigma`/`PSum` type and

src/Lean/Meta/Tactic/Injection.lean

@@ -114,10 +114,11 @@ where
         if lhs.isRawNatLit && rhs.isRawNatLit then cont
         else
           try
-            match (← injection mvarId fvarId newNames) with
-            | .solved  => return .solved
-            | .subgoal mvarId newEqs remainingNames =>
-              mvarId.withContext <| go d (newEqs.toList ++ fvarIds) mvarId remainingNames
+            commitIfNoEx do
+              match (← injection mvarId fvarId newNames) with
+              | .solved  => return .solved
+              | .subgoal mvarId newEqs remainingNames =>
+                mvarId.withContext <| go d (newEqs.toList ++ fvarIds) mvarId remainingNames
           catch _ => cont
       else cont
 

src/Lean/Meta/Tactic/LinearArith/Nat/Basic.lean

@@ -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)

src/Lean/Meta/Tactic/LinearArith/Nat/Simp.lean

@@ -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

src/Lean/Meta/Tactic/LinearArith/Solver.lean

@@ -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

src/Lean/Meta/Tactic/Replace.lean

@@ -33,17 +33,21 @@ def _root_.Lean.MVarId.replaceTargetEq (mvarId : MVarId) (targetNew : Expr) (eqP
     return mvarNew.mvarId!
 
 /--
-  Convert the given goal `Ctx |- target` into `Ctx |- targetNew`. It assumes the goals are definitionally equal.
-  We use the proof term
-  ```
-  @id target mvarNew
-  ```
-  to create a checkpoint. -/
+Converts the given goal `Ctx |- target` into `Ctx |- targetNew`. It assumes the goals are definitionally equal.
+We use the proof term
+```
+@id target mvarNew
+```
+to create a checkpoint.
+
+If `targetNew` is equal to `target`, then returns `mvarId` unchanged.
+Uses `Expr.equal` for the comparison so that it is possible to update binder names, etc., which are user-visible.
+-/
 def _root_.Lean.MVarId.replaceTargetDefEq (mvarId : MVarId) (targetNew : Expr) : MetaM MVarId :=
   mvarId.withContext do
     mvarId.checkNotAssigned `change
     let target  ← mvarId.getType
-    if target == targetNew then
+    if Expr.equal target targetNew then
       return mvarId
     else
       let tag     ← mvarId.getTag
@@ -95,12 +99,15 @@ abbrev _root_.Lean.MVarId.replaceLocalDecl (mvarId : MVarId) (fvarId : FVarId) (
   replaceLocalDeclCore mvarId fvarId typeNew eqProof
 
 /--
-Replace the type of `fvarId` at `mvarId` with `typeNew`.
+Replaces the type of `fvarId` at `mvarId` with `typeNew`.
 Remark: this method assumes that `typeNew` is definitionally equal to the current type of `fvarId`.
+
+If `typeNew` is equal to current type of `fvarId`, then returns `mvarId` unchanged.
+Uses `Expr.equal` for the comparison so that it is possible to update binder names, etc., which are user-visible.
 -/
 def _root_.Lean.MVarId.replaceLocalDeclDefEq (mvarId : MVarId) (fvarId : FVarId) (typeNew : Expr) : MetaM MVarId := do
   mvarId.withContext do
-    if typeNew == (← fvarId.getType) then
+    if Expr.equal typeNew (← fvarId.getType) then
       return mvarId
     else
       let mvarDecl ← mvarId.getDecl

src/Lean/Meta/Tactic/Rfl.lean

@@ -19,9 +19,6 @@ namespace Lean.Meta.Rfl
 
 open Lean Meta
 
-/-- Discrimation tree settings for the `refl` extension. -/
-def reflExt.config : WhnfCoreConfig := {}
-
 /-- Environment extensions for `refl` lemmas -/
 initialize reflExt :
     SimpleScopedEnvExtension (Name × Array DiscrTree.Key) (DiscrTree Name) ←
@@ -42,7 +39,7 @@ initialize registerBuiltinAttribute {
     if let .app (.const ``Eq [_]) _ := rel then
       throwError "@[refl] attribute may not be used on `Eq.refl`."
     unless ← withNewMCtxDepth <| isDefEq lhs rhs do fail
-    let key ← DiscrTree.mkPath rel reflExt.config
+    let key ← DiscrTree.mkPath rel
     reflExt.add (decl, key) kind
 }
 
@@ -91,7 +88,7 @@ def _root_.Lean.MVarId.applyRfl (goal : MVarId) : MetaM Unit := goal.withContext
     goal.setType (.app t.appFn! lhs)
     let s ← saveState
     let mut ex? := none
-    for lem in ← (reflExt.getState (← getEnv)).getMatch rel reflExt.config do
+    for lem in ← (reflExt.getState (← getEnv)).getMatch rel do
       try
         let gs ← goal.apply (← mkConstWithFreshMVarLevels lem)
         if gs.isEmpty then return () else
@@ -123,7 +120,7 @@ def _root_.Lean.MVarId.liftReflToEq (mvarId : MVarId) : MetaM MVarId := do
   if rel.isAppOf `Eq then
     -- No need to lift Eq to Eq
     return mvarId
-  for lem in ← (reflExt.getState (← getEnv)).getMatch rel reflExt.config do
+  for lem in ← (reflExt.getState (← getEnv)).getMatch rel do
     let res ← observing? do
       -- First create an equality relating the LHS and RHS
       -- and reduce the goal to proving that LHS is related to LHS.

src/Lean/Meta/Tactic/Simp/Main.lean

@@ -239,9 +239,10 @@ def withNewLemmas {α} (xs : Array Expr) (f : SimpM α) : SimpM α := do
     withFreshCache do
       let mut s ← getSimpTheorems
       let mut updated := false
+      let ctx ← getContext
       for x in xs do
         if (← isProof x) then
-          s ← s.addTheorem (.fvar x.fvarId!) x
+          s ← s.addTheorem (.fvar x.fvarId!) x (config := ctx.indexConfig)
           updated := true
       if updated then
         withSimpTheorems s f
@@ -832,7 +833,7 @@ def simpTargetStar (mvarId : MVarId) (ctx : Simp.Context) (simprocs : SimprocsAr
   for h in (← getPropHyps) do
     let localDecl ← h.getDecl
     let proof  := localDecl.toExpr
-    let simpTheorems ← ctx.simpTheorems.addTheorem (.fvar h) proof
+    let simpTheorems ← ctx.simpTheorems.addTheorem (.fvar h) proof (config := ctx.indexConfig)
     ctx := ctx.setSimpTheorems simpTheorems
   match (← simpTarget mvarId ctx simprocs discharge? (stats := stats)) with
   | (none, stats) => return (TacticResultCNM.closed, stats)

src/Lean/Meta/Tactic/Simp/Rewrite.lean

@@ -203,7 +203,7 @@ def rewrite? (e : Expr) (s : SimpTheoremTree) (erased : PHashSet Origin) (tag :
 where
   /-- For `(← getConfig).index := true`, use discrimination tree structure when collecting `simp` theorem candidates. -/
   rewriteUsingIndex? : SimpM (Option Result) := do
-    let candidates ← s.getMatchWithExtra e (getDtConfig (← getConfig))
+    let candidates ← withSimpIndexConfig <| s.getMatchWithExtra e
     if candidates.isEmpty then
       trace[Debug.Meta.Tactic.simp] "no theorems found for {tag}-rewriting {e}"
       return none
@@ -221,7 +221,7 @@ where
   Only the root symbol is taken into account. Most of the structure of the discrimination tree is ignored.
   -/
   rewriteNoIndex? : SimpM (Option Result) := do
-    let (candidates, numArgs) ← s.getMatchLiberal e (getDtConfig (← getConfig))
+    let (candidates, numArgs) ← withSimpIndexConfig <| s.getMatchLiberal e
     if candidates.isEmpty then
       trace[Debug.Meta.Tactic.simp] "no theorems found for {tag}-rewriting {e}"
       return none
@@ -245,7 +245,7 @@ where
 
   diagnoseWhenNoIndex (thm : SimpTheorem) : SimpM Unit := do
     if (← isDiagnosticsEnabled) then
-      let candidates ← s.getMatchWithExtra e (getDtConfig (← getConfig))
+      let candidates ← withSimpIndexConfig <| s.getMatchWithExtra e
       for (candidate, _) in candidates do
         if unsafe ptrEq thm candidate then
           return ()

src/Lean/Meta/Tactic/Simp/SimpAll.lean

@@ -42,7 +42,8 @@ private def initEntries : M Unit := do
     unless simpThms.isErased (.fvar h) do
       let localDecl ← h.getDecl
       let proof  := localDecl.toExpr
-      simpThms ← simpThms.addTheorem (.fvar h) proof
+      let ctx := (← get).ctx
+      simpThms ← simpThms.addTheorem (.fvar h) proof (config := ctx.indexConfig)
       modify fun s => { s with ctx := s.ctx.setSimpTheorems simpThms }
       if hsNonDeps.contains h then
         -- We only simplify nondependent hypotheses
@@ -95,7 +96,7 @@ private partial def loop : M Bool := do
         trace[Meta.Tactic.simp.all] "entry.id: {← ppOrigin entry.id}, {entry.type} => {typeNew}"
         let mut simpThmsNew := (← getSimpTheorems).eraseTheorem (.fvar entry.fvarId)
         let idNew ← mkFreshId
-        simpThmsNew ← simpThmsNew.addTheorem (.other idNew) (← mkExpectedTypeHint proofNew typeNew)
+        simpThmsNew ← simpThmsNew.addTheorem (.other idNew) (← mkExpectedTypeHint proofNew typeNew) (config := ctx.indexConfig)
         modify fun s => { s with
           modified         := true
           ctx              := ctx.setSimpTheorems simpThmsNew

src/Lean/Meta/Tactic/Simp/SimpTheorems.lean

@@ -204,8 +204,18 @@ structure SimpTheorems where
   toUnfoldThms : PHashMap Name (Array Name) := {}
   deriving Inhabited
 
-/-- Configuration for the discrimination tree. -/
-def simpDtConfig : WhnfCoreConfig := { iota := false, proj := .no, zetaDelta := false }
+/--
+Configuration for `MetaM` used to process global simp theorems
+-/
+def simpGlobalConfig : ConfigWithKey :=
+  { iota         := false
+    proj         := .no
+    zetaDelta    := false
+    transparency := .reducible
+  : Config }.toConfigWithKey
+
+@[inline] def withSimpGlobalConfig : MetaM α → MetaM α :=
+  withConfigWithKey simpGlobalConfig
 
 partial def SimpTheorems.eraseCore (d : SimpTheorems) (thmId : Origin) : SimpTheorems :=
   let d := { d with erased := d.erased.insert thmId, lemmaNames := d.lemmaNames.erase thmId }
@@ -298,7 +308,7 @@ private partial def isPerm : Expr → Expr → MetaM Bool
   | s, t => return s == t
 
 private def checkBadRewrite (lhs rhs : Expr) : MetaM Unit := do
-  let lhs ← DiscrTree.reduceDT lhs (root := true) simpDtConfig
+  let lhs ← withSimpGlobalConfig <| DiscrTree.reduceDT lhs (root := true)
   if lhs == rhs && lhs.isFVar then
     throwError "invalid `simp` theorem, equation is equivalent to{indentExpr (← mkEq lhs rhs)}"
 
@@ -381,11 +391,11 @@ private def mkSimpTheoremCore (origin : Origin) (e : Expr) (levelParams : Array
   assert! origin != .fvar ⟨.anonymous⟩
   let type ← instantiateMVars (← inferType e)
   withNewMCtxDepth do
-    let (_, _, type) ← withReducible <| forallMetaTelescopeReducing type
+    let (_, _, type) ← forallMetaTelescopeReducing type
     let type ← whnfR type
     let (keys, perm) ←
       match type.eq? with
-      | some (_, lhs, rhs) => pure (← DiscrTree.mkPath lhs simpDtConfig noIndexAtArgs, ← isPerm lhs rhs)
+      | some (_, lhs, rhs) => pure (← DiscrTree.mkPath lhs noIndexAtArgs, ← isPerm lhs rhs)
       | none => throwError "unexpected kind of 'simp' theorem{indentExpr type}"
     return { origin, keys, perm, post, levelParams, proof, priority := prio, rfl := (← isRflProof proof) }
 
@@ -394,7 +404,7 @@ private def mkSimpTheoremsFromConst (declName : Name) (post : Bool) (inv : Bool)
   let us := cinfo.levelParams.map mkLevelParam
   let origin := .decl declName post inv
   let val := mkConst declName us
-  withReducible do
+  withSimpGlobalConfig do
     let type ← inferType val
     checkTypeIsProp type
     if inv || (← shouldPreprocess type) then
@@ -464,18 +474,10 @@ private def preprocessProof (val : Expr) (inv : Bool) : MetaM (Array Expr) := do
   return ps.toArray.map fun (val, _) => val
 
 /-- Auxiliary method for creating simp theorems from a proof term `val`. -/
-def mkSimpTheorems (id : Origin) (levelParams : Array Name) (proof : Expr) (post := true) (inv := false) (prio : Nat := eval_prio default) : MetaM (Array SimpTheorem) :=
+private def mkSimpTheorems (id : Origin) (levelParams : Array Name) (proof : Expr) (post := true) (inv := false) (prio : Nat := eval_prio default) : MetaM (Array SimpTheorem) :=
   withReducible do
     (← preprocessProof proof inv).mapM fun val => mkSimpTheoremCore id val levelParams val post prio (noIndexAtArgs := true)
 
-/-- Auxiliary method for adding a local simp theorem to a `SimpTheorems` datastructure. -/
-def SimpTheorems.add (s : SimpTheorems) (id : Origin) (levelParams : Array Name) (proof : Expr) (inv := false) (post := true) (prio : Nat := eval_prio default) : MetaM SimpTheorems := do
-  if proof.isConst then
-    s.addConst proof.constName! post inv prio
-  else
-    let simpThms ← mkSimpTheorems id levelParams proof post inv prio
-    return simpThms.foldl addSimpTheoremEntry s
-
 /--
 Reducible functions and projection functions should always be put in `toUnfold`, instead
 of trying to use equational theorems.
@@ -533,14 +535,25 @@ def SimpTheorems.addDeclToUnfold (d : SimpTheorems) (declName : Name) : MetaM Si
   else
     return d.addDeclToUnfoldCore declName
 
+/-- Auxiliary method for adding a local simp theorem to a `SimpTheorems` datastructure. -/
+def SimpTheorems.add (s : SimpTheorems) (id : Origin) (levelParams : Array Name) (proof : Expr)
+        (inv := false) (post := true) (prio : Nat := eval_prio default)
+        (config : ConfigWithKey := simpGlobalConfig) : MetaM SimpTheorems := do
+  if proof.isConst then
+    -- Recall that we use `simpGlobalConfig` for processing global declarations.
+    s.addConst proof.constName! post inv prio
+  else
+    let simpThms ← withConfigWithKey config <| mkSimpTheorems id levelParams proof post inv prio
+    return simpThms.foldl addSimpTheoremEntry s
+
 abbrev SimpTheoremsArray := Array SimpTheorems
 
-def SimpTheoremsArray.addTheorem (thmsArray : SimpTheoremsArray) (id : Origin) (h : Expr) : MetaM SimpTheoremsArray :=
+def SimpTheoremsArray.addTheorem (thmsArray : SimpTheoremsArray) (id : Origin) (h : Expr) (config : ConfigWithKey := simpGlobalConfig) : MetaM SimpTheoremsArray :=
   if thmsArray.isEmpty then
     let thms : SimpTheorems := {}
-    return #[ (← thms.add id #[] h) ]
+    return #[ (← thms.add id #[] h (config := config)) ]
   else
-    thmsArray.modifyM 0 fun thms => thms.add id #[] h
+    thmsArray.modifyM 0 fun thms => thms.add id #[] h (config := config)
 
 def SimpTheoremsArray.eraseTheorem (thmsArray : SimpTheoremsArray) (thmId : Origin) : SimpTheoremsArray :=
   thmsArray.map fun thms => thms.eraseCore thmId

src/Lean/Meta/Tactic/Simp/Simproc.lean

@@ -213,7 +213,7 @@ def SimprocEntry.tryD (s : SimprocEntry) (numExtraArgs : Nat) (e : Expr) : SimpM
   | .inr proc => return (← proc e).addExtraArgs extraArgs
 
 def simprocCore (post : Bool) (s : SimprocTree) (erased : PHashSet Name) (e : Expr) : SimpM Step := do
-  let candidates ← s.getMatchWithExtra e (getDtConfig (← getConfig))
+  let candidates ← withSimpIndexConfig <| s.getMatchWithExtra e
   if candidates.isEmpty then
     let tag := if post then "post" else "pre"
     trace[Debug.Meta.Tactic.simp] "no {tag}-simprocs found for {e}"
@@ -250,7 +250,7 @@ def simprocCore (post : Bool) (s : SimprocTree) (erased : PHashSet Name) (e : Ex
       return .continue
 
 def dsimprocCore (post : Bool) (s : SimprocTree) (erased : PHashSet Name) (e : Expr) : SimpM DStep := do
-  let candidates ← s.getMatchWithExtra e (getDtConfig (← getConfig))
+  let candidates ← withSimpIndexConfig <| s.getMatchWithExtra e
   if candidates.isEmpty then
     let tag := if post then "post" else "pre"
     trace[Debug.Meta.Tactic.simp] "no {tag}-simprocs found for {e}"

src/Lean/Meta/Tactic/Simp/Types.lean

@@ -53,7 +53,9 @@ abbrev CongrCache := ExprMap (Option CongrTheorem)
 
 structure Context where
   private mk ::
-  config           : Config := {}
+  config            : Config := {}
+  metaConfig        : ConfigWithKey := default
+  indexConfig       : ConfigWithKey := default
   /-- `maxDischargeDepth` from `config` as an `UInt32`. -/
   maxDischargeDepth : UInt32 := UInt32.ofNatTruncate config.maxDischargeDepth
   simpTheorems      : SimpTheoremsArray := {}
@@ -117,9 +119,32 @@ private def updateArith (c : Config) : CoreM Config := do
   else
     return c
 
+/--
+Converts `Simp.Config` into `Meta.ConfigWithKey` used for indexing.
+-/
+private def mkIndexConfig (c : Config) : ConfigWithKey :=
+  { c with
+    proj         := .no
+    transparency := .reducible
+  : Meta.Config }.toConfigWithKey
+
+/--
+Converts `Simp.Config` into `Meta.ConfigWithKey` used for `isDefEq`.
+-/
+-- TODO: use `metaConfig` at `isDefEq`. It is not being used yet because it will break Mathlib.
+private def mkMetaConfig (c : Config) : ConfigWithKey :=
+  { c with
+    proj         := if c.proj then .yesWithDelta else .no
+    transparency := .reducible
+  : Meta.Config }.toConfigWithKey
+
 def mkContext (config : Config := {}) (simpTheorems : SimpTheoremsArray := {}) (congrTheorems : SimpCongrTheorems := {}) : MetaM Context := do
   let config ← updateArith config
-  return { config, simpTheorems, congrTheorems }
+  return {
+    config, simpTheorems, congrTheorems
+    metaConfig := mkMetaConfig config
+    indexConfig := mkIndexConfig config
+  }
 
 def Context.setConfig (context : Context) (config : Config) : Context :=
   { context with config }
@@ -203,6 +228,15 @@ abbrev SimpM := ReaderT MethodsRef $ ReaderT Context $ StateRefT State MetaM
 @[inline] def withInDSimp : SimpM α → SimpM α :=
   withTheReader Context (fun ctx => { ctx with inDSimp := true })
 
+/--
+Executes `x` using a `MetaM` configuration for indexing terms.
+It is inferred from `Simp.Config`.
+For example, if the user has set `simp (config := { zeta := false })`,
+`isDefEq` and `whnf` in `MetaM` should not perform `zeta` reduction.
+-/
+@[inline] def withSimpIndexConfig (x : SimpM α) : SimpM α := do
+  withConfigWithKey (← readThe Simp.Context).indexConfig x
+
 @[extern "lean_simp"]
 opaque simp (e : Expr) : SimpM Result
 
@@ -679,16 +713,6 @@ def tryAutoCongrTheorem? (e : Expr) : SimpM (Option Result) := do
     /- See comment above. This is reachable if `hasCast == true`. The `rhs` is not structurally equal to `mkAppN f argsNew` -/
     return some { expr := rhs }
 
-/--
-Return a WHNF configuration for retrieving `[simp]` from the discrimination tree.
-If user has disabled `zeta` and/or `beta` reduction in the simplifier, or enabled `zetaDelta`,
-we must also disable/enable them when retrieving lemmas from discrimination tree. See issues: #2669 and #2281
--/
-def getDtConfig (cfg : Config) : WhnfCoreConfig :=
-  match cfg.beta, cfg.zeta, cfg.zetaDelta with
-  | true, true, false => simpDtConfig
-  | _,    _,    _     => { simpDtConfig with zeta := cfg.zeta, beta := cfg.beta, zetaDelta := cfg.zetaDelta }
-
 def Result.addExtraArgs (r : Result) (extraArgs : Array Expr) : MetaM Result := do
   match r.proof? with
   | none => return { expr := mkAppN r.expr extraArgs }

src/Lean/Meta/Tactic/Symm.lean

@@ -18,9 +18,6 @@ open Lean Meta
 
 namespace Lean.Meta.Symm
 
-/-- Discrimation tree settings for the `symm` extension. -/
-def symmExt.config : WhnfCoreConfig := {}
-
 /-- Environment extensions for symm lemmas -/
 builtin_initialize symmExt :
     SimpleScopedEnvExtension (Name × Array DiscrTree.Key) (DiscrTree Name) ←
@@ -40,7 +37,7 @@ builtin_initialize registerBuiltinAttribute {
     let some _ := xs.back? | fail
     let targetTy ← reduce targetTy
     let .app (.app rel _) _ := targetTy | fail
-    let key ← withReducible <| DiscrTree.mkPath rel symmExt.config
+    let key ← withReducible <| DiscrTree.mkPath rel
     symmExt.add (decl, key) kind
 }
 
@@ -54,7 +51,7 @@ namespace Lean.Expr
 def getSymmLems (tgt : Expr) : MetaM (Array Name) := do
   let .app (.app rel _) _ := tgt
     | throwError "symmetry lemmas only apply to binary relations, not{indentExpr tgt}"
-  (symmExt.getState (← getEnv)).getMatch rel symmExt.config
+  (symmExt.getState (← getEnv)).getMatch rel
 
 /-- Given a term `e : a ~ b`, construct a term in `b ~ a` using `@[symm]` lemmas. -/
 def applySymm (e : Expr) : MetaM Expr := do

src/Lean/Meta/UnificationHint.lean

@@ -6,6 +6,7 @@ Authors: Leonardo de Moura
 prelude
 import Lean.ScopedEnvExtension
 import Lean.Util.Recognizers
+import Lean.Meta.Basic
 import Lean.Meta.DiscrTree
 import Lean.Meta.SynthInstance
 
@@ -27,7 +28,8 @@ structure UnificationHints where
 instance : ToFormat UnificationHints where
   format h := format h.discrTree
 
-def UnificationHints.config : WhnfCoreConfig := { iota := false, proj := .no }
+private def config : ConfigWithKey :=
+  { iota := false, proj := .no : Config }.toConfigWithKey
 
 def UnificationHints.add (hints : UnificationHints) (e : UnificationHintEntry) : UnificationHints :=
   { hints with discrTree := hints.discrTree.insertCore e.keys e.val }
@@ -81,7 +83,7 @@ def addUnificationHint (declName : Name) (kind : AttributeKind) : MetaM Unit :=
       match decodeUnificationHint body with
       | Except.error msg => throwError msg
       | Except.ok hint =>
-        let keys ← DiscrTree.mkPath hint.pattern.lhs UnificationHints.config
+        let keys ← withConfigWithKey config <| DiscrTree.mkPath hint.pattern.lhs
         validateHint hint
         unificationHintExtension.add { keys := keys, val := declName } kind
 
@@ -101,7 +103,7 @@ def tryUnificationHints (t s : Expr) : MetaM Bool := do
   if t.isMVar then
     return false
   let hints := unificationHintExtension.getState (← getEnv)
-  let candidates ← hints.discrTree.getMatch t UnificationHints.config
+  let candidates ← withConfigWithKey config <| hints.discrTree.getMatch t
   for candidate in candidates do
     if (← tryCandidate candidate) then
       return true

src/Lean/Meta/WHNF.lean

@@ -328,65 +328,8 @@ end
 /-! # Weak Head Normal Form auxiliary combinators -/
 -- ===========================
 
-/--
-Configuration for projection reduction. See `whnfCore`.
--/
-inductive ProjReductionKind where
-  /-- Projections `s.i` are not reduced at `whnfCore`. -/
-  | no
-  /--
-  Projections `s.i` are reduced at `whnfCore`, and `whnfCore` is used at `s` during the process.
-  Recall that `whnfCore` does not perform `delta` reduction (i.e., it will not unfold constant declarations).
-  -/
-  | yes
-  /--
-  Projections `s.i` are reduced at `whnfCore`, and `whnf` is used at `s` during the process.
-  Recall that `whnfCore` does not perform `delta` reduction (i.e., it will not unfold constant declarations), but `whnf` does.
-  -/
-  | yesWithDelta
-  /--
-  Projections `s.i` are reduced at `whnfCore`, and `whnfAtMostI` is used at `s` during the process.
-  Recall that `whnfAtMostI` is like `whnf` but uses transparency at most `instances`.
-  This option is stronger than `yes`, but weaker than `yesWithDelta`.
-  We use this option to ensure we reduce projections to prevent expensive defeq checks when unifying TC operations.
-  When unifying e.g. `(@Field.toNeg α inst1).1 =?= (@Field.toNeg α inst2).1`,
-  we only want to unify negation (and not all other field operations as well).
-  Unifying the field instances slowed down unification: https://github.com/leanprover/lean4/issues/1986
-  -/
-  | yesWithDeltaI
-  deriving DecidableEq, Inhabited, Repr
-
-/--
-Configuration options for `whnfEasyCases` and `whnfCore`.
--/
-structure WhnfCoreConfig where
-  /-- If `true`, reduce recursor/matcher applications, e.g., `Nat.rec true (fun _ _ => false) Nat.zero` reduces to `true` -/
-  iota : Bool := true
-  /-- If `true`, reduce terms such as `(fun x => t[x]) a` into `t[a]` -/
-  beta : Bool := true
-  /-- Control projection reduction at `whnfCore`. -/
-  proj : ProjReductionKind := .yesWithDelta
-  /--
-  Zeta reduction: `let x := v; e[x]` reduces to `e[v]`.
-  We say a let-declaration `let x := v; e` is non dependent if it is equivalent to `(fun x => e) v`.
-  Recall that
-  ```
-  fun x : BitVec 5 => let n := 5; fun y : BitVec n => x = y
-  ```
-  is type correct, but
-  ```
-  fun x : BitVec 5 => (fun n => fun y : BitVec n => x = y) 5
-  ```
-  is not.
-  -/
-  zeta : Bool := true
-  /--
-  Zeta-delta reduction: given a local context containing entry `x : t := e`, free variable `x` reduces to `e`.
-  -/
-  zetaDelta : Bool := true
-
 /-- Auxiliary combinator for handling easy WHNF cases. It takes a function for handling the "hard" cases as an argument -/
-@[specialize] partial def whnfEasyCases (e : Expr) (k : Expr → MetaM Expr) (config : WhnfCoreConfig := {}) : MetaM Expr := do
+@[specialize] partial def whnfEasyCases (e : Expr) (k : Expr → MetaM Expr) : MetaM Expr := do
   match e with
   | .forallE ..    => return e
   | .lam ..        => return e
@@ -397,7 +340,7 @@ structure WhnfCoreConfig where
   | .const ..      => k e
   | .app ..        => k e
   | .proj ..       => k e
-  | .mdata _ e     => whnfEasyCases e k config
+  | .mdata _ e     => whnfEasyCases e k
   | .fvar fvarId   =>
     let decl ← fvarId.getDecl
     match decl with
@@ -405,13 +348,14 @@ structure WhnfCoreConfig where
     | .ldecl (value := v) .. =>
       -- Let-declarations marked as implementation detail should always be unfolded
       -- We initially added this feature for `simp`, and added it here for consistency.
-      unless config.zetaDelta || decl.isImplementationDetail do return e
-      if (← getConfig).trackZetaDelta then
+      let cfg ← getConfig
+      unless cfg.zetaDelta || decl.isImplementationDetail do return e
+      if cfg.trackZetaDelta then
         modify fun s => { s with zetaDeltaFVarIds := s.zetaDeltaFVarIds.insert fvarId }
-      whnfEasyCases v k config
+      whnfEasyCases v k
   | .mvar mvarId   =>
     match (← getExprMVarAssignment? mvarId) with
-    | some v => whnfEasyCases v k config
+    | some v => whnfEasyCases v k
     | none   => return e
 
 @[specialize] private def deltaDefinition (c : ConstantInfo) (lvls : List Level)
@@ -611,30 +555,31 @@ private def whnfDelayedAssigned? (f' : Expr) (e : Expr) : MetaM (Option Expr) :=
 Apply beta-reduction, zeta-reduction (i.e., unfold let local-decls), iota-reduction,
 expand let-expressions, expand assigned meta-variables.
 -/
-partial def whnfCore (e : Expr) (config : WhnfCoreConfig := {}): MetaM Expr :=
+partial def whnfCore (e : Expr) : MetaM Expr :=
   go e
 where
   go (e : Expr) : MetaM Expr :=
-    whnfEasyCases e (config := config) fun e => do
+    whnfEasyCases e fun e => do
       trace[Meta.whnf] e
       match e with
       | .const ..  => pure e
-      | .letE _ _ v b _ => if config.zeta then go <| b.instantiate1 v else return e
+      | .letE _ _ v b _ => if (← getConfig).zeta then go <| b.instantiate1 v else return e
       | .app f ..       =>
-        if config.zeta then
+        let cfg ← getConfig
+        if cfg.zeta then
           if let some (args, _, _, v, b) := e.letFunAppArgs? then
             -- When zeta reducing enabled, always reduce `letFun` no matter the current reducibility level
             return (← go <| mkAppN (b.instantiate1 v) args)
         let f := f.getAppFn
         let f' ← go f
-        if config.beta && f'.isLambda then
+        if cfg.beta && f'.isLambda then
           let revArgs := e.getAppRevArgs
           go <| f'.betaRev revArgs
         else if let some eNew ← whnfDelayedAssigned? f' e then
           go eNew
         else
           let e := if f == f' then e else e.updateFn f'
-          unless config.iota do return e
+          unless cfg.iota do return e
           match (← reduceMatcher? e) with
           | .reduced eNew => go eNew
           | .partialApp   => pure e
@@ -656,7 +601,7 @@ where
           match (← projectCore? c i) with
           | some e => go e
           | none => return e
-        match config.proj with
+        match (← getConfig).proj with
         | .no => return e
         | .yes => k (← go c)
         | .yesWithDelta => k (← whnf c)
@@ -967,26 +912,18 @@ def reduceNat? (e : Expr) : MetaM (Option Expr) :=
   if e.hasFVar || e.hasExprMVar || (← read).canUnfold?.isSome then
     return false
   else
-    match (← getConfig).transparency with
-    | .default => return true
-    | .all     => return true
-    | _        => return false
+    return true
 
 @[inline] private def cached? (useCache : Bool) (e : Expr) : MetaM (Option Expr) := do
   if useCache then
-    match (← getConfig).transparency with
-    | .default => return (← get).cache.whnfDefault.find? e
-    | .all     => return (← get).cache.whnfAll.find? e
-    | _        => unreachable!
+    return (← get).cache.whnf.find? (← mkExprConfigCacheKey e)
   else
     return none
 
 private def cache (useCache : Bool) (e r : Expr) : MetaM Expr := do
   if useCache then
-    match (← getConfig).transparency with
-    | .default => modify fun s => { s with cache.whnfDefault := s.cache.whnfDefault.insert e r }
-    | .all     => modify fun s => { s with cache.whnfAll     := s.cache.whnfAll.insert e r }
-    | _        => unreachable!
+    let key ← mkExprConfigCacheKey e
+    modify fun s => { s with cache.whnf := s.cache.whnf.insert key r }
   return r
 
 @[export lean_whnf]

src/Lean/MetavarContext.lean

@@ -1219,7 +1219,7 @@ private def mkLambda' (x : Name) (bi : BinderInfo) (t : Expr) (b : Expr) (etaRed
   Similar to `LocalContext.mkBinding`, but handles metavariables correctly.
   If `usedOnly == true` then `forall` and `lambda` expressions are created only for used variables.
   If `usedLetOnly == true` then `let` expressions are created only for used (let-) variables. -/
-@[specialize] def mkBinding (isLambda : Bool) (lctx : LocalContext) (xs : Array Expr) (e : Expr) (usedOnly : Bool) (usedLetOnly : Bool) (etaReduce : Bool) : M Expr := do
+def mkBinding (isLambda : Bool) (lctx : LocalContext) (xs : Array Expr) (e : Expr) (usedOnly : Bool) (usedLetOnly : Bool) (etaReduce : Bool) : M Expr := do
   let e ← abstractRange xs xs.size e
   xs.size.foldRevM (init := e) fun i e => do
       let x := xs[i]!

src/Lean/PrettyPrinter/Delaborator/Builtins.lean

@@ -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

src/Lean/PrettyPrinter/Delaborator/Options.lean

@@ -24,6 +24,11 @@ register_builtin_option pp.notation : Bool := {
   group    := "pp"
   descr    := "(pretty printer) disable/enable notation (infix, mixfix, postfix operators and unicode characters)"
 }
+register_builtin_option pp.parens : Bool := {
+  defValue := false
+  group    := "pp"
+  descr    := "(pretty printer) if set to true, notation is wrapped in parentheses regardless of precedence"
+}
 register_builtin_option pp.unicode.fun : Bool := {
   defValue := false
   group    := "pp"
@@ -248,6 +253,7 @@ def getPPNatLit (o : Options) : Bool := o.get pp.natLit.name (getPPNumericTypes
 def getPPCoercions (o : Options) : Bool := o.get pp.coercions.name (!getPPAll o)
 def getPPExplicit (o : Options) : Bool := o.get pp.explicit.name (getPPAll o)
 def getPPNotation (o : Options) : Bool := o.get pp.notation.name (!getPPAll o)
+def getPPParens (o : Options) : Bool := o.get pp.parens.name pp.parens.defValue
 def getPPUnicodeFun (o : Options) : Bool := o.get pp.unicode.fun.name false
 def getPPMatch (o : Options) : Bool := o.get pp.match.name (!getPPAll o)
 def getPPFieldNotation (o : Options) : Bool := o.get pp.fieldNotation.name (!getPPAll o)

src/Lean/PrettyPrinter/Parenthesizer.lean

@@ -8,6 +8,7 @@ import Lean.Parser.Extension
 import Lean.Parser.StrInterpolation
 import Lean.ParserCompiler.Attribute
 import Lean.PrettyPrinter.Basic
+import Lean.PrettyPrinter.Delaborator.Options
 
 
 /-!
@@ -82,8 +83,10 @@ namespace PrettyPrinter
 namespace Parenthesizer
 
 structure Context where
-  -- We need to store this `categoryParser` argument to deal with the implicit Pratt parser call in `trailingNode.parenthesizer`.
+  /-- We need to store this `categoryParser` argument to deal with the implicit Pratt parser call in `trailingNode.parenthesizer`. -/
   cat : Name := Name.anonymous
+  /-- Whether to add parentheses regardless of any other conditions. This is cached from the `pp.parens` option. -/
+  forceParens : Bool := false
 
 structure State where
   stxTrav : Syntax.Traverser
@@ -217,8 +220,13 @@ def maybeParenthesize (cat : Name) (canJuxtapose : Bool) (mkParen : Syntax → S
   let { minPrec := some minPrec, trailPrec := trailPrec, trailCat := trailCat, .. } ← get
     | trace[PrettyPrinter.parenthesize] "visited a syntax tree without precedences?!{line ++ format stx}"
   trace[PrettyPrinter.parenthesize] (m!"...precedences are {prec} >? {minPrec}" ++ if canJuxtapose then m!", {(trailPrec, trailCat)} <=? {(st.contPrec, st.contCat)}" else "")
-  -- Should we parenthesize?
-  if (prec > minPrec || canJuxtapose && match trailPrec, st.contPrec with | some trailPrec, some contPrec => trailCat == st.contCat && trailPrec <= contPrec | _, _ => false) then
+  /- Should we parenthesize?
+     * Note about forceParens mode: we don't insert outermost parentheses (we use the syntax traverser parents to detect this),
+       and we don't insert parentheses when we are at `maxPrec` (since this is effectively infinity).
+  -/
+  if (((← read).forceParens && !st.stxTrav.parents.isEmpty && minPrec < Parser.maxPrec)
+      || prec > minPrec
+      || canJuxtapose && match trailPrec, st.contPrec with | some trailPrec, some contPrec => trailCat == st.contCat && trailPrec <= contPrec | _, _ => false) then
       -- The recursive `visit` call, by the invariant, has moved to the preceding node. In order to parenthesize
       -- the original node, we must first move to the right, except if we already were at the left-most child in the first
       -- place.
@@ -540,16 +548,23 @@ instance : Coe (Parenthesizer → Parenthesizer → Parenthesizer) Parenthesizer
 end Parenthesizer
 open Parenthesizer
 
-/-- Add necessary parentheses in `stx` parsed by `parser`. -/
+/--
+Adds necessary parentheses in `stx` parsed by `parser`.
+-/
 def parenthesize (parenthesizer : Parenthesizer) (stx : Syntax) : CoreM Syntax := do
   trace[PrettyPrinter.parenthesize.input] "{format stx}"
+  let opts ← getOptions
   catchInternalId backtrackExceptionId
     (do
-      let (_, st) ← (parenthesizer {}).run { stxTrav := Syntax.Traverser.fromSyntax stx }
+      let (_, st) ← (parenthesizer { forceParens := getPPParens opts }).run { stxTrav := Syntax.Traverser.fromSyntax stx }
       pure st.stxTrav.cur)
     (fun _ => throwError "parenthesize: uncaught backtrack exception")
 
-def parenthesizeCategory (cat : Name) := parenthesize <| categoryParser.parenthesizer cat 0
+/--
+Adds necessary parentheses to the syntax in the given category (for example, `term`, `tactic`, or `command`).
+-/
+def parenthesizeCategory (cat : Name) (stx : Syntax) :=
+  parenthesize (categoryParser.parenthesizer cat 0) stx
 
 def parenthesizeTerm := parenthesizeCategory `term
 def parenthesizeTactic := parenthesizeCategory `tactic

src/Std.lean

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

src/Std/Internal/Rat.lean

@@ -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

src/Std/Tactic/BVDecide/Normalize/Canonicalize.lean

@@ -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

src/Std/Tactic/BVDecide/Syntax.lean

@@ -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.
   -/

src/Std/Time.lean

@@ -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.
+
+-/

src/Std/Time/Date.lean

@@ -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

src/Std/Time/Date/Basic.lean

@@ -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

src/Std/Time/Date/PlainDate.lean

@@ -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

src/Std/Time/Date/Unit/Basic.lean

@@ -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

src/Std/Time/Date/Unit/Day.lean

@@ -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

src/Std/Time/Date/Unit/Month.lean

@@ -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

src/Std/Time/Date/Unit/Week.lean

@@ -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

src/Std/Time/Date/Unit/Weekday.lean

@@ -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

src/Std/Time/Date/Unit/Year.lean

@@ -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

src/Std/Time/Date/ValidDate.lean

@@ -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

src/Std/Time/DateTime.lean

@@ -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

src/Std/Time/DateTime/PlainDateTime.lean

@@ -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

src/Std/Time/DateTime/Timestamp.lean

@@ -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

src/Std/Time/Duration.lean

@@ -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

src/Std/Time/Format.lean

@@ -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

src/Std/Time/Internal.lean

@@ -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

src/Std/Time/Internal/Bounded.lean

@@ -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

src/Std/Time/Internal/UnitVal.lean

@@ -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

src/Std/Time/Notation.lean

@@ -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}"

src/Std/Time/Notation/Spec.lean

@@ -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}"

src/Std/Time/Time.lean

@@ -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

src/Std/Time/Time/Basic.lean

@@ -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

src/Std/Time/Time/HourMarker.lean

@@ -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

src/Std/Time/Time/PlainTime.lean

@@ -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

src/Std/Time/Time/Unit/Basic.lean

@@ -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

src/Std/Time/Time/Unit/Hour.lean

@@ -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

src/Std/Time/Time/Unit/Millisecond.lean

@@ -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

src/Std/Time/Time/Unit/Minute.lean

@@ -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