path: root/lib/rites/rite_ef/precedence_ef.ml

(* RG 91's Table of Precedence (docs/research/rules-register.md §4). Each
   branch below is one of the table's 28 entries, checked in the table's own
   numeric order -- lower wins, and because occasional entries are true
   exceptions to a later, broader one (RG 91 entry 18's Ember days are an
   exception carved out of entry 22's Lent ferias; entry 21/26's vigils are
   an exception carved out of the generic Class2/Class3 sanctoral-feast
   entries that would otherwise also match), checking in table order and
   returning on the first match is what makes the exception actually win
   without a separate exclusion for every later entry it pre-empts.

   Two kinds of evidence decide an entry:
   - The temporal cycle's own office (Nativity, a Sunday, a feria, All Souls)
     is identified structurally, from the context's date/season/weekday and
     the day's Easter offset -- never from its slug, which is just a label.
     [origin = Temporal] gates every such entry so a sanctoral candidate that
     happens to share a date (Immaculate Conception can never coincide with
     the movable cycle, but nothing stops a future rite bug from producing
     one) cannot be mistaken for the office itself. All Souls (entry 8, the
     one non-temporal-origin member of this group) additionally reads the
     context's weekday for its own register-stated exception -- see entry 8
     below.
   - A sanctoral feast's entry is decided by its [rank], and -- except at
     entry 14 (see its own comment below, where the register draws no such
     line) -- per the brief's structural insight, also by its
     {!Celebration.t}.layer: a celebration whose layer is not the universal
     base is an overlay, hence "proper" or "indult" rather than the
     universal entry (11-13 I class; 16/19/20 II class; 23/24 III class; see
     precedence_ef.mli). [origin = Sanctoral] gates these for the same
     reason: temporal-origin celebrations carry the literal layer id
     "temporal" (rite_ef/temporal_ef.ml's [build]), which is not
     [universal_layer] either, and would otherwise be misread as "proper" by
     the layer test alone.

   Vigils (21, 26) are the one shape neither of those two kinds fully
   describes on their own: a II/III-class vigil can be temporal-origin (the
   Ascension Vigil, produced by temporal_ef today) or sanctoral-origin (a
   saint's vigil, not yet loaded by any task), so its entry cannot be gated
   on [origin] at all. Nothing in the day's other fields marks "this is a
   vigil, not an ordinary office of the same rank" either, so this reads it
   off the temporal cycle's own slug convention (a "-vigil" suffix -- see
   [named] in temporal_ef.ml) rather than guessing a new one. *)

open Colitur_kernel

(* Not an RG citation -- RG 91 ranks proper and indult feasts, it does not
   encode how a computer tells them apart. See precedence_ef.mli. *)
let universal_layer = "ef-universal"
let indult_prefix = "indult:"
let unclassified = max_int

let is_indult layer = String.starts_with ~prefix:indult_prefix layer
let is_universal layer = String.equal layer universal_layer

(* Not an RG citation either -- see [universal_layer] above. Nothing in
   {!Celebration.t} otherwise marks "this is a vigil, not an ordinary office
   of the same rank" (see the file's top comment), so entries 21/26 read it
   off the temporal cycle's own slug suffix (rite_ef/temporal_ef.ml's
   [named], e.g. "ef-ascension-vigil"). *)
let vigil_suffix = "-vigil"

(* Not an RG citation -- see [universal_layer]. Task 10's sanctoral bootstrap
   turned out to name its four real vigils with lectio's OWN convention, a
   "vigil-of-X" PREFIX (data/ef/sanctoral.sexp: vigil-of-st-lawrence,
   vigil-of-sts-peter-paul, vigil-of-the-assumption, vigil-of-the-nativity-
   of-st-john-the-baptist), not [vigil_suffix] -- exactly the mismatch Task
   7's review predicted when it asked for [vigil_suffix] to be exposed.
   [is_vigil] below checks both conventions, so a celebration is a "vigil"
   for RG 91/33's purposes regardless of which layer (temporal or sanctoral)
   produced it. *)
let vigil_prefix = "vigil-of-"

let is_vigil slug =
  String.ends_with ~suffix:vigil_suffix slug || String.starts_with ~prefix:vigil_prefix slug

(* Not an RG citation -- see [universal_layer]. Entry 18's Ember days are
   identified by the temporal cycle's own slug convention (rite_ef/
   temporal_ef.ml's [ember]: "ef-<set>-ember-<day>"), not re-derived here:
   the September anchor in particular is one of the more contested dates in
   the 1962 calendar (temporal_ef.ml's own comment on
   [third_sunday_of_september]), and re-deriving it a second time would only
   create a second place for that same uncertainty to drift. Only the
   Advent, Lent and September sets are listed: RG 91 entry 18 names exactly
   those three; the Whitsun (Pentecost) set is I class and falls inside the
   Pentecost octave, entry 10, matched below before this is ever reached.
   Exposed for the same reason as [vigil_suffix]: a rename of temporal_ef's
   format has somewhere to be caught other than a silently-wrong entry 18.

   [september_ember_prefix] is broken out as its own name (rather than an
   anonymous list literal) because Task 9's [privilege_of] needs to test the
   September set alone, RG 109 privileging it while leaving the Advent and
   Lent sets ordinary (register lines 375-376) -- building [ember_prefixes]
   from it rather than duplicating the literal keeps the two from silently
   drifting apart. *)
