path: root/lib/kernel/calendar.ml

(* Resolution across a whole liturgical year. See calendar.mli for the
   architectural rationale (why [year] is the primitive and [day] derived). *)

(* The kernel's domain floor and ceiling (Date.make's documented 1583..9999
   bound). Both are always constructible -- in-range by definition -- so
   neither of these can itself raise. *)
let domain_min_date =
  match Date.make ~year:1583 ~month:1 ~day:1 with Ok d -> d | Error e -> failwith e

let domain_max_date =
  match Date.make ~year:9999 ~month:12 ~day:31 with Ok d -> d | Error e -> failwith e

(* [start, stop] for the liturgical year opening in civil year [y], clamped at
   both ends of the domain rather than calling [rite.year_start] on a civil
   year outside 1583..9999.

   Top: at [y] = 9999, [rite.year_start (y + 1)] would ask for civil year
   10000 -- out of Date's domain (Plan 2 shipped exactly this bug in
   Validate). Clamp [stop] to 31 December 9999 instead: the final liturgical
   year comes back truncated, not un-computable.

   Bottom: symmetric case, reachable only through [day] below. A date in
   civil year 1583 before that year's own [rite.year_start] genuinely belongs
   to the liturgical year that opened in civil year 1582 for an
   Advent-anchored rite -- but [rite.year_start 1582] is equally out of
   domain. [day] only ever decrements a valid date's own (in-domain) civil
   year by at most one, so [y] = 1582 is the sole way this branch is reached.
   Clamp [start] to 1 January 1583: "year 1582" becomes the truncated
   stretch from the domain floor up to the day before [rite.year_start 1583],
   which is exactly the sliver a date there needs.

   [y] itself is clamped once, up front, to [1582, 9999] -- not left to each
   branch's own guard. Task 5's review found that guarding [start] and [stop]
   independently protected only one of their two [rite.year_start] calls
   each: [start]'s guard (["y < 1583"]) leaves [stop]'s "y + 1" call
   unguarded at the bottom (["year 999"] still called [year_start 1000], out
   of domain), and [stop]'s guard (["y >= 9999"]) leaves [start]'s call
   unguarded at the top (["year 100000"] still called [year_start 100000]).
   Neither is reachable through [day] (see calendar.mli), but [year] is
   public, and a direct out-of-contract call must not raise either. Clamping
   [y] once closes both gaps with one check instead of two. *)
let year_bounds (rite : ('s, 'r) Rite.t) (y : int) : Date.t * Date.t =
  let y = max 1582 (min 9999 y) in
  let start = if y < 1583 then domain_min_date else rite.Rite.year_start y in
  let stop =
    if y >= 9999 then domain_max_date else Date.add_days (rite.Rite.year_start (y + 1)) (-1)
  in
  (start, stop)

(* RG 91's contest for one date: the temporal office against every sanctoral
   entry whose Date_spec resolves to it, plus whatever the placement pass
   below has [injected] there so far (a celebration transferred in from an
   impeded day elsewhere). [Layer.on_date] is keyed on exactly (month, day),
   which for a [Fixed] spec -- the only form Plan 2 ships -- is the same test
   as resolving the spec against [date]'s own year and comparing, so no
   separate filter is needed here.

   [injected] is keyed by [Date.to_rata] rather than [Date.t] directly:
   [Date.t] carries no [compare]-respecting hash, and rata-die is already the
   canonical total order this module uses for date arithmetic. *)
(* RG 33's third trigger, third stage: the set of (date, slug) pairs whose
   vigil the rule suppresses, keyed by rata die. Empty for a rite whose
   [vigil_feast] is the constant [None], and empty on the EF's own shipped
   data -- see {!rg33_suppressed} for both. *)
let no_suppression : (int, string list) Hashtbl.t = Hashtbl.create 1

