diff options
| -rw-r--r-- | lib/rites/rite_ef/precedence_ef.ml | 224 | ||||
| -rw-r--r-- | lib/rites/rite_ef/precedence_ef.mli | 62 | ||||
| -rw-r--r-- | test/test_precedence_ef.ml | 310 |
3 files changed, 567 insertions, 29 deletions
diff --git a/lib/rites/rite_ef/precedence_ef.ml b/lib/rites/rite_ef/precedence_ef.ml index 02181ed..06bbf7c 100644 --- a/lib/rites/rite_ef/precedence_ef.ml +++ b/lib/rites/rite_ef/precedence_ef.ml @@ -74,8 +74,18 @@ let is_vigil slug = String.ends_with ~suffix:vigil_suffix slug 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. *) -let ember_prefixes = [ "ef-advent-ember-"; "ef-lent-ember-"; "ef-september-ember-" ] + 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 @@ -259,15 +269,95 @@ let impedes_vigil (winner : Vocab_ef.rank Precedence.candidate) = cel.Celebration.rank = Vocab_ef.Class1 || is_sunday_slug (Slug.to_string cel.Celebration.slug) -(* Not yet RG 109 (Task 9's job: the closed list of privileged commemorations - and RG 108-111's admission counts). Every [Commemorate] this function - returns carries this one placeholder rather than a silent default, so the - choice is visible and grep-able. [Ordinary] chosen over [Privileged] - deliberately: it grants no admission entitlement RG 111 has not earned, - so code that trusts this value before Task 9 replaces it under-privileges - a commemoration rather than over-privileges one -- the safer direction to - be wrong in. *) -let interim_privilege = Precedence.Ordinary +(* 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 = @@ -278,8 +368,12 @@ let disposition ~(winner : Vocab_ef.rank Precedence.candidate) 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. *) - Precedence.Commemorate interim_privilege + 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) @@ -302,8 +396,9 @@ let disposition ~(winner : Vocab_ef.rank Precedence.candidate) (* RG 95's other branch, for everything below I class: "aut commemorantur aut penitus omittuntur" -- commemorated or wholly omitted. Which of the two survives is RG 108-111's admission count - (Task 9's [admit]), not this function's decision; this only opens the - commemoration. + ([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 @@ -312,4 +407,101 @@ let disposition ~(winner : Vocab_ef.rank Precedence.candidate) 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 interim_privilege + 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 diff --git a/lib/rites/rite_ef/precedence_ef.mli b/lib/rites/rite_ef/precedence_ef.mli index 9fe8789..9c3af95 100644 --- a/lib/rites/rite_ef/precedence_ef.mli +++ b/lib/rites/rite_ef/precedence_ef.mli @@ -65,13 +65,6 @@ val band : Vocab_ef.season Precedence.context -> Vocab_ef.rank Precedence.candid somewhere to be caught other than a silently-wrong RG 33 disposition. *) val sunday_marker : string -(** The placeholder {!Precedence.privilege} every [Commemorate] disposition - below carries until Task 9 implements RG 109's closed list of privileged - commemorations and RG 108-111's admission counts. Exposed so Task 9 (and - any test wanting to assert on it explicitly) does not have to duplicate - the literal [Precedence.Ordinary]. *) -val interim_privilege : Precedence.privilege - (** [disposition ~winner ~loser]: RG 92-95, 33, 94 (docs/research/ rules-register.md §4, "Occurrence" and "Vigils"). What becomes of a losing candidate, decided by the LOSER's own rank and status (RG 95), @@ -89,8 +82,8 @@ val interim_privilege : Precedence.privilege right of translation; this is also what moves All Souls, register line 334, once it loses to an occurring Sunday -- WHERE it lands is {!Rite.t.transfer_target}'s job, not this function's); - - everything else is [Commemorate], carrying {!interim_privilege} until - Task 9 replaces it with RG 109's real per-day computation. + - everything else is [Commemorate], carrying its real RG 109 privilege + (see {!admit} below). Total over every winner/loser pair {!Precedence.resolve} or {!Calendar} can construct: [Vocab_ef.rank] (RG 8) and {!Celebration.status} are both @@ -102,3 +95,54 @@ val disposition : winner:Vocab_ef.rank Precedence.candidate -> loser:Vocab_ef.rank Precedence.candidate -> Precedence.disposition + +(** Slug prefix marking a celebration as one of RG 91 entry 17's days within + the Octave of the Nativity (29-31 Dec -- 26-28 Dec are Stephen, John, the + Innocents, sanctoral, never this prefix). Also colitur's own convention + mirroring rite_ef/temporal_ef.ml's own "ef-nativity-octave-day-%d" slug + format, not an RG citation -- see {!universal_layer} -- exposed for the + same reason as {!vigil_suffix}: a rename of that format has somewhere to + be caught other than a silently-wrong RG 109(c) privilege. *) +val nativity_octave_prefix : string + +(** The September set of {!ember_prefixes}, broken out on its own because RG + 109(d) privileges September Ember days specifically while leaving the + Advent and Lent sets (also {!ember_prefixes}) ordinary -- register lines + 375-376. {!ember_prefixes} is built from this constant, not a duplicated + literal, so the two cannot silently drift apart. *) +val september_ember_prefix : string + +(** [admit ~observed comms]: RG 108-111 (docs/research/rules-register.md §4, + "Commemorations", register lines 371-379). How many of [comms] -- each + already tagged with its real RG 109 privilege by {!disposition} -- RG + 111 admits, and which, given the day actually observed: + - [observed] a [Class1] day: none, except at most one privileged + commemoration (the highest-dignity one, if several are due) -- an + ordinary one is never admitted here, no matter how many are due; + - [observed] a [Class2] Sunday (its slug carries {!sunday_marker}): one + -- a privileged commemoration takes the day's one slot over any + ordinary one whenever one is due, not by comparing dignity, so an + ordinary commemoration that would otherwise win on dignity is still + dropped; + - [observed] any other [Class2] day: one, by dignity alone -- no + privilege override, unlike the Sunday case immediately above; + - [observed] a [Class3] or [Class4] day: at most two, by dignity alone. + + "Dignity" here is [Vocab_ef.rank] (RG 8's four classes), NOT {!band}'s + finer RG 91 entry number -- {!band} needs a [context] (date/season/ + weekday) this function does not receive (see {!Precedence.rules.admit}). + Ties break on slug, matching {!Precedence.compare_by}, so the result + never depends on the order [comms] arrives in. + + Every candidate this returns is a value taken unchanged from [comms], + never rebuilt: {!Precedence.resolve}'s own [dropped]/[omitted] + accounting tells an admitted candidate from a dropped one by physical + equality on the candidate value, so anything this function admitted + stays admitted, and anything it did not is reported in + {!Precedence.resolution.omitted}, never silently lost. Total: every + [Vocab_ef.rank] is one of the four cases above, and every branch is + itself total over an empty or arbitrarily long [comms]. *) +val admit : + observed:Vocab_ef.rank Precedence.candidate -> + (Vocab_ef.rank Precedence.candidate * Precedence.privilege) list -> + (Vocab_ef.rank Precedence.candidate * Precedence.privilege) list diff --git a/test/test_precedence_ef.ml b/test/test_precedence_ef.ml index 3b2d5f6..f3fd357 100644 --- a/test/test_precedence_ef.ml +++ b/test/test_precedence_ef.ml @@ -352,13 +352,25 @@ let disposition_cases = here with a loser that ALSO carries a Class1 rank and a vigil-suffixed slug losing to a Sunday, so this row only passes if the Commemoration_only check is checked BEFORE both RG 33's omission and - RG 95's transfer, not after. *) + RG 95's transfer, not after. Its expected privilege is [Privileged], + not [Ordinary]: this loser's [rank] is [Class1] (the default [cand] + leaves unless overridden, deliberately kept here for the + branch-order proof above), and RG 109(b) (register line 374-375, "of + a I-class day") makes any [Class1] commemoration privileged + regardless of how it reached [Commemorate] -- Task 8's placeholder + [interim_privilege] used to hide this (always [Ordinary]); Task 9's + real [privilege_of] does not. This row is also this suite's ONLY + witness for RG 109(b): a plain [Feast]-status [Class1] loser never + reaches [Commemorate] at all (RG 95 sends it to [Transfer] instead, + see the row above), so [Commemoration_only] is the only shape that + can exercise it here (see the task report). *) ( "Commemoration_only loser is always Commemorate, even if I-class and \ - vigil-shaped, even losing to a Sunday", + vigil-shaped, even losing to a Sunday -- and RG109(b) makes it \ + privileged", an_ordinary_sunday, cand ~origin:P.Sanctoral ~status:Cel.Commemoration_only ~layer:PE.universal_layer "ef-suppressed-vigil", - "Commemorate(Ordinary)" ); + "Commemorate(Privileged)" ); (* Totality: the lower ranks the RG 33/RG 95 branches never touch still reach the RG 95 "commemorated or omitted" branch, not an unhandled/exceptional case. *) @@ -372,6 +384,276 @@ let disposition_cases = "Commemorate(Ordinary)" ) ] +(* Task 9: [privilege_of]'s RG 109 categories (register lines 374-377), + exercised through [PE.disposition]'s [Commemorate] payload -- [privilege_of] + itself is private, so this is the only vantage point a test outside + precedence_ef.ml has on it. Each row below is built to match ONLY the one + category it names (see each row's own comment for why), closing the + hazard flagged in the task brief ("a test day that is both a Sunday and a + I-class day proves nothing about either"). Category (b), "of a I-class + day", already has its sole witness above (the Commemoration_only row): + a plain [Feast]-status [Class1] loser can never reach [Commemorate] at + all in this ruleset (RG 95 routes it to [Transfer] instead), so no + further row for (b) is added here -- see the task report. Category (f), + "of the Major Rogations, in Mass", has no row at all: no candidate this + codebase can currently construct represents one (see [privilege_of]'s own + comment on (f)) -- the negative row below proves the one slug this engine + DOES compute that could be mistaken for it (the Minor Rogations) is + correctly NOT conflated with it, which is the strongest claim available + without inventing an unfounded slug convention. *) +let privilege_cases = + [ (* (a) register line 374: "of a Sunday". [an_ordinary_sunday] is Class2, + not Class1, not within the Nativity octave, not an Ember day, not a + feria of Advent/Lent/Passiontide -- matches (a) alone. *) + ( "(a) an ordinary Sunday commemoration is privileged", + cand "ef-nativity", + an_ordinary_sunday, + "Commemorate(Privileged)" ); + (* (c) register line 375: "of days within the Octave of the Nativity" -- + sourced from [Temporal_ef.temporal]'s own output (29 Dec 2026, Class2, + "ef-nativity-octave-day-5"), not a hand-typed slug, for the same + coupling-safety reason the file's own [of_temporal] rows use it + elsewhere. Not a Sunday, not Class1, not an Ember day, not an + Advent/Lent/Passiontide feria slug. *) + ( "(c) a day within the Nativity octave is privileged", + cand "ef-nativity", + of_temporal (mk 2026 12 29), + "Commemorate(Privileged)" ); + (* (d) register line 375-376: "of September Ember days" -- 23 Sep 2026 is + the September Ember Wednesday (independently derived from + [Temporal_ef]'s own third-Sunday-of-September rule: first Sunday of + September 2026 is the 6th, +14 days = 20th, +3 = 23rd), sourced from + [Temporal_ef.temporal] itself, Class2. Not a Sunday, not Class1, not + within the Nativity octave, not an Advent/Lent Ember day (a DIFFERENT + Ember set, deliberately excluded by (d) -- see the negative row + below), not a plain Advent/Lent/Passiontide feria slug either. *) + ( "(d) a September Ember day is privileged", + cand "ef-nativity", + of_temporal (mk 2026 9 23), + "Commemorate(Privileged)" ); + (* (e) register line 376: "of ferias of Advent, Lent and Passiontide" -- + two rows, one per season named, both from [Temporal_ef.temporal]'s + own generic ferial fallback, neither a Sunday, Ember day, or within + the Nativity octave. *) + ( "(e) an Advent feria is privileged", + cand "ef-nativity", + of_temporal (mk 2026 12 1), + "Commemorate(Privileged)" ); + ( "(e) a Lent feria is privileged", + cand "ef-nativity", + of_temporal (off (-41)), + "Commemorate(Privileged)" ); + (* Negative, RG 109(d) vs (e)'s own boundary: the Advent and Lent Ember + sets are ALSO II-class ferias of Advent/Lent by RG 91 (entry 18), and + their slugs ("ef-advent-ember-*", "ef-lent-ember-*") share (e)'s own + season prefixes -- but RG 109 privileges ONLY the September set (d), + leaving these two ordinary. 16 Dec 2026 is the Advent Ember Wednesday + (independently derived: Advent I 2026 is 29 Nov, +14 days = 13 Dec, + +3 = 16 Dec); the Lent Ember Wednesday is the same date [off (-39)] + already used by the entry-18 [band] row above. Both sourced from + [Temporal_ef.temporal]. If [privilege_of] relied on the season prefix + alone without excluding Ember slugs, both would wrongly come back + [Privileged] -- the exact trap this pair of rows guards against. *) + ( "boundary: an Advent Ember day is NOT privileged (only September is, \ + RG109(d))", + cand "ef-nativity", + of_temporal (mk 2026 12 16), + "Commemorate(Ordinary)" ); + ( "boundary: a Lent Ember day is NOT privileged (only September is, \ + RG109(d))", + cand "ef-nativity", + of_temporal (off (-39)), + "Commemorate(Ordinary)" ); + (* Negative, RG 109(f)'s own boundary: the Minor Litanies/Rogations + (Monday/Tuesday before Ascension, RG 87 -- [Temporal_ef.temporal] + DOES compute these, unlike the Major Litanies RG 109(f) actually + names, see [privilege_of]'s own comment) must NOT be mistaken for the + Major Rogations RG 109(f) privileges: RG 88 says the Minor Rogations + change nothing in the Office at all, so nothing about them is + privileged either. *) + ( "boundary: a Minor Rogation day is NOT privileged (RG109(f) names \ + the Major Litanies, not these)", + cand "ef-nativity", + of_temporal (off 36), + "Commemorate(Ordinary)" ) + ] + +(* Task 9: [PE.admit] -- RG 111's admission counts (register line 378), + given commemorations ALREADY tagged with their real privilege (as + [PE.disposition] now tags them -- see [privilege_cases] above). Every + candidate/privilege pair here is built directly, not routed through + [PE.disposition], so these rows isolate [admit]'s own selection logic + from [privilege_of]'s classification -- the two are proved separately by + design (unlike a test that only proves [admit] admits SOME correct-looking + set without knowing whether it or [privilege_of] supplied the "correct" + part). Checked on slug IDENTITY, not count (the brief: "'two admitted' + proves nothing about *which* two"). *) + +(* Class2 dignity, tagged [Ordinary] explicitly (not via [privilege_of]) -- + used as the higher-dignity, non-privileged half of every asymmetry pair + below. *) +let ordinary_hi = cand ~rank:V.Class2 "ef-ordinary-hi" + +(* Class3 dignity (LOWER than [ordinary_hi]), tagged [Privileged] explicitly + -- pairing a lower-dignity privileged candidate against a higher-dignity + ordinary one is what makes the II-class-Sunday-vs-other-II-class + asymmetry observable: pure dignity and "privilege wins the slot" pick + DIFFERENT winners from this exact pair. *) +let privileged_lo = cand ~rank:V.Class3 "ef-privileged-lo" + +(* Class2 dignity (tied with [ordinary_hi], distinguishing rank from + privilege alone), tagged [Privileged] -- the higher-dignity privileged + candidate for the "two privileged due" row. *) +let privileged_hi = cand ~rank:V.Class2 "ef-privileged-hi" + +(* Class4, the lowest dignity in play -- the third candidate for the + III/IV-class "at most two" row, so which TWO of three survive is the + thing under test, not merely how many. *) +let ordinary_lowest = cand ~rank:V.Class4 "ef-ordinary-lowest" + +let observed_class1 = cand "ef-nativity" (* Class1 by [cand]'s own default. *) +let observed_class2_sunday = an_ordinary_sunday (* Class2, slug carries "-sunday". *) +let observed_class2_other = cand ~rank:V.Class2 "ef-other-class2-day" (* Class2, no "-sunday". *) +let observed_class3 = cand ~rank:V.Class3 "ef-some-class3-day" + +let slugs_of admitted = + List.map (fun (c, _) -> S.to_string c.P.cel.Cel.slug) admitted + +let admit_cases = + [ (* RG 111 (register line 378): "I class: none save one privileged." *) + ( "I-class day, only an ordinary commemoration due -> none admitted", + observed_class1, + [ (ordinary_hi, P.Ordinary) ], + [] ); + ( "I-class day, ordinary + privileged both due -> only the privileged \ + one, regardless of the ordinary one's higher dignity", + observed_class1, + [ (ordinary_hi, P.Ordinary); (privileged_lo, P.Privileged) ], + [ "ef-privileged-lo" ] ); + ( "I-class day, two privileged due -> only the higher-dignity one (still \ + just \"one\")", + observed_class1, + [ (privileged_lo, P.Privileged); (privileged_hi, P.Privileged) ], + [ "ef-privileged-hi" ] ); + (* RG 111: "II-class Sundays: one (dropped if a privileged one is due)." *) + ( "II-class Sunday, only an ordinary commemoration due -> it is admitted", + observed_class2_sunday, + [ (ordinary_hi, P.Ordinary) ], + [ "ef-ordinary-hi" ] ); + ( "II-class Sunday, ordinary (higher dignity) + privileged (lower \ + dignity) both due -> the PRIVILEGED one is admitted, the ordinary \ + one dropped despite outranking it", + observed_class2_sunday, + [ (ordinary_hi, P.Ordinary); (privileged_lo, P.Privileged) ], + [ "ef-privileged-lo" ] ); + (* RG 111: "other II class: one" -- no privilege override, the exact + asymmetry the brief and precedence_ef.ml's own [admit] comment flag: + same candidate pair as the II-class-Sunday row above, OPPOSITE + observed day, OPPOSITE winner. *) + ( "other II-class day, only an ordinary commemoration due -> it is \ + admitted", + observed_class2_other, + [ (ordinary_hi, P.Ordinary) ], + [ "ef-ordinary-hi" ] ); + ( "other II-class day, same ordinary+privileged pair as the Sunday row \ + above -> the ORDINARY one wins on pure dignity this time, the \ + privileged one dropped", + observed_class2_other, + [ (ordinary_hi, P.Ordinary); (privileged_lo, P.Privileged) ], + [ "ef-ordinary-hi" ] ); + (* RG 111: "III-IV class: at most two" -- three candidates due, top two + by dignity admitted, the third (lowest dignity) dropped. *) + ( "III-class day, three commemorations due -> the top two by dignity, \ + not merely \"two of them\"", + observed_class3, + [ (ordinary_hi, P.Ordinary); (privileged_lo, P.Privileged); + (ordinary_lowest, P.Ordinary) ], + [ "ef-ordinary-hi"; "ef-privileged-lo" ] ) + ] + +(* Order independence (brief: "the admitted set must not depend on input + order"): the SAME three candidates as the III-class row above, passed in + the reverse order, must still admit the same top two -- exercised on this + row specifically because it is the one where the sort actually has work + to do (three distinct dignities, a real top-2 cut), unlike a + two-candidate row where either order already happens to be sorted. *) +let test_admit_order_independent () = + let comms = + [ (ordinary_hi, P.Ordinary); (privileged_lo, P.Privileged); (ordinary_lowest, P.Ordinary) ] + in + let forward = slugs_of (PE.admit ~observed:observed_class3 comms) in + let reversed = slugs_of (PE.admit ~observed:observed_class3 (List.rev comms)) in + Alcotest.(check (list string)) "reversed input admits the same candidates" + forward reversed + +(* The brief: "a case proving that what the limit drops is reported in + omitted rather than vanishing" -- three end-to-end proofs, wired with the + REAL [PE.band], [PE.disposition] and [PE.admit] together (not a stub, so + [privilege_of]'s real classification is exercised too, not just [admit]'s + selection logic in isolation as above). + + [rules] deliberately reused, not rebuilt per test, since it is always the + same three real functions. *) +let real_rules = { P.band = PE.band; disposition = PE.disposition; admit = PE.admit } + +(* I-class day, zero admitted: the strongest form of "does not vanish" -- + EVERY commemoration due is dropped (RG 111: "none save one privileged", + and the one loser here is ordinary), yet it must still appear in + [omitted], not merely be absent from [commemorations]. *) +let test_i_class_day_drops_into_omitted () = + let date = mk 2026 12 25 in + let day_ctx = ctx date in + let nativity = of_temporal date in + let saint = cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "ef-some-saint-3" in + let resolution = P.resolve real_rules day_ctx ~temporal:nativity ~sanctoral:[ saint ] in + Alcotest.(check (list string)) "nothing admitted on a I-class day with only an ordinary loser due" + [] (List.map (fun (c, _) -> S.to_string c.P.cel.Cel.slug) resolution.P.commemorations); + Alcotest.(check (list (pair string string))) "the ordinary loser is reported omitted, not vanished" + [ ("ef-some-saint-3", "omitted: admission limit reached") ] + (List.map (fun (c, reason) -> (S.to_string c.P.cel.Cel.slug, reason)) resolution.P.omitted) + +(* II-class Sunday, two ordinary losers due, RG 111's "one" admits the + higher-dignity one and drops the other into [omitted]. *) +let test_ii_class_sunday_drops_second_loser_into_omitted () = + let date = mk 2025 11 9 (* an ordinary Time-after-Pentecost Sunday, not All Souls-adjacent. *) in + let day_ctx = ctx date in + let sunday = + { P.cel = + Cel.make ~slug:(S.of_string_exn "ef-time-after-pentecost-sunday-x") ~rank:V.Class2 + ~colour:Col.Green ~subject:Sub.Temporal ~layer:"temporal" (); + origin = P.Temporal } + in + let saint_a = cand ~origin:P.Sanctoral ~rank:V.Class2 ~layer:PE.universal_layer "ef-some-saint" in + let saint_b = cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "ef-some-saint-3" in + let resolution = P.resolve real_rules day_ctx ~temporal:sunday ~sanctoral:[ saint_a; saint_b ] in + Alcotest.(check (list string)) "only the higher-dignity (Class2) loser is admitted" + [ "ef-some-saint" ] + (List.map (fun (c, _) -> S.to_string c.P.cel.Cel.slug) resolution.P.commemorations); + Alcotest.(check (list (pair string string))) "the lower-dignity loser is reported omitted, not vanished" + [ ("ef-some-saint-3", "omitted: admission limit reached") ] + (List.map (fun (c, reason) -> (S.to_string c.P.cel.Cel.slug, reason)) resolution.P.omitted) + +(* A genuinely privileged commemoration reaching [admit] through the REAL + pipeline (register RG 109(e)): a Lent feria (Class3, temporal-origin) + loses to a universal Class2 sanctoral feast on the same date, and + [PE.disposition] tags it [Privileged] via [privilege_of] -- proving + [privilege_of] and [admit] cooperate correctly end-to-end, not merely in + the hand-tagged unit tests above. *) +let test_privileged_lent_feria_admitted_end_to_end () = + let date = off (-41) (* Lent I Monday, the same date the entry-22 [band] row uses. *) in + let day_ctx = ctx date in + let lent_feria = of_temporal date in + let saint = cand ~origin:P.Sanctoral ~rank:V.Class2 ~layer:PE.universal_layer "ef-some-saint" in + let resolution = P.resolve real_rules day_ctx ~temporal:lent_feria ~sanctoral:[ saint ] in + Alcotest.(check string) "the Lent feast wins the day, not the sanctoral feast's own commemoration" + "ef-some-saint" (S.to_string resolution.P.observed.P.cel.Cel.slug); + Alcotest.(check (list (pair string string))) "the Lent feria is admitted, tagged Privileged" + [ ("ef-lent-1-monday", "Privileged") ] + (List.map + (fun (c, p) -> (S.to_string c.P.cel.Cel.slug, match p with P.Privileged -> "Privileged" | P.Ordinary -> "Ordinary")) + resolution.P.commemorations); + Alcotest.(check int) "nothing omitted" 0 (List.length resolution.P.omitted) + (* Completes Task 7's carried fix (register line 334): on a real Sunday landing on 2 November, All Souls does not merely lose (that was Task 7's [band] fix, proved by [test_all_souls_yields_to_sunday] above) -- it must @@ -426,7 +708,27 @@ let suite = Alcotest.(check string) desc expect (string_of_disposition (PE.disposition ~winner ~loser)))) disposition_cases + @ List.map + (fun (desc, winner, loser, expect) -> + Alcotest.test_case desc `Quick (fun () -> + Alcotest.(check string) desc expect + (string_of_disposition (PE.disposition ~winner ~loser)))) + privilege_cases @ [ Alcotest.test_case "All Souls disposition is Transfer" `Quick test_all_souls_disposition_is_transfer; Alcotest.test_case "All Souls transfers end-to-end (resolve, real rules)" `Quick - test_all_souls_transfers_end_to_end ] ) + test_all_souls_transfers_end_to_end ] + @ List.map + (fun (desc, observed, comms, expect) -> + Alcotest.test_case desc `Quick (fun () -> + Alcotest.(check (list string)) desc expect + (slugs_of (PE.admit ~observed comms)))) + admit_cases + @ [ Alcotest.test_case "admit is order-independent (III-class, 3 candidates)" `Quick + test_admit_order_independent; + Alcotest.test_case "I-class day: full drop reported in omitted, not vanished" `Quick + test_i_class_day_drops_into_omitted; + Alcotest.test_case "II-class Sunday: second loser dropped into omitted" `Quick + test_ii_class_sunday_drops_second_loser_into_omitted; + Alcotest.test_case "RG109(e) Lent feria privileged end-to-end" `Quick + test_privileged_lent_feria_admitted_end_to_end ] ) |