let advent_ember_prefix = "ef-advent-ember-"
let lent_ember_prefix = "ef-lent-ember-"
let september_ember_prefix = "ef-september-ember-"
let ember_prefixes = [ advent_ember_prefix; lent_ember_prefix; september_ember_prefix ]

let is_ember_18 slug = List.exists (fun prefix -> String.starts_with ~prefix slug) ember_prefixes

let band (ctx : Vocab_ef.season Precedence.context) (c : Vocab_ef.rank Precedence.candidate) :
    int =
  let cel = c.Precedence.cel in
  let rank = cel.Celebration.rank in
  let subject = cel.Celebration.subject in
  let layer = cel.Celebration.layer in
  let slug = Slug.to_string cel.Celebration.slug in
  let is_temporal = c.Precedence.origin = Precedence.Temporal in
  let is_vigil = is_vigil slug in
  let date = ctx.Precedence.date in
  let season = ctx.Precedence.season in
  let weekday = ctx.Precedence.weekday in
  let is_sunday = weekday = Date.Sun in
  let m = Date.month date and d = Date.day date in
  (* Easter offset, the same convention as temporal_ef.ml's [days_between
     easter d]: 0 is Easter itself, negative before, positive after. *)
  let off = Date.to_rata date - Date.to_rata (Computus.gregorian_easter (Date.year date)) in
  (* Named so entry 8's Sunday exception below can read "one worse than the
     Sunday it must yield to" rather than a bare integer that happens to
     equal entry 15's own value; entry 15's own branch returns this same
     binding, not a second literal, so the two can never drift apart. *)
  let entry_15_band = 15 in
  let open Vocab_ef in
  (* 1: Nativity, Easter Sunday, Pentecost Sunday (I class w/ octave). *)
  if is_temporal && rank = Class1 && ((m = 12 && d = 25) || off = 0 || off = 49) then 1
    (* 2: Sacred Triduum (Thu-Sat of Holy Week). *)
  else if is_temporal && rank = Class1 && off >= -3 && off <= -1 then 2
    (* 3: Epiphany, Ascension, Holy Trinity, Corpus Christi, Sacred Heart,
       Christ the King. *)
  else if is_temporal && rank = Class1
          && ((m = 1 && d = 6) (* Epiphany *)
             || off = 39 (* Ascension *) || off = 56 (* Trinity *)
             || off = 60 (* Corpus Christi *) || off = 68 (* Sacred Heart *)
             || Date.compare date (Temporal_ef.christ_the_king (Date.year date)) = 0)
  then 3
    (* 4: Immaculate Conception, Assumption BVM. *)
  else if (not is_temporal) && rank = Class1 && ((m = 12 && d = 8) || (m = 8 && d = 15)) then 4
    (* 5: Vigil & Octave day of the Nativity. *)
  else if is_temporal && rank = Class1 && ((m = 12 && d = 24) || (m = 1 && d = 1)) then 5
    (* 6: Sundays of Advent, Lent, Passiontide, and Low Sunday. *)
  else if is_temporal && rank = Class1 && is_sunday
          && (season = Advent || season = Lent || season = Passiontide || off = 7)
  then 6
    (* 7: I-class ferias not above -- Ash Wednesday; Mon/Tue/Wed of Holy Week.
       Thu-Sat of Holy Week are the Triduum, entry 2 above, not this entry. *)
  else if is_temporal && rank = Class1 && (off = -46 || (off >= -6 && off <= -4)) then 7
    (* 8: All Souls -- register line 334's own text carries a qualifier this
       transcription must honour: "yields to an occurring Sunday". 2 November
       is always Time_after_pentecost (well clear of Advent/Lent/Passiontide
       and of every other entry's own Easter-relative or fixed date), so a
       Sunday landing on it is always an ordinary entry-15 II-class Sunday --
       the one and only rival this exception ever has to lose to. On such a
       Sunday this returns [entry_15_band + 1]: strictly worse than 15 (an
       exact tie would fall to Precedence.resolve's slug tie-break, which
       for "ef-all-souls" against a "ef-time-after-pentecost-sunday-*" slug
       would make All Souls WIN -- the precise bug this guards against), but
       otherwise not a citation to any other RG 91 row -- nothing else can
       ever occur on 2 November to be confused with it. Entry 8's own [rank]
       is untouched by this, so Task 8's disposition (RG 95: only I-class
       feasts transfer) still sees the true I-class candidate it needs to
       move to 3 November. *)
  else if (not is_temporal) && rank = Class1 && m = 11 && d = 2 then
    if is_sunday then entry_15_band + 1 else 8
    (* 9: Vigil of Pentecost. *)
  else if is_temporal && rank = Class1 && off = 48 then 9
    (* 10: Days within the Octaves of Easter and Pentecost. *)
  else if is_temporal && rank = Class1 && ((off >= 1 && off <= 6) || (off >= 50 && off <= 55))
  then 10
    (* 11: I-class feasts of the universal Church not above. *)
  else if (not is_temporal) && (not is_vigil) && rank = Class1 && is_universal layer then 11
    (* 12: Proper I-class feasts. *)
  else if (not is_temporal) && (not is_vigil) && rank = Class1 && not (is_indult layer) then 12
    (* 13: Indult I-class feasts. By elimination once 11 and 12 have failed:
       not the universal layer (11), and marked as an indult overlay (12's
       "not indult" test having just failed). *)
  else if (not is_temporal) && (not is_vigil) && rank = Class1 then 13
    (* 14: Feasts of the Lord, II class -- register line 341, deliberately
       UNQUALIFIED (contrast entry 16 at line 342, which explicitly says "not
       of the Lord"; RG 37c, register line 393, speaks of "II-class feasts of
       the Lord" replacing an occurring II-class Sunday with no universal
       qualifier either). No layer test here, unlike 11/12/13 and 16/19/20:
       the register does not split this entry into universal/proper/indult,
       so a proper or indult feast of the Lord still bands 14, not 19/20. *)
  else if (not is_temporal) && (not is_vigil) && rank = Class2 && subject = Subject.Lord then 14
    (* 15: Sundays, II class (every Sunday not already named at 6). *)
  else if is_temporal && rank = Class2 && is_sunday then entry_15_band
    (* 16: II-class feasts of the universal Church, not of the Lord. *)
  else if (not is_temporal) && (not is_vigil) && rank = Class2 && is_universal layer then 16
    (* 17: Days within the Octave of the Nativity (26-28 Dec are Stephen,
       John, the Innocents -- sanctoral, not this entry). *)
  else if is_temporal && rank = Class2 && m = 12 && (d = 29 || d = 30 || d = 31) then 17
    (* 18: II-class ferias -- Advent 17-23 Dec; Ember days of Advent, Lent,
       September. *)
  else if is_temporal && rank = Class2
          && ((season = Advent && m = 12 && d >= 17 && d <= 23) || is_ember_18 slug)
  then 18
    (* 19: Proper II-class feasts. *)
  else if (not is_temporal) && (not is_vigil) && rank = Class2 && not (is_indult layer) then 19
    (* 20: Indult II-class feasts. By elimination, as at 13. *)
  else if (not is_temporal) && (not is_vigil) && rank = Class2 then 20
    (* 21: II-class vigils (Ascension, Assumption, John Baptist, Peter & Paul
       -- can be temporal- or sanctoral-origin, see the file comment above). *)
  else if rank = Class2 && is_vigil then 21
    (* 22: Ferias of Lent and Passiontide (Thursday after Ash Wednesday to the
       Saturday before Palm Sunday), except the Ember days (18 above). *)
  else if is_temporal && rank = Class3 && (season = Lent || season = Passiontide) then 22
    (* 23: III-class feasts in particular calendars. Unlike 11/12 and 14/16
       above, the universal entry (24) is the HIGHER number here -- RG 91's
       own table ranks a particular-calendar III-class feast ahead of a
       universal one, the reverse of the I/II-class ordering. Transcribed as
       the register states it, not "corrected" into the other classes'
       pattern. RG 91 has no indult sub-rank at III class, so every non-base
       layer lands here, not split further. *)
  else if (not is_temporal) && (not is_vigil) && rank = Class3 && not (is_universal layer) then 23
    (* 24: III-class feasts in the universal calendar. *)
  else if (not is_temporal) && (not is_vigil) && rank = Class3 then 24
    (* 25: Ferias of Advent to 16 Dec, except the Ember days (18 above). *)
  else if is_temporal && rank = Class3 && season = Advent then 25
    (* 26: III-class vigils (St Lawrence). *)
  else if rank = Class3 && is_vigil then 26
    (* 27: Office of the BVM on Saturday -- every otherwise-unoccupied IV-class
       Saturday, per the historical default that fills it; ordinary Mass
       propers still make Rogation Mon/Tue/Wed proper without changing the
       Office (RG 88, see temporal_ef.ml's [temporal]), so those never carry
       this entry unless they happen to fall on the Saturday itself. Excludes
       vigils for the same reason 11-13/14/16/19/20/23/24 do: RG 91 has no
       IV-class vigil at all (its own vigil list, register lines 381-384,
       stops at III class), so one would be an anomaly, not this entry. *)
  else if is_temporal && (not is_vigil) && rank = Class4 && weekday = Date.Sat then 27
    (* 28: IV-class ferias -- the unqualified catch-all (temporal_ef.ml's own
       comment on [ferial_rank] cites the same primary text, "Feriae IV
       classis"). Excludes vigils for the same reason as 27 above: a IV-class
       "feria" that is also a vigil is not a feria RG 91 describes. *)
  else if (not is_vigil) && rank = Class4 then 28
  else unclassified

(* Task 8: what happens to the day's LOSING candidate (docs/research/
   rules-register.md §4, "Occurrence" RG 92-95 and "Vigils" RG 33, plus RG
   94). [band] above decides who wins; this decides the loser's fate, which
   turns on the LOSER's own rank and status (RG 95), except RG 33's vigil
   omission, which also has to read the winner. Nothing here ever returns
   [Precedence.Repose]: that disposition denotes RG 100-102's *repositio*
   (perpetual impediment from a proper/diocesan calendar), out of this
   plan's scope -- see calendar.mli's own note that nothing in the EF
   ruleset currently emits it. *)

(* RG 33 (register line 383-384): a I- or II-class vigil falling on any
   Sunday or a I-class feast is entirely omitted. Every Sunday slug this
   rite's temporal cycle produces -- named (temporal_ef.ml's [named], e.g.
   "ef-easter-sunday") or the generic "ef-<season>-sunday-<n>" fallback
   ([sunday_slug]) -- contains this marker; nothing else [band] classifies
   does. Not an RG citation itself -- see [universal_layer]'s note on this
   file's own naming conventions -- exposed for the same reason as
   {!vigil_suffix}: a future rename of temporal_ef's Sunday-slug format has
   somewhere to be caught other than a silently-wrong RG 33 disposition. *)