let is_suppressed (suppressed : (int, string list) Hashtbl.t) (date : Date.t)
    (c : 'r Precedence.candidate) =
  match Hashtbl.find_opt suppressed (Date.to_rata date) with
  | None -> false
  | Some slugs -> List.mem (Slug.to_string c.Precedence.cel.Celebration.slug) slugs

let resolve_with_injected ?(suppressed = no_suppression) (rite : ('s, 'r) Rite.t)
    (idx : 'r Layer.index)
    (injected : (int, 'r Precedence.candidate list) Hashtbl.t) (date : Date.t) :
    ('s, 'r) Temporal.t * 's Precedence.context * 'r Precedence.resolution =
  let temporal = rite.Rite.temporal date in
  let temporal_candidate =
    { Precedence.cel = temporal.Temporal.office; origin = Precedence.Temporal }
  in
  let natural =
    Layer.on_date ~fixed_key:rite.Rite.fixed_key idx date
    |> List.map (fun (e : 'r Layer.entry) ->
           { Precedence.cel = e.Layer.cel; origin = Precedence.Sanctoral })
  in
  let arrived = try Hashtbl.find injected (Date.to_rata date) with Not_found -> [] in
  let ctx = { Precedence.date; season = temporal.Temporal.season; weekday = temporal.Temporal.weekday } in
  (* RG 33: a suppressed vigil is not a losing candidate, it is not a
     candidate at all -- "penitus omittitur". Filtering here rather than
     leaving it to [disposition] is deliberate and is what the rubric says:
     were it left in the contest it could still claim the day's single
     commemoration slot (RG 111) ahead of a saint genuinely entitled to it,
     which is precisely the defect the SECOND trigger's own fix corrected for
     the Sunday case. Note this drops it from [omitted] too -- the
     suppression is reported by {!build_day} instead, with its own reason, so
     nothing vanishes unaccounted for. *)
  let sanctoral =
    match Hashtbl.length suppressed with
    | 0 -> natural @ arrived
    | _ -> List.filter (fun c -> not (is_suppressed suppressed date c)) (natural @ arrived)
  in
  let resolution =
    Precedence.resolve rite.Rite.rules ctx ~temporal:temporal_candidate ~sanctoral
  in
  (temporal, ctx, resolution)

(* What Precedence.resolve currently reports as observed on [date], given the
   placements decided so far -- this is exactly the [occupant] callback
   Rite.transfer_target's search walks forward with (rite.mli explains why
   that judgement has to come from the rite, not from here). *)
let occupant_of (rite : ('s, 'r) Rite.t) (idx : 'r Layer.index)
    (injected : (int, 'r Precedence.candidate list) Hashtbl.t) (date : Date.t) : 'r Celebration.t =
  let _, _, resolution = resolve_with_injected rite idx injected date in
  resolution.Precedence.observed.Precedence.cel

(* Hard guard on the placement fixed point (spec §2.4): every genuine
   transfer moves a celebration strictly forward and the celebration set is
   finite, so the round below always empties [deferred] within a handful of
   rounds in practice (an RG 97-98 collision of N feasts on one date costs at
   most N-1 extra rounds -- each round resolves the winner of whatever pile-up
   occurred and re-defers the rest, one fewer each time). 64 is not tuned to
   that bound; it is a defensive ceiling nothing in the 1962 calendar comes
   close to, so that a rite/data combination this module has not anticipated
   fails as a recorded, inspectable [omitted] reason (below) instead of
   hanging the CLI. *)
let max_transfer_rounds = 64

let unconverged_reason =
  "omitted: transfer placement did not converge within max_transfer_rounds (RG 96-98)"

(* A rite-supplied [transfer_target] is trusted to search strictly forward
   (rite.mli), but nothing stops it naming a date past the end of the
   liturgical year it was asked about -- e.g. an I-class feast impeded in
   the last days before Advent I, whose first admissible day genuinely
   falls in the following liturgical year's own territory (unproven to
   occur in the real EF calendar, but not something this module can rule
   out by construction). [place_transfers] never injects such a target: the
   [dates] array is exactly what [year]/[build_day] walk to produce the
   result, so a candidate placed outside it would be [observed]/
   [transferred_in] nowhere in the output at all -- gone, not merely
   mis-filed, and silently so, contradicting [calendar.mli]'s "never
   silently dropped". This reason makes that failure mode visible instead. *)
let out_of_range_reason = "omitted: transfer target falls outside the liturgical year (RG 96)"

(* RG 33: "Vigilia II aut III classis penitus omittitur... vel si festum cui
   praemittitur in alium diem transferri aut ad commemorationem reduci
   contingat." The vigil is not demoted or commemorated -- it is dropped
   whole, which is what "penitus" says. *)
let rg33_vigil_reason =
  "omitted: the feast this vigil precedes does not keep its own day (RG 33)"

(* Rebuilds the per-date injection index from [assignment] (slug -> (origin,
   target)) fresh each round, rather than accumulating it incrementally as
   candidates are placed. A candidate re-deferred in a later round (its first
   target turned out to already be claimed by a higher-band rival, see
   [place_transfers]) must vacate its old target date entirely, not merely
   gain a second one; rebuilding from a slug-keyed map, which holds exactly
   one entry per candidate, gives that for free. An append-only structure
   would instead leave the stale placement behind forever, and the round
   loop would never see [deferred] empty out. *)
let injected_index_of_assignment (assignment : (string, Date.t * Date.t) Hashtbl.t)
    (candidate_by_slug : (string, 'r Precedence.candidate) Hashtbl.t) :
    (int, 'r Precedence.candidate list) Hashtbl.t =
  let tbl : (int, 'r Precedence.candidate list) Hashtbl.t = Hashtbl.create 16 in
  Hashtbl.iter
    (fun slug (_origin, target) ->
      let key = Date.to_rata target in
      let c = Hashtbl.find candidate_by_slug slug in
      Hashtbl.replace tbl key (c :: (try Hashtbl.find tbl key with Not_found -> [])))
    assignment;
  tbl

(* The placement pass itself (spec §2.4 steps 1-4; step 5, recording
   transferred_in/out, is [year]'s job once this reaches a fixed point).

   Every [Precedence.Transfer]-*and*-[Precedence.Repose]-disposed loser lands
   in [resolution.deferred] together -- [Precedence.resolve]'s own fold
   matches them as one case, [Transfer | Repose -> ... :: defs ...] -- and
   everything gathered below is routed through
   [rite.transfer_target], i.e. RG 96's next-admissible-day search. That is
   only correct for [Transfer]. [Repose] denotes RG 100-102's *repositio*
   (perpetual impediment, reassigned to the next appropriate day and treated
   as proper) -- a distinct rubric this module does not implement. It is
   documented here rather than split into a second mechanism because nothing
   currently produces [Repose]: the design spec records it as "declared, not
   exercised" (§1.3) -- the EF ruleset (Tasks 7-9) returns it for nothing;
   perpetual impediment arises from proper/diocesan calendars, which are
   overlay content, out of this plan's scope. If a future rite's rules ever
   do return [Repose], it would silently take the RG 96 path here, which
   would be wrong -- worth knowing before that day, not discovering it then.

   Each round: gather every currently-deferred candidate across the whole
   year (fresh, against this round's [injected] state -- a candidate already
   placed and now winning its target is no longer a loser anywhere and so
   will not reappear here); if none, the fixed point is reached. Otherwise
   sort ALL of them by band -- RG 97-98: this is the global ordering that
   decides who transfers first when I-class feasts coincide -- ties break on
   slug, same convention as Precedence.compare_by, so placement never depends
   on the layer's own entry order. Then place each in turn, in that order.

   [claimed_this_round] is what makes the sort actually decide anything: it
   starts empty every round and gains one entry per candidate placed so far
   THIS round, and [occupant_with_claims] reports a claimed date as occupied
   by whoever claimed it, layered on top of [injected] (last round's settled
   state, frozen for the round -- see [injected_index_of_assignment] for why
   that has to stay frozen rather than being updated in place). Without it,
   every candidate in a round would search against the exact same snapshot
   and a same-date collision would only be caught (and only one side of it
   corrected) on re-resolution next round, one collision layer per round --
   RG 97-98's own ordering would still come out right in the end, but only
   by accident of Precedence.resolve's own internal tie-break repeating this
   module's, not because this module's sort ever decided anything. Layering
   the claims instead means a same-round collision is resolved in the one
   round it is found, in the sorted order, and the earlier RG 97-98 test
   pins exactly that: it fails on "claims 2 Feb first" without this.

   [~start ~stop] bound the [transfer_target] a placement is allowed to
   settle on: outside that range it goes into [out_of_range] instead of
   [assignment], permanently (never retried -- [transfer_target] is a pure
   function of a candidate's own permanent origin and the occupancy state,
   so asking it again would only recompute the same out-of-range answer). *)
let place_transfers (rite : ('s, 'r) Rite.t) (idx : 'r Layer.index) ~(start : Date.t)
    ~(stop : Date.t) (dates : Date.t array) :
    (string, Date.t * Date.t) Hashtbl.t
    * (string, 'r Precedence.candidate) Hashtbl.t
    * (string, Date.t * Date.t) Hashtbl.t =
  let assignment : (string, Date.t * Date.t) Hashtbl.t = Hashtbl.create 16 in
  let candidate_by_slug : (string, 'r Precedence.candidate) Hashtbl.t = Hashtbl.create 16 in
  let out_of_range : (string, Date.t * Date.t) Hashtbl.t = Hashtbl.create 4 in
  let compare_deferred (_, ctx1, c1) (_, ctx2, c2) =
    let b1 = rite.Rite.rules.Precedence.band ctx1 c1 in
    let b2 = rite.Rite.rules.Precedence.band ctx2 c2 in
    if b1 <> b2 then Int.compare b1 b2
    else Slug.compare c1.Precedence.cel.Celebration.slug c2.Precedence.cel.Celebration.slug
  in
  let round = ref 0 in
  let converged = ref false in
  let guard_hit = ref false in
  while (not !converged) && not !guard_hit do
    incr round;
    if !round > max_transfer_rounds then guard_hit := true
    else begin
      let injected = injected_index_of_assignment assignment candidate_by_slug in
      let raw =
        Array.to_list dates
        |> List.concat_map (fun date ->
               let _, ctx, resolution = resolve_with_injected rite idx injected date in
               List.map (fun c -> (date, ctx, c)) resolution.Precedence.deferred)
      in
      (* [raw] rediscovers every candidate's *permanent* natural loss at its
         origin every round -- the layer entry never moves, so a candidate
         already settled elsewhere still shows up losing at the date it was
         always going to lose at. Left unfiltered, that stale sighting gets
         placed again right next to the candidate's own already-settled
         self, which -- because a placed candidate's own rank makes it look
         "occupied" to a fresh search starting from its original origin --
         oscillates between two dates forever, never reaching [deferred =
         []] (confirmed by removing this filter: "transferable" lands on 14
         Jan instead of 13 in test_transfer_moves_and_does_not_duplicate,
         not merely "doesn't converge" -- the bug is a wrong answer, not
         only a hang). A sighting is genuinely actionable only if the
         candidate has never been placed yet (first time seen, and not
         already known unplaceable -- [out_of_range] gets the same
         permanent exclusion [assignment] does, for the same reason), or if
         it is losing exactly at the date it is *currently* assigned to (a
         fresh RG 97-98 bump: something else also landed there and
         out-ranked it) -- any other date is the stale, permanent one and is
         dropped. *)
      let deferred =
        List.filter
          (fun (date, _ctx, c) ->
            let slug = Slug.to_string c.Precedence.cel.Celebration.slug in
            if Hashtbl.mem out_of_range slug then false
            else
              match Hashtbl.find_opt assignment slug with
              | None -> true
              | Some (_, target) -> Date.compare date target = 0)
          raw
      in
      if deferred = [] then converged := true
      else begin
        let claimed_this_round : (int, 'r Precedence.candidate) Hashtbl.t = Hashtbl.create 4 in
        let occupant_with_claims d =
          match Hashtbl.find_opt claimed_this_round (Date.to_rata d) with
          | Some c -> c.Precedence.cel
          | None -> occupant_of rite idx injected d
        in
        List.stable_sort compare_deferred deferred
        |> List.iter (fun (origin, _ctx, c) ->
               let target = rite.Rite.transfer_target c origin occupant_with_claims in
               let slug = Slug.to_string c.Precedence.cel.Celebration.slug in
               if Date.compare target start < 0 || Date.compare target stop > 0 then
                 Hashtbl.replace out_of_range slug (origin, target)
               else begin
                 Hashtbl.replace claimed_this_round (Date.to_rata target) c;
                 Hashtbl.replace assignment slug (origin, target);
                 Hashtbl.replace candidate_by_slug slug c
               end)
      end
    end
  done;
  (assignment, candidate_by_slug, out_of_range)

(* The final build of one day, once placement has reached its fixed point (or
   exhausted the guard): resolve against the settled [injected] state, then
   layer on [transferred_in] (this date received an injected candidate that
   went on to win) and [transferred_out] (whichever candidates' settled
   placements originated here -- RG 97-98 lets that be more than one; see
   [Liturgical_day.transferred_out]). *)
(* RG 33's third omission trigger -- "vel si festum cui praemittitur in alium
   diem transferri aut ad commemorationem reduci contingat" ("or if the feast
   it precedes happens to be transferred to another day or reduced to a
   commemoration"). See {!Precedence.rules.vigil_feast} for the contract and
   for why the RITE names the feast instead of the kernel inferring it.

   ONE PASS, NO FIXED POINT. Both halves of the clause reduce to the same
   observable question -- is the named feast the OBSERVED office on the
   following day? -- and the answer cannot depend on the vigil, because a
   vigil is a candidate only on its own day and never on its feast's. So
   resolving D+1 here WITHOUT applying this rule is exact, not an
   approximation, and the recursion an eager reading would suggest (D asks
   D+1, which asks D+2...) never arises. Contrast RG 96's transfers, which
   genuinely do need [place_transfers]' iteration.

   RUNS AFTER [place_transfers], and must: the whole point is to see the
   post-transfer placement, so the [injected] table this receives is the
   settled one.

   D+1 MAY FALL OUTSIDE THE LITURGICAL YEAR -- the last day of the year is
   resolved against the first day of the next, which [Layer.index] already
   covers (it indexes [y-1; y; y+1]) and {!Rite.temporal} answers for any
   in-domain date. Only the domain edge itself is refused, where [Date.add_days]
   would leave the representable range; a vigil there keeps its office, the
   same conservative direction the rest of this module takes at the boundary. *)
let rg33_suppressed (rite : ('s, 'r) Rite.t) (idx : 'r Layer.index)
    (injected : (int, 'r Precedence.candidate list) Hashtbl.t) (dates : Date.t array) :
    (int, string list) Hashtbl.t =
  let suppressed : (int, string list) Hashtbl.t = Hashtbl.create 8 in
  Array.iter
    (fun date ->
      let candidates =
        Layer.on_date ~fixed_key:rite.Rite.fixed_key idx date
        |> List.map (fun (e : 'r Layer.entry) ->
               { Precedence.cel = e.Layer.cel; origin = Precedence.Sanctoral })
      in
      let arrived = try Hashtbl.find injected (Date.to_rata date) with Not_found -> [] in
      let temporal = rite.Rite.temporal date in
      let temporal_candidate =
        { Precedence.cel = temporal.Temporal.office; origin = Precedence.Temporal }
      in
      (* The temporal cycle produces vigils too (the Ascension vigil is one),
         so it is checked alongside the sanctoral candidates. *)
      List.iter
        (fun c ->
          match rite.Rite.rules.Precedence.vigil_feast c with
          | None -> ()
          | Some feast ->
              if Date.compare date domain_max_date < 0 then begin
                let morrow = Date.add_days date 1 in
                let _, _, r = resolve_with_injected rite idx injected morrow in
                let observed = r.Precedence.observed.Precedence.cel.Celebration.slug in
                if not (Slug.equal observed feast) then begin
                  let key = Date.to_rata date in
                  let slug = Slug.to_string c.Precedence.cel.Celebration.slug in
                  let prior = try Hashtbl.find suppressed key with Not_found -> [] in
                  Hashtbl.replace suppressed key (slug :: prior)
                end
              end)
        (temporal_candidate :: (candidates @ arrived)))
    dates;
  suppressed

let build_day (rite : ('s, 'r) Rite.t) (idx : 'r Layer.index)
    (assignment : (string, Date.t * Date.t) Hashtbl.t)
    (out_of_range : (string, Date.t * Date.t) Hashtbl.t)
    (injected : (int, 'r Precedence.candidate list) Hashtbl.t)
    (suppressed : (int, string list) Hashtbl.t)
    (transferred_out_of : (int, ('r Celebration.t * Date.t) list) Hashtbl.t) (date : Date.t) :
    ('s, 'r) Liturgical_day.t =
  let temporal, _ctx, resolution = resolve_with_injected ~suppressed rite idx injected date in
  let arrived = try Hashtbl.find injected (Date.to_rata date) with Not_found -> [] in
  let transferred_in =
    arrived
    |> List.find_opt (fun c ->
           Slug.equal c.Precedence.cel.Celebration.slug
             resolution.Precedence.observed.Precedence.cel.Celebration.slug)
    |> Option.map (fun c -> c.Precedence.cel)
  in
  let transferred_out =
    try Hashtbl.find transferred_out_of (Date.to_rata date) with Not_found -> []
  in
  (* [resolution.deferred] here is NOT "the placement pass never got to
     these": it is the origin day's own permanent, structural loss -- the
     layer entry that lost the RG 91 contest here never moves, so a
     candidate successfully placed somewhere else still shows up losing at
     the exact date it was always going to lose at (this is the same fact
     [place_transfers]'s round loop has to filter around, see its comment).
     A [deferred] sighting only belongs in [omitted] if it was never
     actually settled anywhere -- i.e. it is stuck in [out_of_range], or the
     guard above was hit before it reached a day it wins. Settled elsewhere
     means genuinely accounted for via [observed]/[transferred_in] on the
     day it landed and [transferred_out] here, not via [omitted] too --
     double-booking it in both would fail Task 12's "appears exactly once"
     reading of this day alone. *)
  (* Whether a transferred/injected candidate is genuinely accounted for at
     its assigned target -- true under any of THREE conditions, not two
     (fix round 1, ef-major-litanies task -- the first version of this
     function, and this comment, claimed two, missing exactly the same
     shape one channel further out than the bug it had just fixed; see
     below for how that was found).

     (1) It won the day outright there (every [Transfer]-disposed candidate
     this kernel produced before a rite could transfer a
     [Celebration.status = Commemoration_only] one: a losing FEAST, which
     RG 96's own "next day not I or II class" guarantees an unblocked day
     to win once it arrives -- [occupant_of] alone used to answer this, and
     still would).

     (2) It survives at the target as one of the day's own admitted
     COMMEMORATIONS instead (a shape [place_transfers] itself never used to
     produce, because nothing before could dispose a [Commemoration_only]
     candidate as [Transfer] -- {!Precedence.resolve} holds such a
     candidate out of the band contest entirely, so it can never win a day
     outright, only ever be commemorated on one; a rite is nonetheless free
     to [Transfer] one to a named date, e.g. RG 80's Major Litanies, RG
     81's own "nihil fit in Officio" making [observed] structurally
     impossible for it anywhere). The FIRST version of this function
     stopped here, at (1) and (2) -- {!Liturgical_day.t}'s own doc comment
     promises [observed] and [commemorations] are never silently lost, and
     this read as "the same two channels", which is where the "two, not
     three" miscount came from: that promise is about {!Liturgical_day.t}'s
     OWN five fields, not an exhaustive account of every way
     {!Precedence.resolve} can dispose of a candidate at one date.

     (3) It reaches the target and is disposed there as [Omit] by
     {!Precedence.rules.disposition} itself (RG 33's vigil omission, RG
     16(a)'s Sunday suppression, RG 26's IV-class-feria omission, the
     Lord-vs-Lord exclusion, ...) OR is offered to
     {!Precedence.rules.admit} there but capped out by an admission-count
     limit RG 111 itself imposes (e.g. a Class1 day admits only ONE
     privileged commemoration; a second one due the same day, or the SAME
     Litanies candidate no longer privileged, loses that slot) -- both
     land in the target's own [omitted], with their own accurate,
     already-diagnostic reason ("omitted: yielded to a higher day" /
     "omitted: admission limit reached"), and both are just as genuinely
     "delivered and considered" as (1)/(2), not stuck anywhere. Missing
     this third channel reproduces the EXACT ORIGINAL BUG this function was
     written to fix, one level further out: a candidate settled (via (3))
     at its target was still reported [unresolved] at its ORIGIN, under
     the same wrong, hardcoded [unconverged_reason] label, and
     double-counted by {!Validate}'s own "duplicated" check the same way.

     Found, not merely reasoned to: fix round 1's review reproduced it two
     ways. Constructively, a second privileged [Commemoration_only] entry
     placed on the Litanies' own transfer target (Easter+2) that sorts
     ahead of it forces the Litanies to lose {!Precedence.rules.admit}'s
     own Class1 "one privileged commemoration only" cap there. And,
     already present in this branch's own mutation-testing record without
     being run to ground at the time: mutation 3 (this task's own report,
     `privilege_of`'s RG 109(f) branch forced to [Ordinary]) makes the
     transferred Litanies itself lose that SAME Class1 cap at its OWN
     target -- no second candidate needed, since an [Ordinary] commemoration
     has no standing at all against a [Class1] day's privileged-only
     admission rule ({!Precedence_ef.admit}'s own Class1 case). That
     mutation's 9th failure, the exhaustive `Validate` property sweep on a
     random year, was this bug; the report noted the failure and declined
     to diagnose it before reverting the mutation, which is precisely how
     it survived one fix round.

     Unreachable on shipped EF data today (every `Commemoration_only`
     candidate this rite's own real data carries is at most [Class3]
     except the Litanies themselves, and no second privileged
     commemoration can ever fall on Easter+2 -- {!Precedence_ef
     .privilege_of}'s own (a)-(e) categories are all Sunday/Ember/Advent-
     Lent-Passiontide/Nativity-octave shaped, none of which Easter+2 is or
     can be), which is exactly why it survived this far: nothing in the
     shipped calendar has ever exercised it. Fails LOUDLY (a wrong,
     misleading label) rather than silently, and is fixed here rather than
     left as a documented residual, since the fix is a one-line
     generalisation of the same check, not new machinery. Kept
     rite-agnostic: nothing here reads anything EF-specific, only
     {!Precedence.resolution}'s own [observed]/[commemorations]/[omitted]
     fields -- THREE of {!Precedence.resolution}'s four fields (the fourth,
     [deferred], denotes a candidate that has NOT yet settled at this date,
     by definition, so it is correctly never consulted here). 
     A SIGNAL TRADED AWAY, named because it is real (fix-round re-review):
     channel (3) accepts both shapes of [omitted] -- the admission cap, and
     a rite whose own [disposition] omits the candidate AT the target its
     own [transfer_target] named. For the cap this is unambiguously
     "settled". For the second it is a judgement: before this change that
     shape produced a loud, if mislabelled, [Validate] "unconverged"
     failure; now it is silent at the origin and honestly reported at the
     target. The kernel cannot tell "the rite deliberately omitted it
     there" from "the rite chose a bad target" without rite knowledge it
     must not have, so accepting it is the right call -- but the diagnostic
     it used to give up is gone. Unreachable in [Rite_ef] today: only the
     Major Litanies transfer as [Commemoration_only], and RG 96's search
     guarantees a transferred FEAST an unblocked target. *)
  let settled_at target slug =
    let _, _, target_resolution = resolve_with_injected ~suppressed rite idx injected target in
    let matches (c : 'r Precedence.candidate) =
      Slug.equal c.Precedence.cel.Celebration.slug slug
    in
    matches target_resolution.Precedence.observed
    || List.exists (fun (c, _) -> matches c) target_resolution.Precedence.commemorations
    || List.exists (fun (c, _) -> matches c) target_resolution.Precedence.omitted
  in
  let unresolved c =
    let slug = c.Precedence.cel.Celebration.slug in
    if Hashtbl.mem out_of_range (Slug.to_string slug) then true
    else
      match Hashtbl.find_opt assignment (Slug.to_string slug) with
      | None -> true
      | Some (_, target) -> not (settled_at target slug)
  in
  let reason_for c =
    if Hashtbl.mem out_of_range (Slug.to_string c.Precedence.cel.Celebration.slug) then
      out_of_range_reason
    else unconverged_reason
  in
  (* RG 33's third trigger removes the vigil from the contest entirely
     ({!resolve_with_injected} filters it before {!Precedence.resolve} ever
     sees it), so it cannot appear in [resolution.omitted] the way an
     ordinary loser does. Re-derived here from the same table, with its own
     reason, so that the day's accounting stays complete: every candidate the
     date carries is still reported somewhere. *)
  let rg33_omitted =
    match Hashtbl.find_opt suppressed (Date.to_rata date) with
    | None -> []
    | Some slugs ->
        let on_date =
          Layer.on_date ~fixed_key:rite.Rite.fixed_key idx date
          |> List.map (fun (e : 'r Layer.entry) -> e.Layer.cel)
        in
        let temporal_office = temporal.Temporal.office in
        (temporal_office :: (on_date @ List.map (fun c -> c.Precedence.cel) arrived))
        |> List.filter (fun (cel : 'r Celebration.t) ->
               List.mem (Slug.to_string cel.Celebration.slug) slugs)
        |> List.map (fun cel -> (cel, rg33_vigil_reason))
  in
  let omitted =
    List.map (fun (c, reason) -> (c.Precedence.cel, reason)) resolution.Precedence.omitted
    @ (resolution.Precedence.deferred |> List.filter unresolved
      |> List.map (fun c -> (c.Precedence.cel, reason_for c)))
    @ rg33_omitted
  in
  let formulary, citations =
    rite.Rite.readings ~observed:resolution.Precedence.observed.Precedence.cel ~temporal ~date
      ~temporal_at:rite.Rite.temporal
  in
  let creed =
    rite.Rite.creed ~temporal ~observed:resolution.Precedence.observed.Precedence.cel ~date
  in
  let gloria =
    rite.Rite.gloria ~temporal ~observed:resolution.Precedence.observed.Precedence.cel ~date
  in
  {
    Liturgical_day.date;
    rite = rite.Rite.id;
    temporal;
    observed = resolution.Precedence.observed.Precedence.cel;
    commemorations =
      List.map (fun (c, p) -> (c.Precedence.cel, p)) resolution.Precedence.commemorations;
    transferred_in;
    transferred_out;
    omitted;
    citations;
    formulary;
    creed;
    gloria;
  }

let year (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) (y : int) :
    ('s, 'r) Liturgical_day.t array =
  (* A liturgical year is Advent-anchored and straddles two civil years --
     [year_start y .. year_start (y+1) - 1] -- so BOTH must be resolved for
     movable entries, or a movable feast in the tail of the span silently
     vanishes. *)
  (* A liturgical year straddles two civil years, so both are named.
     [Layer.index] filters them to the kernel domain, which is what keeps
     the edges (y = 1583 naming 1582, y = 9999 naming 10000) from
     calling the rite's [easter] out of range. *)
  let idx = Layer.index layer ~easter:rite.Rite.easter ~years:[ y - 1; y; y + 1 ] in
  let start, stop = year_bounds rite y in
  (* [max 0]: defends [Array.init] against a negative length, which would
     otherwise arise for a rite whose [year_start] lands exactly on the
     domain floor (start clamps to the same date, giving [stop] a day
     before it). Not reachable through [day] -- see calendar.mli -- but
     [year] is public, and a direct out-of-contract call must not raise
     either. *)
  let n = max 0 (Date.to_rata stop - Date.to_rata start + 1) in
  let dates = Array.init n (fun i -> Date.add_days start i) in
  let assignment, candidate_by_slug, out_of_range = place_transfers rite idx ~start ~stop dates in
  let injected = injected_index_of_assignment assignment candidate_by_slug in
  let transferred_out_of : (int, ('r Celebration.t * Date.t) list) Hashtbl.t = Hashtbl.create 16 in
  Hashtbl.iter
    (fun slug (origin, target) ->
      let cel = (Hashtbl.find candidate_by_slug slug).Precedence.cel in
      let key = Date.to_rata origin in
      Hashtbl.replace transferred_out_of key
        ((cel, target) :: (try Hashtbl.find transferred_out_of key with Not_found -> [])))
    assignment;
  (* Canonicalise each day's departures: the accumulation above walks
     [assignment] via [Hashtbl.iter], whose bucket order is not guaranteed
     stable across runs (OCaml's hash seed can be randomised via
     OCAMLRUNPARAM=R), so a day with more than one departure -- RG 97-98's
     coinciding-feasts case -- would otherwise report them in a
     run-dependent order: an environment read, in a kernel whose invariants
     forbid one. [Layer.index] guards against exactly this by
     re-sorting each date bucket after building it (layer.ml); same fix,
     same reason. Sorted by target date -- which, for a correctly-converged
     year, is also RG 97-98's own order: the higher-precedence loser claims
     the earlier admissible day -- ties (not expected, but not assumed
     impossible) broken on slug. *)
  let by_target_then_slug (c1, t1) (c2, t2) =
    let dc = Date.compare t1 t2 in
    if dc <> 0 then dc else Slug.compare c1.Celebration.slug c2.Celebration.slug
  in
  Hashtbl.iter
    (fun k v -> Hashtbl.replace transferred_out_of k (List.sort by_target_then_slug v))
    transferred_out_of;
  (* RG 33's third trigger, computed once for the whole year and AFTER
     [place_transfers], because the question it asks -- did the vigil's feast
     keep its own day? -- is only answerable against the settled placement.
     See {!rg33_suppressed}. *)
  let suppressed = rg33_suppressed rite idx injected dates in
  Array.map (build_day rite idx assignment out_of_range injected suppressed transferred_out_of) dates

let day (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) (date : Date.t) :
    ('s, 'r) Liturgical_day.t =
  let cy = Date.year date in
  let y = if Date.compare date (rite.Rite.year_start cy) >= 0 then cy else cy - 1 in
  let start, _ = year_bounds rite y in
  (year rite layer y).(Date.to_rata date - Date.to_rata start)