From 7d3b5ec831a60e8b63466251d63b2bd564acba2b Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 12 Aug 2026 13:32:13 +0200 Subject: fix(rite-ef,kernel): follow the oracle on the Purification; admit reads the day's own Sunday-ness, not observed Fix round 1 review, two findings landed together because each golden pin's correctness depends on both. CRITICAL (item 1): reverts this branch's own first-pass retag of the Purification (2 February) from Lord back to Bvm -> Lord. The calendarium titles it 'B. Mariae Virg.', but missalemeum -- this project's designated EF oracle -- treats it as taking an occurring II-class Sunday's place outright, commemorations empty, exactly RG16(a)'s own festum Domini treatment (2020-02-02, 2014-02-02, independently fetched). Control, 2019-09-08 (the Nativity of the BVM, an ordinary Marian feast, on a Sunday): the Sunday observed, the feast merely commemorated -- the opposite pattern, proving the Purification's own oracle treatment is deliberate, not a gap. RG16(a) alone, on the untouched data, would have matched the oracle character for character; retagging Bvm is what moved colitur away from it on 1200 domain-wide days. The user has ruled: follow the oracle. Genuine primary-text counter-evidence (RG120(b), the colour rule grouping 2 February under 'B. Mariae Virg.', a category separate from 'Domini') is recorded in the register, not discarded -- a different project could reasonably rule the other way on the same evidence. most-holy-name-of-mary stays retagged Bvm; that one was never disputed. Removes the now-unneeded C12 lectio allow-list entry (data/ef/ expected-divergences.sexp, test_differential.ml): with the Purification Lord again, colitur matches lectio's own class = lord on every affected date, no divergence to allow-list. IMPORTANT (item 2): Precedence.rules.admit gains a ~temporal parameter -- a genuine kernel signature change, unlike RG16(a) itself. RG111(b)'s own Sunday rank floor ('one commemoration, namely of a II-class feast') used to be detected by reading observed's own slug for a Sunday marker, which silently assumed observed IS the day's temporal-cycle office. RG16(a) breaks that assumption on purpose: a Feast of the Lord standing in for an impeded Sunday 'cum omnibus iuribus et privilegiis' keeps the day a dominica II classis for RG111(b) too, even though the FEAST, not the Sunday, is observed. Before this fix an unrelated saint (Pope Sixtus II et al., 6 August, Class3) was wrongly admitted into the freed slot on every one of 1178 domain-wide days. Oracle-confirmed directly: 2023-08-06 (a Sunday) shows him displaced, commemorations empty; 2026-08-06 (an ordinary Thursday) shows him admitted -- being a Sunday is exactly what excludes him. admit now reads Sunday-ness off ~temporal (the day's own temporal-cycle candidate, passed through from Precedence.resolve unchanged) instead of observed. Validate's own admission fixed-point invariant updated to pass the same real temporal candidate through. Both golden pins in test_golden.ml were promoted from actual colitur day output without independently consulting the rubric or the oracle first -- a real defect the review caught. Re-derived from both before re-pinning: 2028-08-06 and 2025-02-02 now pin comms=[], no commemoration at all, matching missalemeum exactly in both cases. --- lib/kernel/precedence.mli | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) (limited to 'lib/kernel/precedence.mli') diff --git a/lib/kernel/precedence.mli b/lib/kernel/precedence.mli index ae054dd..d394cb1 100644 --- a/lib/kernel/precedence.mli +++ b/lib/kernel/precedence.mli @@ -34,12 +34,28 @@ type ('s, 'r) rules = { (** RG 92-95: the loser's fate, which depends on the loser's own rank. *) admit : observed:'r candidate -> + temporal:'r candidate -> ('r candidate * privilege) list -> ('r candidate * privilege) list; (** RG 108-111: how many commemorations are admitted, and in what order; anything filtered out here is recorded in {!resolution.omitted}, not dropped. + [temporal] is {!resolve}'s own [~temporal] argument, passed through + unchanged -- the day's temporal-cycle candidate, regardless of + whether it won. Fix round 1 (RG16(a) task): before this, a rite's + [admit] could only infer properties of the CIVIL DAY (chiefly "is + this a Sunday", RG 111(b)'s own two-tier admission rule) from + [observed]'s own fields -- a proxy that breaks the moment something + OTHER than the day's own temporal candidate can be [observed], the + exact shape RG 16(a) introduces (a Feast of the Lord standing in + the impeded Sunday's place "cum omnibus iuribus et privilegiis", + RG 91 entry 14). This is NOT a kernel definition of "Sunday" -- + the kernel does not gain any rite-specific knowledge by this + parameter, it only threads through a value {!resolve} already + holds; a rite's own [admit] is free to ignore it entirely, the + same as [observed]. + OBLIGATION ON THE IMPLEMENTATION, not enforced by this type: every candidate this function returns must be a value taken UNCHANGED from its input list, never rebuilt (e.g. via a [{ c with ... }] -- cgit v1.3 From ea22ad2bde211998e6719fd5fb76233571a48383 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 12 Aug 2026 15:16:00 +0200 Subject: fix(kernel,rite-ef): admit orders commemorations by RG 113's table of precedence, not slug Precedence_ef.admit broke a same-rank tie among commemoration candidates alphabetically by slug -- a deterministic engineering convention with no rubrical citation. RG 113's own second sentence, primary-source-verified against two independent scans and previously uncited in the register (only "commemoratio de Tempore fit primo loco" was quoted before), gives the real rule: "in admittendis et ordinandis aliis commemorationibus, servetur ordo tabellae praecedentiae" -- admitting and ordering commemorations both run on the rite's own table of precedence (band's 28-entry table), not RG 8's coarse four-class rank. Precedence.resolve now computes each commemoration candidate's own band value once, generically, and hands it to rules.admit as a third tuple element (Precedence.rules.admit's signature changed accordingly, ditto Precedence_ef.admit; every rule-record stub in the test suite updated to match). Precedence_ef.admit's own compare_dignity is replaced by compare_precedence, ordering by band then slug; a residual tie within one identical band value still falls back to slug, since RG 113 gives no further instruction there -- documented as a still-uncited engineering convention, not dressed up as a rubric. RG 98 ("in paritate autem Officium prius impeditum praecedit") was considered as a candidate authority for that residual and rejected: it governs the transfer queue order among several simultaneously-impeded I-class feasts (Caput XIII), a different operation in a different chapter from RG 113's commemoration admission (Caput XVI); nothing in the primary text connects the two. Blast radius measured against the pre-change binary across the entire 1583-9999 domain (not only 2005-2050): the admitted-commemoration-slug set is byte-identical, day for day, before and after this change. The fix corrects the citation and mechanism, not the answer, on this codebase's current data -- both of the task brief's named examples (22 Feb Chair-of-Peter/Lent-vs-Paul, 22 Sept Maurice-vs-Thomas-of- Villanova) are confirmed present and unchanged in both streams. A new test (RG113: admit picks by precedence order, not slug, when they disagree) proves admit actually consults the passed-in precedence value with a synthetic pair whose slug order and precedence order disagree -- teeth a same-band-only regression test could not have caught, since every real collision found in the domain happens to agree on both axes. 271 -> 272 tests, all green; COLITUR_EXHAUSTIVE_SWEEP=1 unaffected. --- lib/kernel/precedence.ml | 21 ++++++- lib/kernel/precedence.mli | 15 ++++- lib/kernel/validate.ml | 26 +++++++- lib/rites/rite_ef/precedence_ef.ml | 116 ++++++++++++++++++++---------------- lib/rites/rite_ef/precedence_ef.mli | 58 +++++++++++------- test/test_calendar.ml | 5 +- test/test_precedence.ml | 4 +- test/test_precedence_ef.ml | 85 +++++++++++++++++++++----- test/test_validate.ml | 15 +++-- 9 files changed, 245 insertions(+), 100 deletions(-) (limited to 'lib/kernel/precedence.mli') diff --git a/lib/kernel/precedence.ml b/lib/kernel/precedence.ml index d48203e..2c55817 100644 --- a/lib/kernel/precedence.ml +++ b/lib/kernel/precedence.ml @@ -18,8 +18,13 @@ type ('s, 'r) rules = { admit : observed:'r candidate -> temporal:'r candidate -> - ('r candidate * privilege) list -> + ('r candidate * privilege * int) list -> ('r candidate * privilege) list; + (** the trailing [int] on each input triple is that candidate's own + [band] value, computed once by {!resolve} below (a rite's [admit] + has no [context] of its own to compute it with) -- see [resolve]'s + own comment for why this is a KERNEL-level policy, not a rite- + specific rule threaded in as data. *) } type 'r resolution = { @@ -56,7 +61,19 @@ let resolve rules ctx ~temporal ~sanctoral = ([], [], []) losers in let comms = List.rev comms and deferred = List.rev deferred in - let admitted = rules.admit ~observed ~temporal comms in + (* RG 113 (EF; docs/research/rules-register.md §4 "Commemorations"): "in + admittendis et ordinandis aliis commemorationibus, servetur ordo + tabellae praecedentiae" -- admitting AND ordering commemorations both + run on the rite's own table of precedence, the same [band] already + used above to pick [observed]. Computed here, once, generically (a + rite's own [admit] has no [ctx] of its own to call [band] with) rather + than inside every rite's [admit] separately -- a kernel-level POLICY + ("commemorations are ordered by the rite's own band"), not a + rite-specific RULE baked into the kernel: the actual [band] function, + and whether a rite's [admit] even uses the value it is handed, both + stay entirely rite-supplied. *) + let comms_by_precedence = List.map (fun (c, p) -> (c, p, rules.band ctx c)) comms in + let admitted = rules.admit ~observed ~temporal comms_by_precedence in let dropped = List.filter (fun c -> not (List.exists (fun a -> fst a == fst c) admitted)) comms in diff --git a/lib/kernel/precedence.mli b/lib/kernel/precedence.mli index d394cb1..09376d7 100644 --- a/lib/kernel/precedence.mli +++ b/lib/kernel/precedence.mli @@ -35,12 +35,25 @@ type ('s, 'r) rules = { admit : observed:'r candidate -> temporal:'r candidate -> - ('r candidate * privilege) list -> + ('r candidate * privilege * int) list -> ('r candidate * privilege) list; (** RG 108-111: how many commemorations are admitted, and in what order; anything filtered out here is recorded in {!resolution.omitted}, not dropped. + Each input triple's trailing [int] is that candidate's own {!band} + value, computed once by {!resolve} (RG 113: "in admittendis et + ordinandis aliis commemorationibus, servetur ordo tabellae + praecedentiae" -- ADMITTING and ORDERING commemorations is governed + by the same table-of-precedence order {!band} already supplies for + picking the day's own winner; docs/research/rules-register.md §4 + "Commemorations"). Supplied rather than left for [admit] to compute + itself because [admit] has no [context] (date/season/weekday) of + its own -- {!resolve} already holds one and calls {!band} with it + for every candidate regardless. A rite's [admit] is free to ignore + the value entirely (e.g. fall back to [Vocab.rank] alone), the same + as it may ignore [temporal] below. + [temporal] is {!resolve}'s own [~temporal] argument, passed through unchanged -- the day's temporal-cycle candidate, regardless of whether it won. Fix round 1 (RG16(a) task): before this, a rite's diff --git a/lib/kernel/validate.ml b/lib/kernel/validate.ml index a3208dd..433dc99 100644 --- a/lib/kernel/validate.ml +++ b/lib/kernel/validate.ml @@ -315,8 +315,29 @@ let run (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) ~year = { Precedence.cel = d.Liturgical_day.temporal.Temporal.office; origin = Precedence.Temporal } in + (* [band]'s own [context] (RG 113, docs/research/rules-register.md + §4 "Commemorations" -- {!Precedence.rules.admit}'s own new + [int] parameter, added alongside RG 113's fix: [admit] now + orders/selects by the rite's table-of-precedence value + {!resolve} attaches to each candidate, not by [Vocab.rank] + alone). Reconstructed from {!Liturgical_day.t}'s own embedded + [Temporal.t], the same source [temporal_candidate] above + already draws its [cel] from, so this is the exact [ctx] + {!Calendar} passed to {!Precedence.resolve} for this date in + the first place, not a re-derivation that could itself drift. *) + let day_ctx : 's Precedence.context = + { Precedence.date; + season = d.Liturgical_day.temporal.Temporal.season; + weekday = d.Liturgical_day.temporal.Temporal.weekday } + in let as_candidates comms = - List.map (fun (c, p) -> ({ Precedence.cel = c; origin = Precedence.Sanctoral }, p)) comms + List.map + (fun (c, p) -> + let cand : 'r Precedence.candidate = + { Precedence.cel = c; origin = Precedence.Sanctoral } + in + (cand, p, rite.Rite.rules.Precedence.band day_ctx cand)) + comms in let offered = as_candidates d.Liturgical_day.commemorations in let readmitted = @@ -327,7 +348,8 @@ let run (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) ~year = List.map (fun (c, p) -> (Slug.to_string c.Precedence.cel.Celebration.slug, p)) l |> List.sort compare in - if norm readmitted <> norm offered then + let offered_pairs = List.map (fun (c, p, _) -> (c, p)) offered in + if norm readmitted <> norm offered_pairs then fail date "admission" (Printf.sprintf "admit is not a fixed point on this day's own commemorations: re-offering %d \ diff --git a/lib/rites/rite_ef/precedence_ef.ml b/lib/rites/rite_ef/precedence_ef.ml index 5688640..861bb1a 100644 --- a/lib/rites/rite_ef/precedence_ef.ml +++ b/lib/rites/rite_ef/precedence_ef.ml @@ -758,38 +758,47 @@ let disposition ~(winner : Vocab_ef.rank Precedence.candidate) carries everything this split needs, the same way [observed]'s used to before a competing office could occupy the Sunday's place. *) -(* 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 +(* RG 113 -- CORRECTED, Task B (branch ef-rg16a): docs/research/rules- + register.md §4's RG 113 entry previously quoted only its FIRST sentence + ("commemoratio de Tempore fit primo loco"); its SECOND, load-bearing + sentence, primary-source-verified against two independent scans, is the + real rule for this function: *"In admittendis et ordinandis aliis + commemorationibus, servetur ordo tabellae praecedentiae"* -- in ADMITTING + and ORDERING the other commemorations, the order of the table of + precedence (RG 91, {!band}'s own 28-entry table) is to be kept. + + This REPLACES a previous [compare_dignity], which sorted by RG 8's coarse + four-class [rank] ("dignity") and broke same-rank ties alphabetically by + slug -- an engineering convention with no rubrical warrant, silently + deciding 66 days over 2005-2050 (e.g. 22 Sept 2027, an Ember Wednesday: + the alphabetical rule admitted "maurice-and-companions-martyrs" over + "thomas-of-villanova", both Class3/{!band} entry 24 -- missalemeum shows + Thomas). {!band} needs a [context] this function itself does not have + (date/season/weekday) -- unlike [dignity], which read [rank] alone -- + so {!Precedence.resolve} now computes each candidate's own [band] value + once, generically, and hands it to [admit] as the trailing [int] on each + input triple (see {!Precedence.rules.admit}'s own doc). [comms] below is + [(candidate * privilege * int) list], not the pair it used to be. *) +let compare_precedence (a, _, ba) (b, _, bb) = + if ba <> bb then Int.compare (ba : int) bb 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 +(* [comms]'s own candidate/privilege pair, its [band] value dropped once a + selection has been made -- {!Precedence.rules.admit}'s return type is + still the pair, not the triple; only the INPUT carries [band]. *) +let drop_band (c, p, (_ : int)) = (c, p) + let admit ~(observed : Vocab_ef.rank Precedence.candidate) ~(temporal : Vocab_ef.rank Precedence.candidate) - (comms : (Vocab_ef.rank Precedence.candidate * Precedence.privilege) list) : + (comms : (Vocab_ef.rank Precedence.candidate * Precedence.privilege * int) 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 + (* Sorted once, by {!band} then slug (see [compare_precedence]); every + branch below either takes a prefix of this list or filters it, so the + RESULT is always built from [comms]'s own 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 @@ -801,9 +810,11 @@ let admit ~(observed : Vocab_ef.rank Precedence.candidate) celebration would surface TWICE in the same day -- once in [commemorations] (the rebuilt copy) and once in [omitted] (the original, which nothing admitted matches). One admission, double-reported, and no - crash to announce it, which is exactly why this comment exists. *) - let sorted = List.stable_sort compare_dignity comms in - let is_privileged (_, p) = p = Precedence.Privileged in + crash to announce it, which is exactly why this comment exists. + [drop_band] only unwraps the pair back out of the triple -- it does not + rebuild [c] or [p] themselves, so this obligation still holds. *) + let sorted = List.stable_sort compare_precedence comms in + let is_privileged (_, p, _) = p = Precedence.Privileged in let observed_rank = observed.Precedence.cel.Celebration.rank in (* CORRECTED (fix round 1, RG16(a) task): read off [temporal], not [observed] -- see this function's own doc comment above for the full @@ -819,9 +830,9 @@ let admit ~(observed : Vocab_ef.rank Precedence.candidate) | 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 ]) + due; at most one privileged one does, the highest-precedence one + (RG 113: {!band}'s own table order) if several are. *) + (match List.filter is_privileged sorted with [] -> [] | best :: _ -> [ drop_band best ]) | Class2, true -> (* RG 111(b), primary text, RE-VERIFIED word for word against the scan (final fix wave; this sentence is the sole textual basis for the @@ -835,17 +846,18 @@ let admit ~(observed : Vocab_ef.rank Precedence.candidate) dropped if a privileged commemoration is due." Two clauses, not one: (i) a privileged commemoration, whenever due, categorically takes the day's one slot - -- not by comparing its dignity against the ordinary contender's, + -- not by comparing its precedence against the ordinary contender's, so an ordinary commemoration that would otherwise win on raw - dignity is still dropped once any privileged one is also due (the - asymmetric clause the brief and task report flag as deliberate, not - present at "other II class" below); (ii) failing that, the slot is - reserved SPECIFICALLY for a [Class2] candidate -- "de festo II - classis" is a RANK restriction, not merely "whichever ordinary - candidate has the best dignity": a III- or IV-class ordinary loser - (a plain commemoration-only saint with no privilege of its own) has - NO standing for this slot at all and must be entirely omitted, even - when it is the only candidate present. + table order is still dropped once any privileged one is also due + (the asymmetric clause the brief and task report flag as + deliberate, not present at "other II class" below); (ii) failing + that, the slot is reserved SPECIFICALLY for a [Class2] candidate -- + "de festo II classis" is a RANK restriction, not merely "whichever + ordinary candidate has the best table position": a III- or + IV-class ordinary loser (a plain commemoration-only saint with no + privilege of its own) has NO standing for this slot at all and + must be entirely omitted, even when it is the only candidate + present. Fix, Task 16 (primary-source-verified + missalemeum-confirmed): previously this fell back to "the best of [sorted], whatever its @@ -857,21 +869,21 @@ let admit ~(observed : Vocab_ef.rank Precedence.candidate) shows him "displaced" (omitted), never commemorated; the pre-fix code admitted him regardless. *) (match List.filter is_privileged sorted with - | best :: _ -> [ best ] + | best :: _ -> [ drop_band best ] | [] -> ( - match List.filter (fun (c, _) -> c.Precedence.cel.Celebration.rank = Class2) sorted with + match List.filter (fun (c, _, _) -> c.Precedence.cel.Celebration.rank = Class2) sorted with | [] -> [] - | best :: _ -> [ best ])) + | best :: _ -> [ drop_band 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 ]) + goes to whichever candidate outranks the rest by RG 113's own + table-of-precedence order ({!band}), privileged or not. *) + (match sorted with [] -> [] | best :: _ -> [ drop_band 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 + (* RG 111: "III-IV class: at most two" -- by RG 113's table order, same + as the non-Sunday II-class case, just with room for two. *) + List.map drop_band (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 @@ -884,9 +896,11 @@ let admit ~(observed : Vocab_ef.rank Precedence.candidate) 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]). *) + RG 96 speaks of the day's CLASS (RG 8's four-way "dignity"), not [band]'s + finer 28-entry occurrence-table row -- unlike {!admit} above, which (RG + 113, Task B/ef-rg16a) now DOES use [band] itself for its own selection + order; RG 96's own text has no such finer-table reading, so [is_blocking] + stays on [Vocab_ef.rank] alone. *) 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, diff --git a/lib/rites/rite_ef/precedence_ef.mli b/lib/rites/rite_ef/precedence_ef.mli index ee7667d..49195f9 100644 --- a/lib/rites/rite_ef/precedence_ef.mli +++ b/lib/rites/rite_ef/precedence_ef.mli @@ -166,33 +166,49 @@ val september_ember_prefix : string (** [admit ~observed ~temporal comms]: RG 108-111 (docs/research/rules-register.md §4, "Commemorations"). 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: + its real RG 109 privilege by {!disposition}, and its own {!band} value + (RG 91's table-of-precedence entry, computed once by + {!Precedence.resolve} -- see {!Precedence.rules.admit}'s own doc) -- 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; + commemoration (the highest-{!band}-precedence one, if several are + due) -- an ordinary one is never admitted here, no matter how many + are due; - the CIVIL DAY is a [Class2] Sunday ([temporal]'s slug carries {!sunday_marker} -- CORRECTED, fix round 1, RG16(a) task: read off [temporal], not [observed]; see below): one, subject to TWO conditions, not one -- (i) a privileged commemoration, whenever due, categorically takes the day's one slot over any ordinary one, not by - comparing dignity, so an ordinary commemoration that would otherwise - win on dignity is still dropped; (ii) failing that, the slot is - reserved for a [Class2] candidate SPECIFICALLY ("de festo II classis", - RG 111(b)'s own wording -- a RANK FLOOR, not "whichever ordinary - candidate has the best dignity"): a III- or IV-class ordinary loser - has no standing for this slot at all and is admitted nothing, even - when it is the only candidate due; - - the civil day is any other [Class2] day: one, by dignity alone -- no - privilege override and no rank floor, unlike the Sunday case - immediately above; - - [observed] a [Class3] or [Class4] day: at most two, by dignity alone. + comparing table position, so an ordinary commemoration that would + otherwise win on table order is still dropped; (ii) failing that, the + slot is reserved for a [Class2] candidate SPECIFICALLY ("de festo II + classis", RG 111(b)'s own wording -- a RANK FLOOR, not "whichever + ordinary candidate has the best table position"): a III- or IV-class + ordinary loser has no standing for this slot at all and is admitted + nothing, even when it is the only candidate due; + - the civil day is any other [Class2] day: one, by {!band}'s table order + alone -- no privilege override and no rank floor, unlike the Sunday + case immediately above; + - [observed] a [Class3] or [Class4] day: at most two, by {!band}'s table + order 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. + CORRECTED, Task B (branch ef-rg16a): this used to sort by + [Vocab_ef.rank] (RG 8's coarse four-class "dignity") and break same-rank + ties alphabetically by slug -- an engineering convention with no + rubrical warrant, cited nowhere, silently deciding 66 days over + 2005-2050. RG 113's own second sentence, previously uncited + (docs/research/rules-register.md §4's RG 113 entry), is the real rule: + *"in admittendis et ordinandis aliis commemorationibus, servetur ordo + tabellae praecedentiae"* -- admitting and ordering commemorations both + run on {!band}'s own finer RG 91 table, not RG 8's four classes. + {!band} needs a [context] (date/season/weekday) this function does not + receive on its own, so {!Precedence.resolve} computes it once, + generically, and hands each candidate its own value as the trailing + [int] on [comms]'s triples (see {!Precedence.rules.admit}). Ties break + on slug ONLY within one identical [band] value (RG 113 gives no further + instruction there; still an uncited engineering convention, register §6 + "RG 113 tie-break"), matching {!Precedence.compare_by}'s own fallback, + so the result never depends on the order [comms] arrives in. [temporal] -- CORRECTED, fix round 1 (RG16(a) task): this function used to read the Sunday/non-Sunday split off [observed]'s own slug, which @@ -219,7 +235,7 @@ val september_ember_prefix : string val admit : observed:Vocab_ef.rank Precedence.candidate -> temporal:Vocab_ef.rank Precedence.candidate -> - (Vocab_ef.rank Precedence.candidate * Precedence.privilege) list -> + (Vocab_ef.rank Precedence.candidate * Precedence.privilege * int) list -> (Vocab_ef.rank Precedence.candidate * Precedence.privilege) list (** The Annunciation's own bootstrapped slug (data/ef/sanctoral.sexp, Task diff --git a/test/test_calendar.ml b/test/test_calendar.ml index 8770017..93cd0bb 100644 --- a/test/test_calendar.ml +++ b/test/test_calendar.ml @@ -82,7 +82,10 @@ module Fixture = struct test below a genuine Precedence-native omission (distinct from a deferred one) to exercise. *) let rules : (season, rank) P.rules = - { P.band; disposition; admit = (fun ~observed:_ ~temporal:_ cs -> List.filteri (fun i _ -> i < 1) cs) } + { P.band; disposition; + admit = + (fun ~observed:_ ~temporal:_ cs -> + List.filteri (fun i _ -> i < 1) cs |> List.map (fun (c, p, (_ : int)) -> (c, p))) } (* RG 96, generic form: search forward from the day after [origin] for the first day whose occupant is not "blocking" -- in this synthetic diff --git a/test/test_precedence.ml b/test/test_precedence.ml index ff75baa..ce75ab6 100644 --- a/test/test_precedence.ml +++ b/test/test_precedence.ml @@ -26,7 +26,9 @@ let rules = | Cel.Feast -> (match loser.P.cel.Cel.rank with | Hi -> P.Transfer | Lo -> P.Commemorate P.Ordinary)); - admit = (fun ~observed:_ ~temporal:_ cs -> List.filteri (fun i _ -> i < 2) cs) } + admit = + (fun ~observed:_ ~temporal:_ cs -> + List.filteri (fun i _ -> i < 2) cs |> List.map (fun (c, p, (_ : int)) -> (c, p))) } let slug_of c = S.to_string c.P.cel.Cel.slug diff --git a/test/test_precedence_ef.ml b/test/test_precedence_ef.ml index 8465870..ca623d2 100644 --- a/test/test_precedence_ef.ml +++ b/test/test_precedence_ef.ml @@ -290,7 +290,7 @@ let test_all_souls_yields_to_sunday () = let rules = { P.band = (fun c cd -> PE.band c cd); disposition = (fun ~winner:_ ~loser:_ -> P.Omit); - admit = (fun ~observed:_ ~temporal:_ cs -> cs) } + admit = (fun ~observed:_ ~temporal:_ cs -> List.map (fun (c, p, (_ : int)) -> (c, p)) cs) } in let resolution = P.resolve rules day_ctx ~temporal:sunday ~sanctoral:[ all_souls ] in Alcotest.(check string) "the Sunday is observed, not All Souls" @@ -822,6 +822,22 @@ 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 +(* [admit_cases] below (Task B, ef-rg16a) needs a precedence-order [int] on + every comms triple -- {!Precedence.rules.admit}'s new parameter, RG 113 + (docs/research/rules-register.md §4, "RG 113"). This table's own header + comment states its purpose: isolate [admit]'s own selection/count logic + from {!PE.band}'s occurrence-table classification, so every candidate + here is built from a synthetic slug ("ef-ordinary-hi" etc.) that matches + none of [band]'s 28 real branches -- calling the REAL [PE.band] on them + would collapse every one to {!PE.unclassified} (the same tied value), + destroying the table's ability to distinguish rows at all. [order_of_rank] + is a TEST-ONLY stand-in, reproducing exactly the relative order the + previous [dignity] function gave (RG 8's rank cardinal, lower first) -- + so every existing expectation below still holds unchanged; only the + tuple shape gained this third field. *) +let order_of_rank = function V.Class1 -> 10 | V.Class2 -> 20 | V.Class3 -> 30 | V.Class4 -> 40 +let po c p = (c, p, order_of_rank c.P.cel.Cel.rank) + (* Real-data shapes for the fix round's own RG16(a)/[admit] interaction (below): a Feast of the Lord (subject Lord, Class2, sanctoral) as [observed], oracle-confirmed real slugs/ranks rather than hand-typed @@ -853,28 +869,28 @@ let admit_cases = [ (* RG 111 (§4): "I class: none save one privileged." *) ( "I-class day, only an ordinary commemoration due -> none admitted", observed_class1, observed_class1, - [ (ordinary_hi, P.Ordinary) ], + [ po 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, observed_class1, - [ (ordinary_hi, P.Ordinary); (privileged_lo, P.Privileged) ], + [ po ordinary_hi P.Ordinary; po privileged_lo P.Privileged ], [ "ef-privileged-lo" ] ); ( "I-class day, two privileged due -> only the higher-dignity one (still \ just \"one\")", observed_class1, observed_class1, - [ (privileged_lo, P.Privileged); (privileged_hi, P.Privileged) ], + [ po privileged_lo P.Privileged; po 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, observed_class2_sunday, - [ (ordinary_hi, P.Ordinary) ], + [ po 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, observed_class2_sunday, - [ (ordinary_hi, P.Ordinary); (privileged_lo, P.Privileged) ], + [ po ordinary_hi P.Ordinary; po privileged_lo P.Privileged ], [ "ef-privileged-lo" ] ); (* RG 111(b)'s own rank floor ("scilicet DE FESTO II CLASSIS"), fix round 1 F7: a Class3 ORDINARY candidate -- no privileged rival due, @@ -886,7 +902,7 @@ let admit_cases = ( "II-class Sunday, sole candidate is an ORDINARY Class3 (not \ \"de festo II classis\") -> admitted nothing, not the best available", observed_class2_sunday, observed_class2_sunday, - [ (ordinary_class3, P.Ordinary) ], + [ po ordinary_class3 P.Ordinary ], [] ); (* RG 111: "other II class: one" -- no privilege override, the exact asymmetry the brief and precedence_ef.ml's own [admit] comment flag: @@ -895,21 +911,21 @@ let admit_cases = ( "other II-class day, only an ordinary commemoration due -> it is \ admitted", observed_class2_other, observed_class2_other, - [ (ordinary_hi, P.Ordinary) ], + [ po 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, observed_class2_other, - [ (ordinary_hi, P.Ordinary); (privileged_lo, P.Privileged) ], + [ po ordinary_hi P.Ordinary; po 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, observed_class3, - [ (ordinary_hi, P.Ordinary); (privileged_lo, P.Privileged); - (ordinary_lowest, P.Ordinary) ], + [ po ordinary_hi P.Ordinary; po privileged_lo P.Privileged; + po ordinary_lowest P.Ordinary ], [ "ef-ordinary-hi"; "ef-privileged-lo" ] ); (* Fix round 1, item 2 (RG16(a) task review): the CRITICAL witness for [~temporal]. RG 16(a)'s own text -- the winning Feast of the Lord @@ -928,7 +944,7 @@ let admit_cases = TEMPORAL candidate is a II-class Sunday -> the RG111(b) rank floor \ still applies, admits nothing (Sixtus, Class3, has no standing)", lord_winner, an_ordinary_sunday, - [ (sixtus, P.Ordinary) ], + [ po sixtus P.Ordinary ], [] ); (* The control, same pair as the row above with [observed] = [temporal] (no displacement -- an ordinary WEEKDAY, not a Sunday): "other II @@ -941,7 +957,7 @@ let admit_cases = = observed, not a Sunday) -> \"other II class: one\", Sixtus IS \ admitted", lord_winner, lord_winner, - [ (sixtus, P.Ordinary) ], + [ po sixtus P.Ordinary ], [ "pope-sixtus-ii-felicissimus-and-agapitus-martyrs" ] ) ] @@ -953,7 +969,7 @@ let admit_cases = 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) ] + [ po ordinary_hi P.Ordinary; po privileged_lo P.Privileged; po ordinary_lowest P.Ordinary ] in let forward = slugs_of (PE.admit ~observed:observed_class3 ~temporal:observed_class3 comms) in let reversed = @@ -962,6 +978,39 @@ let test_admit_order_independent () = Alcotest.(check (list string)) "reversed input admits the same candidates" forward reversed +(* RG 113 teeth (Task B, ef-rg16a): two SAME-rank candidates whose slug order + DISAGREES with their band/precedence order -- "aa-worse-precedence" sorts + first alphabetically but is given the WORSE (higher) precedence int, + "zz-better-precedence" sorts last alphabetically but the BETTER (lower) + one. Both are [Class3] (same RG 8 "dignity", so a version of [admit] that + silently reverted to sorting by [rank] then slug -- the exact pre-fix + shape this task replaced -- would pick "aa-worse-precedence" here, the + OPPOSITE of what this asserts. A real RG 91 [band] value never actually + produces this exact pairing against these two synthetic slugs (see + [admit_cases]'s own header on why this table uses synthetic, non-band- + classifiable slugs) -- the precedence ints are supplied directly, the + same [po]/explicit-order convention this file already uses, standing in + for whatever real [band] would compute. This is what proves [admit] + actually consults the passed-in precedence value rather than merely + accepting one as a matter of new type-checking. *) +let order_tiebreak_alpha_first_worse = cand ~rank:V.Class2 "aa-worse-precedence" +let order_tiebreak_alpha_last_better = cand ~rank:V.Class2 "zz-better-precedence" + +(* [observed_class2_other]: "other II class: one" admits exactly ONE, by + precedence order alone (no privilege override, no rank floor) -- unlike + the III-class row [test_admit_order_independent] reuses, which admits + TWO out of two offered here and so cannot distinguish "picked by + precedence" from "picked both anyway". *) +let test_admit_uses_precedence_not_slug_when_they_disagree () = + let comms = + [ (order_tiebreak_alpha_first_worse, P.Ordinary, 90); + (order_tiebreak_alpha_last_better, P.Ordinary, 10) ] + in + Alcotest.(check (list string)) + "the BETTER-precedence candidate is admitted even though it sorts LAST alphabetically" + [ "zz-better-precedence" ] + (slugs_of (PE.admit ~observed:observed_class2_other ~temporal:observed_class2_other comms)) + (* 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 @@ -1181,7 +1230,10 @@ let test_all_souls_transfers_end_to_end () = origin = P.Temporal } in let all_souls = cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-all-souls" in - let rules = { P.band = PE.band; disposition = PE.disposition; admit = (fun ~observed:_ ~temporal:_ cs -> cs) } in + let rules = + { P.band = PE.band; disposition = PE.disposition; + admit = (fun ~observed:_ ~temporal:_ cs -> List.map (fun (c, p, (_ : int)) -> (c, p)) cs) } + in let resolution = P.resolve rules day_ctx ~temporal:sunday ~sanctoral:[ all_souls ] in Alcotest.(check (list string)) "All Souls is deferred (transferred), not omitted or commemorated" [ "ef-all-souls" ] @@ -1378,6 +1430,9 @@ let suite = admit_cases @ [ Alcotest.test_case "admit is order-independent (III-class, 3 candidates)" `Quick test_admit_order_independent; + Alcotest.test_case + "RG113: admit picks by precedence order, not slug, when they disagree" `Quick + test_admit_uses_precedence_not_slug_when_they_disagree; 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 diff --git a/test/test_validate.ml b/test/test_validate.ml index 42c58f5..501dd2e 100644 --- a/test/test_validate.ml +++ b/test/test_validate.ml @@ -377,7 +377,9 @@ module Synthetic = struct let dup_rules : (season, rank) P.rules = { P.band = (fun _ c -> match c.P.origin with P.Temporal -> 0 | P.Sanctoral -> 10); disposition = (fun ~winner:_ ~loser:_ -> P.Commemorate P.Ordinary); - admit = (fun ~observed:_ ~temporal:_ cs -> List.map (fun (c, p) -> ({ c with P.origin = c.P.origin }, p)) cs) } + admit = + (fun ~observed:_ ~temporal:_ cs -> + List.map (fun (c, p, (_ : int)) -> ({ c with P.origin = c.P.origin }, p)) cs) } (* "unconverged": two entries collide on one date (6 June), both beating the temporal office and tied with each other, so slug decides: @@ -416,7 +418,7 @@ module Synthetic = struct disposition = (fun ~winner:_ ~loser -> match loser.P.cel.Cel.rank with R1 -> P.Transfer | R2 -> P.Commemorate P.Ordinary); - admit = (fun ~observed:_ ~temporal:_ cs -> cs) } + admit = (fun ~observed:_ ~temporal:_ cs -> List.map (fun (c, p, (_ : int)) -> (c, p)) cs) } let guard_transfer_target (_ : rank P.candidate) (origin : D.t) (_ : D.t -> rank Cel.t) = origin @@ -434,7 +436,7 @@ module Synthetic = struct let adm_c_entry = mk_entry ~month:9 ~day:9 ~slug:"adm-c" ~rank:R2 let adm_layer = Layer.of_entries ~id:"adm" ~name:"adm" [ adm_a_entry; adm_b_entry; adm_c_entry ] - let adm_compare_slug (c1, _) (c2, _) = Slug.compare c1.P.cel.Cel.slug c2.P.cel.Cel.slug + let adm_compare_slug (c1, _, _) (c2, _, _) = Slug.compare c1.P.cel.Cel.slug c2.P.cel.Cel.slug let rec adm_take n = function | [] -> [] @@ -446,7 +448,8 @@ module Synthetic = struct admit = (fun ~observed:_ ~temporal:_ cs -> let sorted = List.stable_sort adm_compare_slug cs in - if List.length sorted mod 2 = 1 then adm_take 2 sorted else adm_take 1 sorted) } + let taken = if List.length sorted mod 2 = 1 then adm_take 2 sorted else adm_take 1 sorted in + List.map (fun (c, p, (_ : int)) -> (c, p)) taken) } (* "observed": two DIFFERENT layer entries sharing one slug -- a realistic data mistake (a renamed or duplicated entry), not prevented by @@ -475,7 +478,7 @@ module Synthetic = struct disposition = (fun ~winner:_ ~loser -> match loser.P.cel.Cel.rank with R1 -> P.Transfer | R2 -> P.Commemorate P.Ordinary); - admit = (fun ~observed:_ ~temporal:_ cs -> cs) } + admit = (fun ~observed:_ ~temporal:_ cs -> List.map (fun (c, p, (_ : int)) -> (c, p)) cs) } let collide_d2 = match D.make ~year:2026 ~month:2 ~day:10 with Ok d -> d | Error e -> failwith e let collide_transfer_target (_ : rank P.candidate) (_ : D.t) (_ : D.t -> rank Cel.t) = collide_d2 @@ -492,7 +495,7 @@ module Synthetic = struct let clean_sanctoral_rules : (season, rank) P.rules = { P.band = (fun _ c -> match c.P.origin with P.Temporal -> 0 | P.Sanctoral -> 10); disposition = (fun ~winner:_ ~loser:_ -> P.Commemorate P.Ordinary); - admit = (fun ~observed:_ ~temporal:_ cs -> cs) } + admit = (fun ~observed:_ ~temporal:_ cs -> List.map (fun (c, p, (_ : int)) -> (c, p)) cs) } end open Synthetic -- cgit v1.3