let sunday_marker = "-sunday"

let contains_substring s ~needle =
  let ls = String.length s and ln = String.length needle in
  let rec at i = i + ln <= ls && (String.sub s i ln = needle || at (i + 1)) in
  ln = 0 || at 0

let is_sunday_slug slug = contains_substring slug ~needle:sunday_marker

(* RG 33's own two conditions, taken directly from its text ("any Sunday or
   a I-class feast") -- NOT derived from anything about which RG 91 entries
   can numerically outrank a vigil. [rank = Class1] is the "I-class feast"
   half. [is_sunday_slug] is the "any Sunday" half, and it is not redundant
   with the rank check: RG 91 entries 14 and 16-20 (Feasts of the Lord II
   class, universal/proper/indult II-class feasts, days within the Nativity
   octave) are all [Class2], all outrank a II-class vigil (entry 21), and
   none of them is a Sunday -- a winner of that shape satisfies neither
   condition here, so [impedes_vigil] correctly returns [false] and such a
   vigil falls through to RG 95's ordinary commemorate-or-omit branch
   instead of RG 33's omission, exactly as the rubric requires. *)
let impedes_vigil (winner : Vocab_ef.rank Precedence.candidate) =
  let cel = winner.Precedence.cel in
  cel.Celebration.rank = Vocab_ef.Class1
  || is_sunday_slug (Slug.to_string cel.Celebration.slug)

(* RG 91 entry 17's own slug convention (rite_ef/temporal_ef.ml's [named]:
   "ef-nativity-octave-day-%d" for 29-31 Dec -- 26-28 Dec are Stephen, John,
   the Innocents, sanctoral, and never carry this prefix, see [band]'s entry
   17 comment). Not an RG citation itself -- see [universal_layer] -- reused
   below by [privilege_of] for RG 109(c). *)
let nativity_octave_prefix = "ef-nativity-octave-day-"

(* RG 109's own three named seasons for (e), "of ferias of Advent, Lent and
   Passiontide" (register line 376) -- temporal_ef.ml's generic
   <season>-<week>-<weekday> ferial fallback slugs, whose season word is
   [season_slug_word]'s output for exactly these three (vocab_ef.ml: Advent
   and Passiontide are unmodified [season_to_string]; Lent likewise). Also
   matches the Lent "after Ashes" sub-case ("ef-lent-after-ashes-<weekday>",
   temporal_ef.ml's own [christmastide_feria_slug]-adjacent branch), which
   is still a Lent feria under this same prefix. Not an RG citation -- see
   [universal_layer] -- private: nothing outside [privilege_of] needs it. *)
let alp_feria_prefixes = [ "ef-advent-"; "ef-lent-"; "ef-passiontide-" ]

(* RG 109 (register lines 374-377, docs/research/rules-register.md §4): the
   closed list of privileged commemorations, checked in the register's own
   lettered order. A candidate matching none of (a)-(f) is ordinary, per the
   register's own closing sentence, "All others are ordinary." Read entirely
   off the candidate's own fields (rank, slug, origin) -- no [context]
   (date/season/weekday) is available or needed: every category names a
   property of the commemorated OFFICE ITSELF ("a commemoration OF a
   Sunday", "OF a I-class day", ...), not of the day it happens to fall on,
   and each of (a)-(e) already has a candidate-only marker this file's own
   conventions establish ([sunday_marker], rank, [nativity_octave_prefix],
   [september_ember_prefix]/[alp_feria_prefixes]) -- see the task report for
   the full reasoning.

   [disposition] below is this function's only caller, at both of its
   [Commemorate] sites -- replacing Task 8's [interim_privilege] placeholder,
   which always returned [Ordinary] regardless of the loser's real shape.
   [admit] (RG 108-111's admission counts, below) trusts the privilege value
   [disposition] has already attached rather than recomputing it here a
   second time. *)
let privilege_of (c : Vocab_ef.rank Precedence.candidate) : Precedence.privilege =
  let cel = c.Precedence.cel in
  let rank = cel.Celebration.rank in
  let slug = Slug.to_string cel.Celebration.slug in
  let is_temporal = c.Precedence.origin = Precedence.Temporal in
  let open Vocab_ef in
  (* (a) register line 374: "of a Sunday" -- the same slug marker RG 33's
     [impedes_vigil] already reads to answer "is this candidate a Sunday". *)
  if is_sunday_slug slug then Precedence.Privileged
  (* (b) register line 374-375: "of a I-class day" -- the candidate's own
     rank. In this codebase's current disposition rules the ONLY way a
     [Class1] candidate ever reaches [Commemorate] at all is via
     [Celebration.status = Commemoration_only] (a plain [Feast]-status
     [Class1] loser always [Transfer]s instead, RG 95, below) -- so this
     branch is real but its only reachable witness today is that shape; see
     the task report. *)
  else if rank = Class1 then Precedence.Privileged
  (* (c) register line 375: "of days within the Octave of the Nativity". *)
  else if is_temporal && String.starts_with ~prefix:nativity_octave_prefix slug then
    Precedence.Privileged
  (* (d) register line 375-376: "of September Ember days" -- deliberately
     ONLY the September set: RG 109 does not list the Advent or Lent Ember
     sets (also II class, RG 91 entry 18), so those must fall through to
     "ordinary", not be caught here or at (e) below. *)
  else if is_temporal && String.starts_with ~prefix:september_ember_prefix slug then
    Precedence.Privileged
  (* (e) register line 376: "of ferias of Advent, Lent and Passiontide" --
     [not (is_ember_18 slug)] is required, not redundant with (d): the
     Advent and Lent Ember prefixes ("ef-advent-ember-", "ef-lent-ember-")
     also start with this branch's own [alp_feria_prefixes] entries
     ("ef-advent-", "ef-lent-"), and RG 109 does not privilege them (see (d)
     above) -- without this exclusion they would wrongly match here. *)
  else if is_temporal
          && (not (is_ember_18 slug))
          && List.exists (fun p -> String.starts_with ~prefix:p slug) alp_feria_prefixes
  then Precedence.Privileged
  (* (f) register line 376-377: "of the Major Rogations, in Mass" -- the
     Major Litanies (25 April, RG 80) are not yet computed anywhere in this
     codebase (temporal_ef.ml's own comment on [temporal]'s Rogation branch:
     "The Major Litanies... are a fixed date and are not yet computed; they
     arrive with Plan 3's sanctoral"), so no candidate this engine can
     currently construct represents one. There is no existing slug
     convention to anchor a check to, and guessing one risks silently
     misclassifying whatever a future task does name it -- a wrong citation
     is worse than a missing one, so this is left unimplemented and flagged
     in the task report rather than guessed. Deliberately NOT matched by
     anything above: the Minor Litanies/Rogations ("ef-rogation-monday"/
     "-tuesday", RG 87) temporal_ef.ml DOES compute are a different
     observance RG 109(f) does not name (RG 88: the Minor Rogations change
     nothing in the Office at all), so they correctly fall through to
     "ordinary" below, not this category. *)
  else Precedence.Ordinary

let disposition ~(winner : Vocab_ef.rank Precedence.candidate)
    ~(loser : Vocab_ef.rank Precedence.candidate) : Precedence.disposition =
  let open Vocab_ef in
  let cel = loser.Precedence.cel in
  if cel.Celebration.status = Celebration.Commemoration_only then
    (* Always -- checked before RG 33's omission and RG 95's transfer so
       neither can override it: a Commemoration_only entry can never win
       (Precedence.resolve holds it out of the band contest entirely, see
       that module's [resolve]) and, per the brief, can never transfer
       either. Its privilege is [privilege_of loser] like every other
       [Commemorate] below -- Commemoration_only carries a real [rank] for
       exactly this purpose (Celebration.mli: "RG 111 orders admitted
       commemorations by dignity"), so RG 109(b) applies to it precisely as
       it would to any other candidate. *)
    Precedence.Commemorate (privilege_of loser)
  else if
    (cel.Celebration.rank = Class1 || cel.Celebration.rank = Class2)
    && is_vigil (Slug.to_string cel.Celebration.slug)
    && impedes_vigil winner
  then
    (* RG 33. Checked before the generic Class1 -> Transfer rule below, or a
       I-class vigil (Nativity, Pentecost) impeded on its own Sunday/
       I-class-feast terms would wrongly transfer instead of vanishing. *)
    Precedence.Omit
  else if
    cel.Celebration.rank = Class1
    && not (is_sunday_slug (Slug.to_string cel.Celebration.slug))
  then
    (* RG 95 (register lines 323, 363): only I-class FEASTS have the right
       of translation -- RG 91's own table lists Sundays as a separate row
       (entry 6, register line 332) from feasts (entries 11-13, register
       lines 337-339), so a Sunday is never a "feast" in RG 95's sense, and
       [is_sunday_slug] (the same marker RG 33's [impedes_vigil] and RG
       109(a)'s [privilege_of] already use) excludes it here. This is the
       branch that completes Task 7's All Souls fix (register line 334, RG
       91 entry 8): All Souls is I class, not a vigil, and not a Sunday
       slug, so once it loses to an occurring Sunday it still reaches here
       and transfers -- to 3 November, now DIRECTLY authorised by RG 96
       Attamen (b) (primary-source-verified 2026-08-12): "Commemoratio
       omnium Fidelium defunctorum, quando occurrit cum dominica,
       transfertur, tamquam in sedem propriam, in feriam II sequentem" --
       when it coincides with a Sunday, transferred, as to its own proper
       seat, to the following Monday. Previously this rested only on entry
       8's own parenthetical plus the general RG 96 walk, which happened to
       produce the right date; WHERE it lands either way is
       Rite.transfer_target's job, not this function's -- disposition only
       says THAT it moves. *)
    Precedence.Transfer
  else
    (* RG 95's other branch: "aut commemorantur aut penitus omittuntur" --
       commemorated or wholly omitted. Reached by everything below I class,
       AND by an impeded I-class Sunday (excluded from the [Transfer] branch
       above): RG 109(a) (register line 374) lists "of a Sunday" as a
       privileged commemoration category, which presupposes an impeded
       Sunday stays put rather than moving to another day the way a feast
       does -- [privilege_of] tags it [Privileged] via the same
       [is_sunday_slug] marker, with no further code needed here. Which of
       commemorate/omit survives is RG 108-111's admission count ([admit],
       below), not this function's decision; this only opens the
       commemoration, tagged with its real RG 109 privilege via
       [privilege_of].

       RG 94 (a fixed-day commemoration is not carried along with a
       transferred feast) needs no code here: [Precedence.resolve] calls
       this function once per loser, always against the day's actual
       [observed] winner -- never against a fellow loser that itself
       transferred away -- so no mechanism exists by which a commemoration
       could ride along with a departing feast in the first place; there is
       nothing to suppress. *)
    Precedence.Commemorate (privilege_of loser)

(* Task 9: how many of the day's commemorations RG 111 admits, and which
   (docs/research/rules-register.md §4, register line 378, "Commemorations"
   RG 111). [band] decides who wins the day; [disposition] decides who is
   even eligible to be commemorated, and tags each with its RG 109 privilege
   via [privilege_of]; this decides how many of THOSE survive.

   RG 111 keys its four admission rules off the CLASS OF THE DAY ("diebus I
   classis", "dominicis II classis", "aliis diebus II classis", "diebus III
   et IV classis") -- read here off [observed]'s own [rank] and, for the
   Sunday/non-Sunday II-class split, the same slug marker [privilege_of] and
   RG 33's [impedes_vigil] already use ([is_sunday_slug]). No [context]
   (date/season/weekday) is available to [admit] (see precedence.mli's
   [rules.admit]) or needed: [observed] IS the day's own celebration, so its
   rank and slug already carry everything RG 111's own four categories test. *)

(* RG 8's four-class dignity order, Class1 highest. Deliberately NOT [band]
   (RG 91's much finer 28-entry table): [band] needs a [context] [admit]
   does not have (see above), and Celebration.mli's own comment on [status]
   -- "RG 111 orders admitted commemorations by dignity" -- names [rank]
   itself as that dignity, not the finer occurrence-table entry. *)
let dignity = function
  | Vocab_ef.Class1 -> 1
  | Vocab_ef.Class2 -> 2
  | Vocab_ef.Class3 -> 3
  | Vocab_ef.Class4 -> 4

(* Deterministic selection order for RG 111: dignity first, then slug --
   the same tie-break {!Precedence.compare_by} uses for [band] itself (the
   brief: "break ties on slug"), so which candidate wins a shared rank never
   depends on the order [comms] arrives in. *)
let compare_dignity (a, _) (b, _) =
  let da = dignity a.Precedence.cel.Celebration.rank
  and db = dignity b.Precedence.cel.Celebration.rank in
  if da <> db then Int.compare da db
  else Slug.compare a.Precedence.cel.Celebration.slug b.Precedence.cel.Celebration.slug

let rec take n = function
  | [] -> []
  | x :: xs -> if n <= 0 then [] else x :: take (n - 1) xs

let admit ~(observed : Vocab_ef.rank Precedence.candidate)
    (comms : (Vocab_ef.rank Precedence.candidate * Precedence.privilege) list) :
    (Vocab_ef.rank Precedence.candidate * Precedence.privilege) list =
  (* Sorted once, by dignity then slug (see [compare_dignity]); every branch
     below either takes a prefix of this list or filters it, so the RESULT
     is always a sub-list of [comms] with its elements untouched -- never
     rebuilt -- which matters beyond determinism: {!Precedence.resolve}'s
     own [dropped] computation tells an admitted candidate from a dropped
     one by physical equality (==) on the candidate value (Task 2's own
     deferred note: "assuming admit returns the same candidate values rather
     than rebuilt ones; undocumented for rite authors" -- documented here,
     now that this is the function that note was about). Building a fresh
     [{ c with ... }] record anywhere below would silently defeat that
     accounting: the dropped candidate would then match nothing in
     [admitted], and {!Precedence.resolve} would count it as dropped a
     SECOND time (once for real, once because its identity no longer
     matches its own admitted copy) without ever raising -- a silent
     double-count, not a crash, which is exactly why this comment exists. *)
  let sorted = List.stable_sort compare_dignity comms in
  let is_privileged (_, p) = p = Precedence.Privileged in
  let observed_rank = observed.Precedence.cel.Celebration.rank in
  let observed_is_sunday =
    is_sunday_slug (Slug.to_string observed.Precedence.cel.Celebration.slug)
  in
  let open Vocab_ef in
  match (observed_rank, observed_is_sunday) with
  | Class1, _ ->
      (* RG 111: "I class: none save one privileged." Ordinary commemorations
         never get a slot at all on a I-class day, no matter how many are
         due; at most one privileged one does, the highest-dignity one if
         several are. *)
      (match List.filter is_privileged sorted with [] -> [] | best :: _ -> [ best ])
  | Class2, true ->
      (* RG 111: "II-class Sundays: one (dropped if a privileged one is
         due)." Read as: the day's one slot goes to a privileged
         commemoration whenever one is due, categorically -- not by
         comparing its dignity against the ordinary contender's -- so an
         ordinary commemoration that would otherwise win the slot on raw
         dignity is still dropped once any privileged commemoration is also
         due. This is the asymmetric clause the brief and task report flag
         as deliberate, not present at "other II class" below; see the task
         report for the reasoning and its residual uncertainty (the register
         does not spell out the mechanism beyond this one sentence). *)
      (match List.filter is_privileged sorted with
       | best :: _ -> [ best ]
       | [] -> ( match sorted with [] -> [] | best :: _ -> [ best ] ))
  | Class2, false ->
      (* RG 111: "other II class: one" -- no privilege-override clause here,
         unlike the Sunday case immediately above, so the day's one slot
         goes to whichever candidate outranks the rest by dignity alone,
         privileged or not. *)
      (match sorted with [] -> [] | best :: _ -> [ best ])
  | (Class3 | Class4), _ ->
      (* RG 111: "III-IV class: at most two" -- by dignity, same as the
         non-Sunday II-class case, just with room for two. *)
      take 2 sorted

(* Task 11: RG 96 -- where an impeded I-class feast lands (docs/research/
   rules-register.md §4, "Transfer/translation"). [band] decides who is
   impeded; [disposition] decides that an impeded I-class FEAST (not a
   Sunday, not omitted by RG 33) is [Transfer]-disposed; this is the third
   and final question RG 96 poses -- WHERE the translation lands -- and is
   {!Rite.t.transfer_target} itself, called by {!Calendar}'s placement pass
   once per deferred candidate, never re-run once a target is accepted
   (calendar.ml's own comment on [~start ~stop]).

   RG 96's own text, register-transcribed: "the next following day that is
   not I or II class." [is_blocking] reads that off [Vocab_ef.rank] --
   RG 96 speaks of the day's CLASS (RG 8's four-way dignity), not [band]'s
   finer 28-entry occurrence-table row, the same distinction {!admit} above
   already draws for RG 111 ({!dignity}, not [band]). *)
let is_blocking (rank : Vocab_ef.rank) = rank = Vocab_ef.Class1 || rank = Vocab_ef.Class2

(* RG 96's own named exception (docs/research/rules-register.md §4,
   "Transfer/translation", RG 96 Attamen (a) -- primary-source-verified
   2026-08-12, corrected from an earlier unconditional transcription; see
   the register's own correction note). Verbatim: "festum Annuntiationis
   B. Mariae Virg., quando est transferendum post Pascha, transfertur,
   tamquam in sedem propriam, in feriam II post dominicam in albis" -- when
   [the feast] is to be transferred PAST EASTER, [it] is transferred, as to
   its own proper seat, to the Monday after Low Sunday. The exception is
   CONDITIONAL on that "past Easter" clause -- {!transfer_target} tests it
   by comparing the GENERAL RG 96 target against Easter itself, not by
   testing the date here. Identified by slug -- the same convention this
   file already uses to pick out one specific celebration from a rank/
   status shape shared by many others ({!nativity_octave_prefix},
   [is_ember_18]'s date anchors) -- not an RG citation itself: RG 96 does
   not encode how a computer recognises "the Annunciation", only what
   happens to it once recognised. data/ef/sanctoral.sexp's own bootstrapped
   slug (Task 10), reused verbatim rather than guessed. *)
let annunciation_slug = "annunciation-of-the-blessed-virgin-mary"

(* Not an RG citation -- a defensive engineering ceiling, the same role
   Calendar's own [max_transfer_rounds] plays for the OUTER round loop
   (calendar.ml). That guard bounds how many ROUNDS the whole-year placement
   pass takes; it does nothing for the walk a single call to this function
   makes internally, which is this module's own responsibility (rite.mli
   documents the obligation this constant exists to satisfy). Comfortably
   longer than the longest real run of consecutive I/II-class days the 1962
   calendar produces -- 24 Dec to 1 Jan (the Nativity vigil through the
   Circumcision, both I class, with the intervening octave days II class) is
   9 days; Easter through Low Sunday (the Easter octave, I class, entry 10)
   is 8 -- RG 91 entry 28's own unqualified IV-class catch-all guarantees a
   non-blocking feria follows any such run in real data. Not tuned to that
   bound any more than 64 is tuned to RG 97-98's real collision count: a
   ceiling nothing in the 1962 calendar comes close to, so a rite/data shape
   this module has not anticipated fails FINITELY (see [search_from]) rather
   than hanging the CLI. *)
let max_search_days = 400

(* The domain's own ceiling ({!Date.make}'s documented 1583..9999 bound,
   also duplicated by calendar.ml's own [domain_max_date] for the same
   reason: neither module exposes it to the other, and this is a three-line
   constant, not worth a new signature just to share it). [search_from]
   below must never call [occupant] on a date past this: [occupant] chains
   through the rite's own [temporal] (calendar.ml's [resolve_with_injected]),
   which for the real EF rite calls [Computus.gregorian_easter], which is
   NOT total outside 1583..9999 -- it constructs a [Date.t] via [Date.make]
   and [failwith]s on [Error]. [Date.add_days] itself has no such limit (it
   is documented "unbounded total arithmetic"), so [search_from] CAN walk
   [d] past 31 December 9999 without raising by itself -- the raise would
   only happen on the NEXT [occupant d] call, which is exactly the bug this
   guards against: an I-class feast impeded late enough in civil year 9999
   that every remaining day of the year is also I or II class (reachable
   through the project's own overlay mechanism, confirmed by review: an
   Add-ed I-class feast on 25 December leaves only Class2 Nativity-octave
   days for the rest of 9999, so the unguarded walk reached 1 January 10000
   and crashed there). *)
let domain_max_date =
  match Date.make ~year:9999 ~month:12 ~day:31 with Ok d -> d | Error e -> failwith e

(* Walks forward from [d], returning the first date [occupant] reports as
   NOT [is_blocking]. [steps] is a strictly increasing structural bound on
   the recursion, capped at [max_search_days]: the function decreases
   [max_search_days - steps] by exactly one on every call and returns as
   soon as that reaches zero (whether or not an admissible day was ever
   found), so THIS loop terminates by construction, regardless of what
   [occupant] reports -- it does not rely on the real EF calendar's own
   structure to guarantee termination the way the comment above explains
   why the bound is never actually reached in practice. Also stops, without
   calling [occupant] again, once [d] passes {!domain_max_date} -- see that
   constant's own comment for why probing [occupant] beyond it can raise.
   Either way the last date visited is returned WITHOUT a further
   [occupant] probe -- one more finite (not necessarily admissible) date,
   not a further search -- because the value the caller ([transfer_target])
   is still owed is "a date", never an exception; {!Calendar}'s own
   [~start ~stop] bound (calendar.ml's [place_transfers]) is what turns an
   implausible non-terminating real search into a recorded [omitted], not
   this function pretending to have found something admissible. *)
let rec search_from (occupant : Date.t -> Vocab_ef.rank Celebration.t) (steps : int) (d : Date.t) :
    Date.t =
  if steps >= max_search_days || Date.compare d domain_max_date > 0 then d
  else if is_blocking (occupant d).Celebration.rank then search_from occupant (steps + 1) (Date.add_days d 1)
  else d

(* [transfer_target]'s contract (rite.mli): total, terminating, and its
   result is always strictly after [origin]. Terminating: [search_from]'s
   own structural bound, above. Strictly after [origin]: the general branch
   is exactly [search_from]'s own result starting at [Date.add_days origin
   1], which only ever advances forward from there, so it is always >=
   origin + 1. The Annunciation branch, when it fires, instead searches from
   the Monday after Low Sunday for [origin]'s own civil year -- NOT provably
   later than [origin] by the code alone, but true of every representable
   year: the Annunciation's [origin] is always 25 March (Date_spec.Fixed in
   data/ef/sanctoral.sexp), Easter always falls within that SAME civil year
   in [22 March, 25 April] (Computus's own documented range, register §0),
   so Low Sunday (Easter + 7) falls in [29 March, 2 May] and the Monday
   after it in [30 March, 3 May] -- always after 25 March.

   RG 96 Attamen (a) (see {!annunciation_slug}'s own comment) makes the
   Annunciation exception CONDITIONAL on the general walk carrying the
   feast past Easter -- so the general target is always computed FIRST,
   for every candidate, and only overridden for the Annunciation when that
   target itself falls after Easter Sunday. A version of this function that
   tested the DATE of [origin] instead (e.g. "is 25 March within some fixed
   window of Easter") would be re-deriving the register's own "quando est
   transferendum post Pascha" condition from first principles, exactly the
   kind of guess this project's "a wrong citation is worse than a missing
   one" rule warns against; comparing the general target against Easter
   directly tests the rubric's own words. *)
let transfer_target (c : Vocab_ef.rank Precedence.candidate) (origin : Date.t)
    (occupant : Date.t -> Vocab_ef.rank Celebration.t) : Date.t =
  let general_target = search_from occupant 0 (Date.add_days origin 1) in
  let is_annunciation = Slug.to_string c.Precedence.cel.Celebration.slug = annunciation_slug in
  let easter = Computus.gregorian_easter (Date.year origin) in
  if is_annunciation && Date.compare general_target easter > 0 then
    (* Low Sunday = Easter + 7 (register §0, temporal_ef.ml's [off 7]); the
       Monday after it = Easter + 8. Searched onward from there exactly
       like the general case searches from [origin + 1] -- "only if that
       day is itself blocked" (rite.mli) is [search_from]'s ordinary
       behaviour, not a second mechanism. *)
    search_from occupant 0 (Date.add_days easter 8)
  else general_target