From 8ab24da337a10993b98696df5d499706318beb8e Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 19:02:08 +0200 Subject: kernel(celebration): distinguish a feast from a commemoration-only entry The 1960 reform reduced many feasts to a bare commemoration. They keep a rank, because RG 111 orders admitted commemorations by dignity, but they can never be the observed day. Modelled as a separate status rather than a fifth rank: RG 8 fixes the classes at four. --- lib/kernel/celebration.ml | 13 ++++++++++--- lib/kernel/celebration.mli | 12 ++++++++++-- 2 files changed, 20 insertions(+), 5 deletions(-) (limited to 'lib') diff --git a/lib/kernel/celebration.ml b/lib/kernel/celebration.ml index 2963366..eb4249e 100644 --- a/lib/kernel/celebration.ml +++ b/lib/kernel/celebration.ml @@ -8,10 +8,17 @@ open Sexplib0.Sexp_conv but would carry no information while forcing every consumer (Layer, Overlay, and later Precedence and Calendar) to thread a variable that means nothing. *) +(* Whether this celebration can be the observed day at all. The 1960 reform + reduced many feasts to a bare commemoration; they retain a rank (RG 111 orders + admitted commemorations by dignity) but can never be observed. NOT a fifth + rank: RG 8 fixes the classes at four. *) +type status = Feast | Commemoration_only [@@deriving sexp] + type 'r t = { slug : Slug.t; names : Names.t; rank : 'r; + status : status; colour : Colour.t; subject : Subject.t; citations : Citation.t list; @@ -19,6 +26,6 @@ type 'r t = { } [@@deriving sexp] -let make ~slug ?(names = Names.empty) ~rank ~colour ?(subject = Subject.Temporal) - ?(citations = []) ~layer () = - { slug; names; rank; colour; subject; citations; layer } +let make ~slug ?(names = Names.empty) ~rank ?(status = Feast) ~colour + ?(subject = Subject.Temporal) ?(citations = []) ~layer () = + { slug; names; rank; status; colour; subject; citations; layer } diff --git a/lib/kernel/celebration.mli b/lib/kernel/celebration.mli index 1c84d35..a3c2960 100644 --- a/lib/kernel/celebration.mli +++ b/lib/kernel/celebration.mli @@ -1,8 +1,15 @@ +(** Whether this celebration can be the observed day at all. The 1960 reform + reduced many feasts to a bare commemoration; they retain a rank (RG 111 + orders admitted commemorations by dignity) but can never be observed. NOT + a fifth rank: RG 8 fixes the classes at four. *) +type status = Feast | Commemoration_only [@@deriving sexp] + (** A celebration. Parameterised by the rite's rank type only. *) type 'r t = { slug : Slug.t; names : Names.t; rank : 'r; + status : status; colour : Colour.t; subject : Subject.t; citations : Citation.t list; @@ -10,7 +17,8 @@ type 'r t = { } [@@deriving sexp] -(** [subject] defaults to [Subject.Temporal], [names] to empty, [citations] to []. *) +(** [status] defaults to [Feast], [subject] to [Subject.Temporal], [names] to + empty, [citations] to []. *) val make : - slug:Slug.t -> ?names:Names.t -> rank:'r -> colour:Colour.t -> + slug:Slug.t -> ?names:Names.t -> rank:'r -> ?status:status -> colour:Colour.t -> ?subject:Subject.t -> ?citations:Citation.t list -> layer:string -> unit -> 'r t -- cgit v1.3 From 19d5bbaab8fbf40f6fa6de8906169e3bb7144e1f Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 19:07:11 +0200 Subject: kernel(precedence): rite-parameterised resolver Three rite-supplied functions, not one: band (who wins, RG 91), disposition (what happens to the loser, RG 92-95) and admit (how many commemorations are admitted, RG 111). The loser's fate depends on the loser's own rank, so conflating them would resist extension. resolve takes the temporal candidate separately from the sanctoral list, which makes it total by construction. Every candidate lands in exactly one of observed, commemorations, deferred or omitted -- nothing is dropped silently, which is what makes the no-celebration-lost invariant checkable. --- lib/kernel/precedence.ml | 69 ++++++++++++++++++++++++++++++++++++++++++ lib/kernel/precedence.mli | 60 +++++++++++++++++++++++++++++++++++++ test/test_colitur.ml | 2 +- test/test_precedence.ml | 76 +++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 206 insertions(+), 1 deletion(-) create mode 100644 lib/kernel/precedence.ml create mode 100644 lib/kernel/precedence.mli create mode 100644 test/test_precedence.ml (limited to 'lib') diff --git a/lib/kernel/precedence.ml b/lib/kernel/precedence.ml new file mode 100644 index 0000000..05ad69f --- /dev/null +++ b/lib/kernel/precedence.ml @@ -0,0 +1,69 @@ +(* The rite-parameterised resolver. RG 91 says who wins; RG 92-95 says what + happens to the loser; RG 108-111 says how many commemorations are admitted. + Three separate functions, because the loser's fate depends on the loser's own + rank, not the winner's. *) +open Sexplib0.Sexp_conv + +type origin = Temporal | Sanctoral [@@deriving sexp] +type privilege = Privileged | Ordinary [@@deriving sexp] +type disposition = Omit | Commemorate of privilege | Transfer | Repose [@@deriving sexp] + +type 'r candidate = { cel : 'r Celebration.t; origin : origin } [@@deriving sexp] + +type 's context = { date : Date.t; season : 's; weekday : Date.weekday } + +type ('s, 'r) rules = { + band : 's context -> 'r candidate -> int; + disposition : winner:'r candidate -> loser:'r candidate -> disposition; + admit : + observed:'r candidate -> + ('r candidate * privilege) list -> + ('r candidate * privilege) list; +} + +type 'r resolution = { + observed : 'r candidate; + commemorations : ('r candidate * privilege) list; + deferred : 'r candidate list; + omitted : ('r candidate * string) list; +} + +(* Ties break on slug so the result never depends on input order. *) +let compare_by rules ctx a b = + let ba = rules.band ctx a and bb = rules.band ctx b in + if ba <> bb then Int.compare ba bb + else Slug.compare a.cel.Celebration.slug b.cel.Celebration.slug + +let resolve rules ctx ~temporal ~sanctoral = + (* A commemoration-only entry can never be observed (see Celebration.status), + so it is held out of the contest entirely rather than relying on its band. *) + let eligible, forced_comm = + List.partition + (fun c -> c.cel.Celebration.status = Celebration.Feast) + sanctoral + in + let sorted = List.stable_sort (compare_by rules ctx) (temporal :: eligible) in + let observed = List.hd sorted in + let losers = List.tl sorted @ forced_comm in + let comms, deferred, omitted = + List.fold_left + (fun (comms, defs, omits) l -> + match rules.disposition ~winner:observed ~loser:l with + | Commemorate p -> ((l, p) :: comms, defs, omits) + | Transfer | Repose -> (comms, l :: defs, omits) + | Omit -> (comms, defs, (l, "omitted: yielded to a higher day") :: omits)) + ([], [], []) losers + in + let comms = List.rev comms and deferred = List.rev deferred in + let admitted = rules.admit ~observed comms in + let dropped = + List.filter (fun c -> not (List.exists (fun a -> fst a == fst c) admitted)) comms + in + { + observed; + commemorations = admitted; + deferred; + omitted = + List.rev omitted + @ List.map (fun (c, _) -> (c, "omitted: admission limit reached")) dropped; + } diff --git a/lib/kernel/precedence.mli b/lib/kernel/precedence.mli new file mode 100644 index 0000000..d30e5c3 --- /dev/null +++ b/lib/kernel/precedence.mli @@ -0,0 +1,60 @@ +(** The rite-parameterised resolver: RG 91 says who wins, RG 92-95 says what + happens to the loser, RG 108-111 says how many commemorations are admitted. + Three separate rite-supplied functions, because the loser's fate depends on + the loser's own rank, not the winner's -- conflating them would resist + extension to a second rite. *) + +(** Which of the day's two office streams a candidate came from. *) +type origin = Temporal | Sanctoral [@@deriving sexp] + +(** RG 111: an admitted commemoration's own standing, distinct from its rank. *) +type privilege = Privileged | Ordinary [@@deriving sexp] + +(** What becomes of a losing candidate. *) +type disposition = + | Omit (** yields with no trace in the day's celebration *) + | Commemorate of privilege (** kept as a commemoration of the observed day *) + | Transfer (** moved to the next free day (RG 92-95) *) + | Repose (** kept only in a votive/private sense; not commemorated today *) +[@@deriving sexp] + +(** A celebration together with the office stream it was drawn from. Parameterised + by the rite's rank type only, matching {!Celebration.t}. *) +type 'r candidate = { cel : 'r Celebration.t; origin : origin } [@@deriving sexp] + +(** The day a resolution is computed for. Parameterised by the rite's season + type only -- a context has no rank of its own. *) +type 's context = { date : Date.t; season : 's; weekday : Date.weekday } + +(** The rite's three resolution functions. *) +type ('s, 'r) rules = { + band : 's context -> 'r candidate -> int; + (** RG 91: orders candidates for the day; lower wins. *) + disposition : winner:'r candidate -> loser:'r candidate -> disposition; + (** RG 92-95: the loser's fate, which depends on the loser's own rank. *) + admit : + observed:'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. *) +} + +(** The outcome of resolving one day's candidates. *) +type 'r resolution = { + observed : 'r candidate; + commemorations : ('r candidate * privilege) list; + deferred : 'r candidate list; + omitted : ('r candidate * string) list; (** each with a reason *) +} + +(** Total: the temporal candidate is passed separately, so there is no + empty-candidate case. Ties break on slug, so the result never depends on + input order. A [Commemoration_only] celebration is held out of the contest + and can never be [observed]. Every input candidate appears exactly once in + [observed], [commemorations], [deferred] or [omitted] — nothing is dropped + silently. *) +val resolve : + ('s, 'r) rules -> 's context -> temporal:'r candidate -> + sanctoral:'r candidate list -> 'r resolution diff --git a/test/test_colitur.ml b/test/test_colitur.ml index ae58607..08282e6 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -2,4 +2,4 @@ let () = Alcotest.run "colitur" [ Test_date.suite; Test_computus.suite; Test_colour.suite; Test_slug.suite; Test_names.suite; - Test_overlay.suite; Test_temporal_ef.suite; Test_validate.suite ] + Test_overlay.suite; Test_temporal_ef.suite; Test_validate.suite; Test_precedence.suite ] diff --git a/test/test_precedence.ml b/test/test_precedence.ml new file mode 100644 index 0000000..39be06c --- /dev/null +++ b/test/test_precedence.ml @@ -0,0 +1,76 @@ +module P = Colitur_kernel.Precedence +module Cel = Colitur_kernel.Celebration +module S = Colitur_kernel.Slug +module Col = Colitur_kernel.Colour +module D = Colitur_kernel.Date + +type rank = Hi | Lo [@@deriving sexp] +type season = Green [@@deriving sexp] + +let cand ?(origin = P.Sanctoral) ?(status = Cel.Feast) ~rank slug = + { P.cel = Cel.make ~slug:(S.of_string_exn slug) ~rank ~status ~colour:Col.White + ~layer:"base" (); origin } + +let ctx = + { P.date = (match D.make ~year:2026 ~month:7 ~day:15 with Ok d -> d | Error e -> failwith e); + season = Green; weekday = D.Wed } + +(* Band: Hi beats Lo. Temporal breaks a tie in its own favour. *) +let rules = + { P.band = (fun _ c -> (match c.P.cel.Cel.rank with Hi -> 10 | Lo -> 20) + - (match c.P.origin with P.Temporal -> 1 | P.Sanctoral -> 0)); + disposition = + (fun ~winner:_ ~loser -> + match loser.P.cel.Cel.status with + | Cel.Commemoration_only -> P.Commemorate P.Ordinary + | Cel.Feast -> (match loser.P.cel.Cel.rank with + | Hi -> P.Transfer + | Lo -> P.Commemorate P.Ordinary)); + admit = (fun ~observed:_ cs -> List.filteri (fun i _ -> i < 2) cs) } + +let slug_of c = S.to_string c.P.cel.Cel.slug + +let test_highest_band_wins () = + let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Lo "feria") + ~sanctoral:[ cand ~rank:Hi "big-feast" ] in + Alcotest.(check string) "feast wins" "big-feast" (slug_of r.P.observed) + +let test_temporal_wins_a_tie () = + let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Hi "sunday") + ~sanctoral:[ cand ~rank:Hi "saint" ] in + Alcotest.(check string) "temporal wins tie" "sunday" (slug_of r.P.observed) + +let test_loser_dispositions () = + let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Hi "sunday") + ~sanctoral:[ cand ~rank:Hi "transferable"; cand ~rank:Lo "commemorated" ] in + Alcotest.(check (list string)) "deferred" [ "transferable" ] + (List.map slug_of r.P.deferred); + Alcotest.(check (list string)) "commemorated" [ "commemorated" ] + (List.map (fun (c, _) -> slug_of c) r.P.commemorations) + +(* A commemoration-only entry can never be observed, even at a winning band. *) +let test_commemoration_only_never_observed () = + let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Lo "feria") + ~sanctoral:[ cand ~rank:Hi ~status:Cel.Commemoration_only "suppressed" ] in + Alcotest.(check string) "feria still observed" "feria" (slug_of r.P.observed); + Alcotest.(check (list string)) "suppressed commemorated" [ "suppressed" ] + (List.map (fun (c, _) -> slug_of c) r.P.commemorations) + +(* Anything the admit limit drops is recorded in `omitted`, never dropped silently. *) +let test_nothing_silently_lost () = + let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Hi "sunday") + ~sanctoral:[ cand ~rank:Lo "a"; cand ~rank:Lo "b"; cand ~rank:Lo "c" ] in + Alcotest.(check int) "two admitted" 2 (List.length r.P.commemorations); + Alcotest.(check int) "one recorded as omitted" 1 (List.length r.P.omitted); + let total = 1 + List.length r.P.commemorations + List.length r.P.deferred + + List.length r.P.omitted in + Alcotest.(check int) "every candidate accounted for" 4 total + +let suite = + ( "Precedence", + [ Alcotest.test_case "highest band wins" `Quick test_highest_band_wins; + Alcotest.test_case "temporal wins a tie" `Quick test_temporal_wins_a_tie; + Alcotest.test_case "loser dispositions" `Quick test_loser_dispositions; + Alcotest.test_case "commemoration-only never observed" `Quick + test_commemoration_only_never_observed; + Alcotest.test_case "nothing silently lost" `Quick test_nothing_silently_lost ] ) -- cgit v1.3 From 9df1aab700ce4454c26c7d0ede5b51c0f0c96c66 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 19:30:34 +0200 Subject: kernel: the LiturgicalDay result schema Temporal is embedded rather than flattened, so season/week/weekday have one home and cannot disagree with themselves. transferred_in/out make transfers visible in the result -- an ordo must print 'transferred from the 25th', and the nothing-lost invariant reads these fields. citations exists and is empty until Plan 4; adding it later would widen a type every consumer matches on. --- lib/kernel/liturgical_day.ml | 19 +++++++++++++++++++ lib/kernel/liturgical_day.mli | 17 +++++++++++++++++ 2 files changed, 36 insertions(+) create mode 100644 lib/kernel/liturgical_day.ml create mode 100644 lib/kernel/liturgical_day.mli (limited to 'lib') diff --git a/lib/kernel/liturgical_day.ml b/lib/kernel/liturgical_day.ml new file mode 100644 index 0000000..65e3ba5 --- /dev/null +++ b/lib/kernel/liturgical_day.ml @@ -0,0 +1,19 @@ +open Sexplib0.Sexp_conv + +(* The single stable result schema (parent spec §2). *) +type ('s, 'r) t = { + date : Date.t; + rite : string; + temporal : ('s, 'r) Temporal.t; + (** embedded, not flattened: it is already a coherent unit with its own + invariants, and re-listing season/week/weekday here would create two + places for them to disagree *) + observed : 'r Celebration.t; + commemorations : ('r Celebration.t * Precedence.privilege) list; + transferred_in : 'r Celebration.t option; + (** arrived here from an impeded day *) + transferred_out : Date.t option; + (** this day's celebration went there *) + citations : Citation.t list; (** always empty until Plan 4 *) +} +[@@deriving sexp] diff --git a/lib/kernel/liturgical_day.mli b/lib/kernel/liturgical_day.mli new file mode 100644 index 0000000..3c331c3 --- /dev/null +++ b/lib/kernel/liturgical_day.mli @@ -0,0 +1,17 @@ +(** The single stable result schema (parent spec §2). *) +type ('s, 'r) t = { + date : Date.t; + rite : string; + temporal : ('s, 'r) Temporal.t; + (** embedded, not flattened: it is already a coherent unit with its own + invariants, and re-listing season/week/weekday here would create two + places for them to disagree *) + observed : 'r Celebration.t; + commemorations : ('r Celebration.t * Precedence.privilege) list; + transferred_in : 'r Celebration.t option; + (** arrived here from an impeded day *) + transferred_out : Date.t option; + (** this day's celebration went there *) + citations : Citation.t list; (** always empty until Plan 4 *) +} +[@@deriving sexp] -- cgit v1.3 From 6436509d6b599b7d7c6467bd39c8090cb9634889 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 19:39:37 +0200 Subject: kernel(rite): bundle what a rite supplies; make season runs rite-supplied Validate took four loose arguments that had to come from the same rite with nothing enforcing it, and Calendar is about to add more. Bundling makes a mismatched assembly unrepresentable through the normal path. season_runs replaces the hardcoded assumption that every season occupies exactly one unbroken run. That holds for the 1962 rite but is false for the modern form's Ordinary Time, which is one season in two runs -- as written the check would have reported a false failure every year for the second rite. --- lib/kernel/rite.ml | 12 ++++++++ lib/kernel/rite.mli | 18 +++++++++++ lib/kernel/validate.ml | 15 +++++++--- lib/kernel/validate.mli | 32 ++++++++++---------- test/test_validate.ml | 79 +++++++++++++++++++++++++++++++++++++++++++++---- 5 files changed, 129 insertions(+), 27 deletions(-) create mode 100644 lib/kernel/rite.ml create mode 100644 lib/kernel/rite.mli (limited to 'lib') diff --git a/lib/kernel/rite.ml b/lib/kernel/rite.ml new file mode 100644 index 0000000..b948390 --- /dev/null +++ b/lib/kernel/rite.ml @@ -0,0 +1,12 @@ +(* Everything a rite supplies, bundled. Passing these as loose arguments let a + caller pair one rite's vocab with another's temporal; bundling makes that + unrepresentable through the normal path. *) +type ('s, 'r) t = { + id : string; + vocab : ('s, 'r) Vocab.t; + year_start : int -> Date.t; + temporal : Date.t -> ('s, 'r) Temporal.t; + anchors : int -> (string * Date.t) list; + rules : ('s, 'r) Precedence.rules; + season_runs : 's list; +} diff --git a/lib/kernel/rite.mli b/lib/kernel/rite.mli new file mode 100644 index 0000000..db8e86f --- /dev/null +++ b/lib/kernel/rite.mli @@ -0,0 +1,18 @@ +(** Everything a rite supplies, bundled. Passing these as loose arguments let a + caller pair one rite's vocab with another's temporal; bundling makes that + unrepresentable through the normal path. Carries functions, so it has no + sexp form. *) +type ('s, 'r) t = { + id : string; + vocab : ('s, 'r) Vocab.t; + year_start : int -> Date.t; + (** first day of the liturgical year opening in civil year y *) + temporal : Date.t -> ('s, 'r) Temporal.t; + anchors : int -> (string * Date.t) list; + (** Easter-derived days: (expected slug, date) *) + rules : ('s, 'r) Precedence.rules; + season_runs : 's list; + (** the expected run-length-compressed season sequence over one liturgical + year. NOT necessarily [vocab.seasons]: a rite may have one season + appear in two separate runs (the modern form's Ordinary Time does). *) +} diff --git a/lib/kernel/validate.ml b/lib/kernel/validate.ml index 7be3425..c6501a9 100644 --- a/lib/kernel/validate.ml +++ b/lib/kernel/validate.ml @@ -20,7 +20,11 @@ let has_duplicate strings = let rec go = function a :: (b :: _ as rest) -> a = b || go rest | _ -> false in go sorted -let run vocab ~year_start ~temporal ~anchors ~year = +let run (rite : ('s, 'r) Rite.t) ~year = + let vocab = rite.Rite.vocab in + let year_start = rite.Rite.year_start in + let temporal = rite.Rite.temporal in + let anchors = rite.Rite.anchors in let start = year_start year in let stop = (* [year_start (year + 1)] needs a date in civil year (year+1); at @@ -98,8 +102,11 @@ let run vocab ~year_start ~temporal ~anchors ~year = days; let observed = List.rev !observed in (* Season contiguity and completeness: the run-length-compressed sequence must - equal vocab.seasons exactly -- all seasons, each in one unbroken run, in - canonical order. No EF season can be empty in any year. *) + equal the rite's own [season_runs] exactly, in canonical order. This is + NOT necessarily [vocab.seasons] -- most rites have each season in one + unbroken run, but a rite may legitimately have one season appear in two + separate runs (the modern form's Ordinary Time does), so the expected + sequence is rite-supplied rather than derived from the vocabulary. *) let compressed = List.fold_left (fun acc (_, t) -> @@ -108,7 +115,7 @@ let run vocab ~year_start ~temporal ~anchors ~year = [] observed |> List.rev in - let expected = List.map vocab.Vocab.season_to_string vocab.Vocab.seasons in + let expected = List.map vocab.Vocab.season_to_string rite.Rite.season_runs in if compressed <> expected then fail start "seasons" (Printf.sprintf "season runs %s; expected %s" diff --git a/lib/kernel/validate.mli b/lib/kernel/validate.mli index 709a711..d281f9a 100644 --- a/lib/kernel/validate.mli +++ b/lib/kernel/validate.mli @@ -5,26 +5,24 @@ type failure = { year : int; date : string; check : string; detail : string } val failure_to_string : failure -> string -(** [run vocab ~year_start ~temporal ~anchors ~year] returns every invariant - violation in the liturgical year opening in civil year [year]. An empty - list means the year is clean. +(** [run rite ~year] returns every invariant violation in the liturgical year + opening in civil year [year]. An empty list means the year is clean. - [anchors y] is the rite's own independent restatement of its fixed and - Easter-derived named days for civil year [y], as (expected slug, date) - pairs -- not derived from [temporal] itself, so a drift between the two - is caught rather than invisible. [run] consults both [anchors year] and - [anchors (year + 1)], since a liturgical year straddles two civil years, - and checks only the pairs whose date actually falls within the year - walked. + [rite.Rite.anchors y] is the rite's own independent restatement of its + fixed and Easter-derived named days for civil year [y], as (expected + slug, date) pairs -- not derived from [rite.Rite.temporal] itself, so a + drift between the two is caught rather than invisible. [run] consults + both [anchors year] and [anchors (year + 1)], since a liturgical year + straddles two civil years, and checks only the pairs whose date actually + falls within the year walked. + + The season check compares the run-length-compressed season sequence + against [rite.Rite.season_runs], not [rite.Rite.vocab.seasons]: a rite may + have one season appear in two separate runs (the modern form's Ordinary + Time does), so the two are not necessarily the same list. Total over the whole 1583..9999 domain, including [year] = 9999: the liturgical year opening there continues into out-of-domain civil year 10000, so the walk is clamped to 31 December 9999 and the checks run against that truncated final year rather than raising. *) -val run : - ('s, 'r) Vocab.t -> - year_start:(int -> Date.t) -> - temporal:(Date.t -> ('s, 'r) Temporal.t) -> - anchors:(int -> (string * Date.t) list) -> - year:int -> - failure list +val run : ('s, 'r) Rite.t -> year:int -> failure list diff --git a/test/test_validate.ml b/test/test_validate.ml index c19957d..31d7a3d 100644 --- a/test/test_validate.ml +++ b/test/test_validate.ml @@ -1,9 +1,23 @@ module Val = Colitur_kernel.Validate +module Rite = Colitur_kernel.Rite +module P = Colitur_kernel.Precedence module V = Rite_ef.Vocab_ef module T = Rite_ef.Temporal_ef -let run year = - Val.run V.vocab ~year_start:T.year_start ~temporal:T.temporal ~anchors:T.anchors ~year +(* Plan 3's real EF precedence rules (Precedence_ef, Tasks 7-11) don't exist + yet -- Validate.run doesn't read [rules] at all (nothing does before + Task 5's Calendar), so a placeholder is enough to assemble a well-typed + Rite.t here. *) +let ef_rules : (V.season, V.rank) P.rules = + { P.band = (fun _ _ -> 0); + disposition = (fun ~winner:_ ~loser:_ -> P.Omit); + admit = (fun ~observed:_ _ -> []) } + +let ef_rite : (V.season, V.rank) Rite.t = + { Rite.id = T.id; vocab = V.vocab; year_start = T.year_start; temporal = T.temporal; + anchors = T.anchors; rules = ef_rules; season_runs = V.seasons } + +let run year = Val.run ef_rite ~year let check_year year = match run year with @@ -77,6 +91,8 @@ module Synthetic = struct module Slug = Colitur_kernel.Slug module Colour = Colitur_kernel.Colour module Temporal = Colitur_kernel.Temporal + module P = Colitur_kernel.Precedence + module Rite = Colitur_kernel.Rite type season = A | B type rank = R1 | R2 @@ -105,6 +121,13 @@ module Synthetic = struct let vocab_collapsed_ranks = { vocab with Vocab.rank_to_string = (fun _ -> "same") } let vocab_collapsed_seasons = { vocab with Vocab.season_to_string = (fun _ -> "same") } + (* Precedence_ef doesn't exist yet (Tasks 7-11); Validate.run never reads + [rules], so a placeholder is enough to assemble a well-typed Rite.t. *) + let rules : (season, rank) P.rules = + { P.band = (fun _ _ -> 0); + disposition = (fun ~winner:_ ~loser:_ -> P.Omit); + admit = (fun ~observed:_ _ -> []) } + let year_start y = match D.make ~year:y ~month:1 ~day:1 with Ok d -> d | Error e -> failwith e let weekday_index d = @@ -149,10 +172,41 @@ module Synthetic = struct this synthetic rite too, not only in EF. *) let anchors _y = [ (Slug.to_string (good target).Temporal.office.Cel.slug, target) ] - let run ?(vocab = vocab) ?(anchors = fun _ -> []) temporal = - Val.run vocab ~year_start ~temporal ~anchors ~year:2026 + let rite ?(vocab = vocab) ?(anchors = fun _ -> []) ?(season_runs = [ A; B ]) temporal + : (season, rank) Rite.t = + { Rite.id = "synthetic"; vocab; year_start; temporal; anchors; rules; season_runs } + + let run ?vocab ?anchors ?season_runs temporal = + Val.run (rite ?vocab ?anchors ?season_runs temporal) ~year:2026 let has_check check (fs : Val.failure list) = List.exists (fun f -> f.Val.check = check) fs + + (* A rite whose season B legitimately appears in two separate runs: the + civil year is split into calendar quarters, seasons alternating A B A B + -- as the modern form's Ordinary Time does (January-Ash Wednesday, then + Pentecost-Advent, with Lent/Easter and Advent/Christmas between). Each + quarter gets its own Sunday-aligned week origin, exactly as [good] does + for its own two runs, so every other invariant (weekday, week + numbering, rank, colour, determinism) stays clean and only the season + check is actually exercised. *) + let quarter_start y i = + match D.make ~year:y ~month:(1 + (i * 3)) ~day:1 with Ok d -> d | Error e -> failwith e + + let quarter_index d = (D.month d - 1) / 3 + + let two_run_temporal d = + let y = D.year d in + let qi = quarter_index d in + let s = if qi mod 2 = 0 then A else B in + let origin = sunday_on_or_before (quarter_start y qi) in + let n = floor_div (D.to_rata d - D.to_rata origin) 7 + 1 in + let slug = Printf.sprintf "syn2-%s-%d" (season_to_string s) (D.to_rata d) in + let rank = if D.weekday d = D.Sun then R1 else R2 in + { Temporal.season = s; week = Some n; weekday = D.weekday d; + office = Cel.make ~slug:(Slug.of_string_exn slug) ~rank ~colour:Colour.Green ~layer:"synthetic" () } + + let rite_with_two_runs : (season, rank) Rite.t = + rite ~season_runs:[ A; B; A; B ] two_run_temporal end open Synthetic @@ -160,6 +214,18 @@ open Synthetic let test_synthetic_baseline_is_clean () = Alcotest.(check bool) "clean synthetic fixture has no failures" true (run good = []) +(* The point of this task: a rite whose season B genuinely appears in two + separate runs (quarters 0,1,2,3 give season sequence A B A B, not a single + A-then-B pair) validates clean when [season_runs] says so. Before this + task, [Validate]'s season check hardcoded "compressed = vocab.seasons" + ([A; B]) with no way to say otherwise -- against that check this fixture's + compressed sequence, [A; B; A; B], would never match and every year would + report a spurious "seasons" failure. *) +let test_two_run_season_is_accepted () = + let r = Synthetic.rite_with_two_runs in + Alcotest.(check (list string)) "no failures" [] + (List.map Val.failure_to_string (Val.run r ~year:2026)) + let test_coverage_fires () = let temporal d = if D.compare d target = 0 then failwith "boom" else good d in Alcotest.(check bool) "coverage check fires when temporal raises" true @@ -170,10 +236,10 @@ let test_seasons_fires () = let t = good d in let y = D.year d in let flip_after = match D.make ~year:y ~month:9 ~day:1 with Ok d -> d | Error e -> failwith e in - (* Season A reappears after B: breaks "each season, one unbroken run". *) + (* Season A reappears after B: breaks the expected [A; B] run sequence. *) if D.compare d flip_after >= 0 then { t with Temporal.season = A } else t in - Alcotest.(check bool) "seasons check fires when a season recurs" true + Alcotest.(check bool) "seasons check fires when a season recurs outside season_runs" true (has_check "seasons" (run temporal)) let test_week_fires () = @@ -269,6 +335,7 @@ let suite = Alcotest.test_case "year 9999 does not raise" `Quick test_year_9999_does_not_raise; Alcotest.test_case "easter extremes" `Quick test_easter_extremes; Alcotest.test_case "synthetic baseline is clean" `Quick test_synthetic_baseline_is_clean; + Alcotest.test_case "two-run season is accepted" `Quick test_two_run_season_is_accepted; Alcotest.test_case "coverage fires" `Quick test_coverage_fires; Alcotest.test_case "seasons fires" `Quick test_seasons_fires; Alcotest.test_case "week fires" `Quick test_week_fires; -- cgit v1.3 From 8de560db7fb1b7b7d3ca93285068c6a4214e0bff Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 20:01:31 +0200 Subject: kernel(calendar): the year is the primitive, the day is derived Transfers make per-date resolution impossible to do correctly: resolving 25 March can push a feast onto 26 March, and RG 97-98 has coinciding I-class feasts transfer in table order, which needs global knowledge. So year computes a whole liturgical year in one pass and day indexes into it. Pure, no cache, no mutable state. This commit resolves each day but does not yet place deferred transfers; they are recorded with a reason. Task 6 adds the placement pass. --- lib/kernel/calendar.ml | 93 ++++++++++++++++++++++++++ lib/kernel/calendar.mli | 45 +++++++++++++ test/test_calendar.ml | 172 ++++++++++++++++++++++++++++++++++++++++++++++++ test/test_colitur.ml | 3 +- 4 files changed, 312 insertions(+), 1 deletion(-) create mode 100644 lib/kernel/calendar.ml create mode 100644 lib/kernel/calendar.mli create mode 100644 test/test_calendar.ml (limited to 'lib') diff --git a/lib/kernel/calendar.ml b/lib/kernel/calendar.ml new file mode 100644 index 0000000..fd23377 --- /dev/null +++ b/lib/kernel/calendar.ml @@ -0,0 +1,93 @@ +(* Resolution across a whole liturgical year. See calendar.mli for the + architectural rationale (why [year] is the primitive and [day] derived). *) + +(* The kernel's domain floor and ceiling (Date.make's documented 1583..9999 + bound). Both are always constructible -- in-range by definition -- so + neither of these can itself raise. *) +let domain_min_date = + match Date.make ~year:1583 ~month:1 ~day:1 with Ok d -> d | Error e -> failwith e + +let domain_max_date = + match Date.make ~year:9999 ~month:12 ~day:31 with Ok d -> d | Error e -> failwith e + +(* [start, stop] for the liturgical year opening in civil year [y], clamped at + both ends of the domain rather than calling [rite.year_start] on a civil + year outside 1583..9999. + + Top: at [y] = 9999, [rite.year_start (y + 1)] would ask for civil year + 10000 -- out of Date's domain (Plan 2 shipped exactly this bug in + Validate). Clamp [stop] to 31 December 9999 instead: the final liturgical + year comes back truncated, not un-computable. + + Bottom: symmetric case, reachable only through [day] below. A date in + civil year 1583 before that year's own [rite.year_start] genuinely belongs + to the liturgical year that opened in civil year 1582 for an + Advent-anchored rite -- but [rite.year_start 1582] is equally out of + domain. [day] only ever decrements a valid date's own (in-domain) civil + year by at most one, so [y] = 1582 is the sole way this branch is reached. + Clamp [start] to 1 January 1583: "year 1582" becomes the truncated + stretch from the domain floor up to the day before [rite.year_start 1583], + which is exactly the sliver a date there needs. *) +let year_bounds (rite : ('s, 'r) Rite.t) (y : int) : Date.t * Date.t = + let start = if y < 1583 then domain_min_date else rite.Rite.year_start y in + let stop = + if y >= 9999 then domain_max_date else Date.add_days (rite.Rite.year_start (y + 1)) (-1) + in + (start, stop) + +(* RG 91's contest for one date: the temporal office against every sanctoral + entry whose Date_spec resolves to it. [Layer.on_date] is keyed on exactly + (month, day), which for a [Fixed] spec -- the only form Plan 2 ships -- is + the same test as resolving the spec against [date]'s own year and + comparing, so no separate filter is needed here. *) +let resolve_day (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) (date : Date.t) : + ('s, 'r) Liturgical_day.t = + let temporal = rite.Rite.temporal date in + let temporal_candidate = + { Precedence.cel = temporal.Temporal.office; origin = Precedence.Temporal } + in + let sanctoral = + Layer.on_date idx ~month:(Date.month date) ~day:(Date.day date) + |> List.map (fun (e : 'r Layer.entry) -> + { Precedence.cel = e.Layer.cel; origin = Precedence.Sanctoral }) + in + let ctx = { Precedence.date; season = temporal.Temporal.season; weekday = temporal.Temporal.weekday } in + let resolution = Precedence.resolve rite.Rite.rules ctx ~temporal:temporal_candidate ~sanctoral in + (* [resolution.deferred] (RG 96-98 transfer candidates) and + [resolution.omitted] (yielded/admission-limit losers) have no field to + land in on Liturgical_day.t yet, so both are simply absent from today's + result -- deliberately incomplete for a deferred candidate, which is + thereby neither observed nor commemorated here, and not yet placed on + any later day either ("deferred: transfer placement not yet implemented + (Task 6)"). Task 6's fixed-point pass closes this gap. *) + { + Liturgical_day.date; + rite = rite.Rite.id; + temporal; + observed = resolution.Precedence.observed.Precedence.cel; + commemorations = + List.map (fun (c, p) -> (c.Precedence.cel, p)) resolution.Precedence.commemorations; + transferred_in = None; + transferred_out = None; + citations = []; + } + +let year (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) (y : int) : + ('s, 'r) Liturgical_day.t array = + let idx = Layer.index_by_date layer in + let start, stop = year_bounds rite y in + (* [max 0]: defends [Array.init] against a negative length, which would + otherwise arise for a rite whose [year_start] lands exactly on the + domain floor (start clamps to the same date, giving [stop] a day + before it). Not reachable through [day] -- see calendar.mli -- but + [year] is public, and a direct out-of-contract call must not raise + either. *) + let n = max 0 (Date.to_rata stop - Date.to_rata start + 1) in + Array.init n (fun i -> resolve_day rite idx (Date.add_days start i)) + +let day (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) (date : Date.t) : + ('s, 'r) Liturgical_day.t = + let cy = Date.year date in + let y = if Date.compare date (rite.Rite.year_start cy) >= 0 then cy else cy - 1 in + let start, _ = year_bounds rite y in + (year rite layer y).(Date.to_rata date - Date.to_rata start) diff --git a/lib/kernel/calendar.mli b/lib/kernel/calendar.mli new file mode 100644 index 0000000..50ff8f8 --- /dev/null +++ b/lib/kernel/calendar.mli @@ -0,0 +1,45 @@ +(** Resolution across a whole liturgical year (spec §2.4). + + Transfers make per-date resolution impossible to do correctly: resolving + 25 March can push a feast onto 26 March, and RG 97-98 has coinciding + I-class feasts transfer in table order, which needs global knowledge of + the whole year. So [year] is the primitive -- it resolves every date in + one pass -- and [day] is derived: it finds the liturgical year containing + a date and indexes into it. Both are pure; neither caches. + + This module resolves each day's temporal-vs-sanctoral contest but does + not yet place deferred transfers (RG 96-98): a losing candidate the + rite's rules send to [Precedence.Transfer] is absent from the result + entirely on this pass -- not observed, not commemorated, and + [transferred_in]/[transferred_out] both stay [None] everywhere. Task 6 + adds the fixed-point placement pass that closes this gap. *) + +(** [year rite layer y] resolves every day of the liturgical year that opens + in civil year [y]: from [rite.year_start y] through the day before + [rite.year_start (y + 1)], inclusive of both ends. + + Total over 1583..9999, including the boundary years: + - At [y] = 9999, [rite.year_start (y + 1)] would ask for civil year + 10000, out of {!Date}'s domain (this is the bug Plan 2 shipped in + [Validate] and later fixed). The end of the walk clamps to 31 December + 9999 instead of computing that call; the returned year comes back + truncated to whatever the rite's own temporal cycle covers between + [rite.year_start 9999] and the last day of that civil year, not + un-computable. + - Symmetrically, [y] < 1583 clamps the start of the walk to 1 January + 1583 instead of calling [rite.year_start y] on an out-of-domain civil + year. [year] is never called this way directly by anything in this + module; {!day} is the only caller that can reach [y] = 1582 (one below + the floor, never lower), when the date it was asked about sits in civil + year 1583 before that year's own [rite.year_start] -- i.e. the sliver + whose true liturgical year opened in civil year 1582, which the domain + cannot represent. Calling [year] with such a [y] directly is also safe: + it returns exactly that truncated sliver. *) +val year : ('s, 'r) Rite.t -> 'r Layer.t -> int -> ('s, 'r) Liturgical_day.t array + +(** [day rite layer date] finds the liturgical year containing [date] -- the + year [y] with [rite.year_start y <= date < rite.year_start (y + 1)] -- + and returns its slot for [date]. Recomputes that whole year on every + call: pure, no cache, no mutable state. Acceptable cost for the natural + usage (dump a year, sweep years for validation), which pays it once. *) +val day : ('s, 'r) Rite.t -> 'r Layer.t -> Date.t -> ('s, 'r) Liturgical_day.t diff --git a/test/test_calendar.ml b/test/test_calendar.ml new file mode 100644 index 0000000..a3c4125 --- /dev/null +++ b/test/test_calendar.ml @@ -0,0 +1,172 @@ +module C = Colitur_kernel.Calendar +module D = Colitur_kernel.Date +module LD = Colitur_kernel.Liturgical_day +module Cel = Colitur_kernel.Celebration +module Sl = Colitur_kernel.Slug +module Rite = Colitur_kernel.Rite + +let mk y m d = match D.make ~year:y ~month:m ~day:d with Ok t -> t | Error e -> failwith e + +(* A synthetic rite -- not EF -- so Calendar's behaviour is proven against the + abstraction, not against EF's own real (and much larger) data. Two + seasons, two ranks: enough to exercise the type parameters without + dragging in real liturgical logic Calendar itself does not compute. *) +module Fixture = struct + module Vocab = Colitur_kernel.Vocab + module Colour = Colitur_kernel.Colour + module Temporal = Colitur_kernel.Temporal + module P = Colitur_kernel.Precedence + module Layer = Colitur_kernel.Layer + module Date_spec = Colitur_kernel.Date_spec + + type season = A | B + type rank = Hi | Lo + + let season_to_string = function A -> "a" | B -> "b" + let season_of_string = function "a" -> Some A | "b" -> Some B | _ -> None + let rank_to_string = function Hi -> "hi" | Lo -> "lo" + let rank_of_string = function "hi" -> Some Hi | "lo" -> Some Lo | _ -> None + + let vocab : (season, rank) Vocab.t = + { Vocab.seasons = [ A; B ]; season_to_string; season_of_string; + ranks = [ Hi; Lo ]; rank_to_string; rank_of_string } + + let weekday_index d = + match D.weekday d with + | D.Sun -> 0 | D.Mon -> 1 | D.Tue -> 2 | D.Wed -> 3 + | D.Thu -> 4 | D.Fri -> 5 | D.Sat -> 6 + + let sunday_on_or_before d = D.add_days d (-(weekday_index d)) + + (* Advent-anchored, mirroring the real EF rite's own RG-71 "Sunday nearest + 30 November" rule (rite_ef/temporal_ef.ml's [advent_start]) rather than + a Jan-1 year start: that shape is what makes the year-below-the-date's- + own-civil-year case in [Calendar.day] genuinely reachable, so the domain + -floor test below exercises something real. *) + let year_start y = D.add_days (sunday_on_or_before (mk y 12 24)) (-21) + + (* Not liturgically meaningful -- Calendar does not check season + contiguity (that is Validate's job); this just proves the season type + parameter is actually threaded through. *) + let season date = if D.month date < 6 then A else B + + (* One office per day, uniquely named by date so distinct days never + collide on slug. *) + let office date = + let slug = Printf.sprintf "feria-%04d-%02d-%02d" (D.year date) (D.month date) (D.day date) in + Cel.make ~slug:(Sl.of_string_exn slug) ~rank:Lo ~colour:Colour.Green ~layer:"synthetic-temporal" () + + let temporal date : (season, rank) Temporal.t = + { Temporal.season = season date; week = None; weekday = D.weekday date; office = office date } + + (* Band: Hi beats Lo; Temporal breaks a tie in its own favour -- the same + convention test_precedence.ml uses. *) + let band (_ : season P.context) (c : rank P.candidate) = + (match c.P.cel.Cel.rank with Hi -> 10 | Lo -> 20) + - (match c.P.origin with P.Temporal -> 1 | P.Sanctoral -> 0) + + let disposition ~winner:_ ~(loser : rank P.candidate) = + match loser.P.cel.Cel.rank with Lo -> P.Commemorate P.Ordinary | Hi -> P.Transfer + + let rules : (season, rank) P.rules = { P.band; disposition; admit = (fun ~observed:_ cs -> cs) } + + let rite : (season, rank) Rite.t = + { Rite.id = "synthetic-calendar"; vocab; year_start; temporal; anchors = (fun _ -> []); + rules; season_runs = [ A; B ] } + + let entry ~month ~day ~slug ~rank = + { Layer.date = (match Date_spec.fixed ~month ~day with Ok d -> d | Error e -> failwith e); + cel = Cel.make ~slug:(Sl.of_string_exn slug) ~rank ~colour:Colour.White + ~layer:"synthetic-sanctoral" () } + + let big_feast = entry ~month:12 ~day:8 ~slug:"big-feast" ~rank:Hi + let commem_worthy = entry ~month:12 ~day:15 ~slug:"commem-worthy" ~rank:Lo + + let layer = Layer.of_entries ~id:"synthetic" ~name:"Synthetic sanctoral" [ big_feast; commem_worthy ] + + let liturgical_year_of date = + let cy = D.year date in + if D.compare date (year_start cy) >= 0 then cy else cy - 1 +end + +let test_year_covers_every_day () = + let days = C.year Fixture.rite Fixture.layer 2026 in + let first = days.(0) and last = days.(Array.length days - 1) in + Alcotest.(check string) "starts at year_start" "2026-11-29" (D.to_iso8601 first.LD.date); + Alcotest.(check bool) "ends the day before next year_start" true + (D.compare last.LD.date (D.add_days (Fixture.rite.Rite.year_start 2027) (-1)) = 0); + (* every consecutive pair is exactly one day apart: no gaps, no duplicates *) + Array.iteri + (fun i d -> + if i > 0 then + Alcotest.(check int) "consecutive" 1 + (D.to_rata d.LD.date - D.to_rata days.(i - 1).LD.date)) + days + +let test_day_agrees_with_year () = + List.iter + (fun (y, m, dd) -> + let date = mk y m dd in + let from_day = C.day Fixture.rite Fixture.layer date in + let ys = C.year Fixture.rite Fixture.layer (Fixture.liturgical_year_of date) in + let from_year = Array.to_list ys |> List.find (fun d -> D.compare d.LD.date date = 0) in + Alcotest.(check string) "same observed" + (Sl.to_string from_year.LD.observed.Cel.slug) + (Sl.to_string from_day.LD.observed.Cel.slug)) + [ (2026, 12, 1); (2027, 3, 15); (2027, 7, 4) ] + +(* Two entries in the layer, per the brief: one that outranks the feria and + one that does not. Both sit on their own date so each assertion below + pins one behaviour without the other candidate muddying it. *) +let test_sanctoral_outranks_feria_becomes_observed () = + let days = C.year Fixture.rite Fixture.layer 2026 in + let date = mk 2026 12 8 in + let d = Array.to_list days |> List.find (fun d -> D.compare d.LD.date date = 0) in + Alcotest.(check string) "big-feast observed" "big-feast" (Sl.to_string d.LD.observed.Cel.slug) + +let test_lower_ranked_sanctoral_is_commemorated () = + let days = C.year Fixture.rite Fixture.layer 2026 in + let date = mk 2026 12 15 in + let d = Array.to_list days |> List.find (fun d -> D.compare d.LD.date date = 0) in + let expected_feria = Sl.to_string (Fixture.office date).Cel.slug in + Alcotest.(check string) "feria still observed" expected_feria (Sl.to_string d.LD.observed.Cel.slug); + Alcotest.(check (list string)) "commem-worthy commemorated" [ "commem-worthy" ] + (List.map (fun (c, _) -> Sl.to_string c.Cel.slug) d.LD.commemorations) + +(* Register/design lesson (Plan 2's Validate 9999 bug): [year_start (y + 1)] + at the top of the domain must not raise. Calling [C.year ... 9999] here + directly (no [try]) is itself part of the pin -- if the clamp regressed, + this call would raise and the test would error rather than fail cleanly. *) +let test_year_9999_does_not_raise () = + let days = C.year Fixture.rite Fixture.layer 9999 in + Alcotest.(check bool) "non-empty" true (Array.length days > 0); + Alcotest.(check string) "starts at year_start 9999" + (D.to_iso8601 (Fixture.rite.Rite.year_start 9999)) + (D.to_iso8601 days.(0).LD.date); + Alcotest.(check string) "ends at the domain ceiling" "9999-12-31" + (D.to_iso8601 days.(Array.length days - 1).LD.date) + +(* The symmetric case at the bottom: 1 January 1583 is the domain's earliest + representable date, and Fixture's Advent-anchored [year_start] puts it + well before that civil year's own year_start -- so [day] must resolve it + via the [y] = 1582 branch without calling [year_start 1582] (out of + domain). Checks identity (the date's own feria), not merely that + something came back. *) +let test_day_near_domain_floor_does_not_raise () = + let date = mk 1583 1 1 in + let d = C.day Fixture.rite Fixture.layer date in + Alcotest.(check string) "returns the queried date" "1583-01-01" (D.to_iso8601 d.LD.date); + Alcotest.(check string) "observed is the day's own feria" + (Sl.to_string (Fixture.office date).Cel.slug) (Sl.to_string d.LD.observed.Cel.slug) + +let suite = + ( "Calendar", + [ Alcotest.test_case "year covers every day" `Quick test_year_covers_every_day; + Alcotest.test_case "day agrees with year" `Quick test_day_agrees_with_year; + Alcotest.test_case "outranking sanctoral becomes observed" `Quick + test_sanctoral_outranks_feria_becomes_observed; + Alcotest.test_case "lower-ranked sanctoral is commemorated" `Quick + test_lower_ranked_sanctoral_is_commemorated; + Alcotest.test_case "year 9999 does not raise" `Quick test_year_9999_does_not_raise; + Alcotest.test_case "day near the domain floor does not raise" `Quick + test_day_near_domain_floor_does_not_raise ] ) diff --git a/test/test_colitur.ml b/test/test_colitur.ml index 08282e6..a97e35c 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -2,4 +2,5 @@ let () = Alcotest.run "colitur" [ Test_date.suite; Test_computus.suite; Test_colour.suite; Test_slug.suite; Test_names.suite; - Test_overlay.suite; Test_temporal_ef.suite; Test_validate.suite; Test_precedence.suite ] + Test_overlay.suite; Test_temporal_ef.suite; Test_validate.suite; Test_precedence.suite; + Test_calendar.suite ] -- cgit v1.3 From 953427d8d1e3a34994be53b60e18662ec26fef4e Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 20:07:55 +0200 Subject: kernel: carry omitted celebrations on Liturgical_day.t, reason and all Precedence.resolution already tracked what happened to every losing candidate -- commemorated, deferred, or omitted with a reason -- but Liturgical_day.t had nowhere for the deferred and omitted buckets to land, so Calendar dropped them at the door. Task 12's no-celebration-lost invariant needs to read that accounting off the day result itself, not re-resolve every day to reconstruct it, so a reason recorded nowhere is not recorded. Add Liturgical_day.omitted : ('r Celebration.t * string) list, after transferred_out and before citations. Calendar.resolve_day now folds resolution.omitted (Precedence's own native omissions, reasons intact) and resolution.deferred (mapped to "deferred: transfer placement not yet implemented (Task 6)") into it. Adds a full-day accounting test against the whole Calendar pipeline: four colliding sanctoral entries plus the day's feria, checked as a slug set (matching test_precedence.ml's own nothing-silently-lost test) so a candidate silently dropped or duplicated into two buckets would fail it, plus an identity check that the deferred and admission-limit reasons don't get swapped. --- lib/kernel/calendar.ml | 21 ++++++++++----- lib/kernel/calendar.mli | 13 ++++++--- lib/kernel/liturgical_day.ml | 3 +++ lib/kernel/liturgical_day.mli | 3 +++ test/test_calendar.ml | 63 ++++++++++++++++++++++++++++++++++++++++--- 5 files changed, 89 insertions(+), 14 deletions(-) (limited to 'lib') diff --git a/lib/kernel/calendar.ml b/lib/kernel/calendar.ml index fd23377..1cdd1fa 100644 --- a/lib/kernel/calendar.ml +++ b/lib/kernel/calendar.ml @@ -35,6 +35,15 @@ let year_bounds (rite : ('s, 'r) Rite.t) (y : int) : Date.t * Date.t = in (start, stop) +(* [resolution.deferred] (RG 96-98 transfer candidates) has nowhere to be + PLACED yet -- Task 6 adds the fixed-point pass that does -- but it must + still be accounted for on the day it lost, not silently dropped: Task + 12's no-celebration-lost invariant reads [Liturgical_day.omitted], so a + deferred candidate folds in there too, with its own reason distinct from + Precedence's native omissions ("omitted: yielded to a higher day", + "omitted: admission limit reached"). *) +let deferred_reason = "deferred: transfer placement not yet implemented (Task 6)" + (* RG 91's contest for one date: the temporal office against every sanctoral entry whose Date_spec resolves to it. [Layer.on_date] is keyed on exactly (month, day), which for a [Fixed] spec -- the only form Plan 2 ships -- is @@ -53,13 +62,10 @@ let resolve_day (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) (date : Date.t in let ctx = { Precedence.date; season = temporal.Temporal.season; weekday = temporal.Temporal.weekday } in let resolution = Precedence.resolve rite.Rite.rules ctx ~temporal:temporal_candidate ~sanctoral in - (* [resolution.deferred] (RG 96-98 transfer candidates) and - [resolution.omitted] (yielded/admission-limit losers) have no field to - land in on Liturgical_day.t yet, so both are simply absent from today's - result -- deliberately incomplete for a deferred candidate, which is - thereby neither observed nor commemorated here, and not yet placed on - any later day either ("deferred: transfer placement not yet implemented - (Task 6)"). Task 6's fixed-point pass closes this gap. *) + let omitted = + List.map (fun (c, reason) -> (c.Precedence.cel, reason)) resolution.Precedence.omitted + @ List.map (fun c -> (c.Precedence.cel, deferred_reason)) resolution.Precedence.deferred + in { Liturgical_day.date; rite = rite.Rite.id; @@ -69,6 +75,7 @@ let resolve_day (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) (date : Date.t List.map (fun (c, p) -> (c.Precedence.cel, p)) resolution.Precedence.commemorations; transferred_in = None; transferred_out = None; + omitted; citations = []; } diff --git a/lib/kernel/calendar.mli b/lib/kernel/calendar.mli index 50ff8f8..2469f2a 100644 --- a/lib/kernel/calendar.mli +++ b/lib/kernel/calendar.mli @@ -9,10 +9,15 @@ This module resolves each day's temporal-vs-sanctoral contest but does not yet place deferred transfers (RG 96-98): a losing candidate the - rite's rules send to [Precedence.Transfer] is absent from the result - entirely on this pass -- not observed, not commemorated, and - [transferred_in]/[transferred_out] both stay [None] everywhere. Task 6 - adds the fixed-point placement pass that closes this gap. *) + rite's rules send to [Precedence.Transfer] is not observed and not + commemorated on the day it lost, and [transferred_in]/[transferred_out] + both stay [None] everywhere -- but it is not silently dropped either. It + lands in that day's [Liturgical_day.omitted] with the reason ["deferred: + transfer placement not yet implemented (Task 6)"], alongside + [Precedence]'s own native omissions (yielded to a higher day; admission + limit reached), each with its own reason. Task 6 adds the fixed-point + placement pass that actually places these; until then, this is the + day's complete, honest accounting of what happened to every candidate. *) (** [year rite layer y] resolves every day of the liturgical year that opens in civil year [y]: from [rite.year_start y] through the day before diff --git a/lib/kernel/liturgical_day.ml b/lib/kernel/liturgical_day.ml index 65e3ba5..cbaca9c 100644 --- a/lib/kernel/liturgical_day.ml +++ b/lib/kernel/liturgical_day.ml @@ -14,6 +14,9 @@ type ('s, 'r) t = { (** arrived here from an impeded day *) transferred_out : Date.t option; (** this day's celebration went there *) + omitted : ('r Celebration.t * string) list; + (** with the reason, never silent -- Task 12's no-celebration-lost + invariant reads this *) citations : Citation.t list; (** always empty until Plan 4 *) } [@@deriving sexp] diff --git a/lib/kernel/liturgical_day.mli b/lib/kernel/liturgical_day.mli index 3c331c3..38e7c76 100644 --- a/lib/kernel/liturgical_day.mli +++ b/lib/kernel/liturgical_day.mli @@ -12,6 +12,9 @@ type ('s, 'r) t = { (** arrived here from an impeded day *) transferred_out : Date.t option; (** this day's celebration went there *) + omitted : ('r Celebration.t * string) list; + (** with the reason, never silent -- Task 12's no-celebration-lost + invariant reads this *) citations : Citation.t list; (** always empty until Plan 4 *) } [@@deriving sexp] diff --git a/test/test_calendar.ml b/test/test_calendar.ml index a3c4125..d34611a 100644 --- a/test/test_calendar.ml +++ b/test/test_calendar.ml @@ -68,7 +68,12 @@ module Fixture = struct let disposition ~winner:_ ~(loser : rank P.candidate) = match loser.P.cel.Cel.rank with Lo -> P.Commemorate P.Ordinary | Hi -> P.Transfer - let rules : (season, rank) P.rules = { P.band; disposition; admit = (fun ~observed:_ cs -> cs) } + (* Admits at most one commemoration -- mirrors test_precedence.ml's own + example and, unlike "admit everything", actually gives the accounting + 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:_ cs -> List.filteri (fun i _ -> i < 1) cs) } let rite : (season, rank) Rite.t = { Rite.id = "synthetic-calendar"; vocab; year_start; temporal; anchors = (fun _ -> []); @@ -82,7 +87,23 @@ module Fixture = struct let big_feast = entry ~month:12 ~day:8 ~slug:"big-feast" ~rank:Hi let commem_worthy = entry ~month:12 ~day:15 ~slug:"commem-worthy" ~rank:Lo - let layer = Layer.of_entries ~id:"synthetic" ~name:"Synthetic sanctoral" [ big_feast; commem_worthy ] + (* 20 Dec: four sanctoral entries on one date, for the full-accounting test. + "day-winner" and "eclipsed" tie on band (both Hi, both Sanctoral); ties + break on slug, so "day-winner" wins and "eclipsed" -- a Hi-rank loser -- + is [Transfer]-disposed, landing in [deferred]. "loser-a" and "loser-b" + are both Lo, both [Commemorate]-disposed, but [admit] only keeps one: + the other lands in Precedence's own [omitted] ("admission limit + reached"), distinct from "eclipsed"'s deferred reason. Four candidates, + three different fates -- observed, one specific omission reason, two + more. *) + let day_winner = entry ~month:12 ~day:20 ~slug:"day-winner" ~rank:Hi + let eclipsed = entry ~month:12 ~day:20 ~slug:"eclipsed" ~rank:Hi + let loser_a = entry ~month:12 ~day:20 ~slug:"loser-a" ~rank:Lo + let loser_b = entry ~month:12 ~day:20 ~slug:"loser-b" ~rank:Lo + + let layer = + Layer.of_entries ~id:"synthetic" ~name:"Synthetic sanctoral" + [ big_feast; commem_worthy; day_winner; eclipsed; loser_a; loser_b ] let liturgical_year_of date = let cy = D.year date in @@ -159,6 +180,41 @@ let test_day_near_domain_floor_does_not_raise () = Alcotest.(check string) "observed is the day's own feria" (Sl.to_string (Fixture.office date).Cel.slug) (Sl.to_string d.LD.observed.Cel.slug) +(* Full-day accounting through the whole Calendar pipeline (Layer -> Calendar + -> Liturgical_day), not just Precedence in isolation: every candidate fed + in for 20 Dec 2026 -- the feria plus Fixture's four colliding sanctoral + entries -- appears exactly once across observed/commemorations/omitted. + Checked as a slug SET (Alcotest.slist), matching test_precedence.ml's own + "nothing silently lost" test: a length-only check would pass even if one + slug were duplicated into two buckets and another dropped, which this + project has shipped before (register finding). *) +let test_full_day_accounting () = + let date = mk 2026 12 20 in + let d = C.day Fixture.rite Fixture.layer date in + let feria_slug = Sl.to_string (Fixture.office date).Cel.slug in + let bucketed = + (Sl.to_string d.LD.observed.Cel.slug + :: List.map (fun (c, _) -> Sl.to_string c.Cel.slug) d.LD.commemorations) + @ List.map (fun (c, _) -> Sl.to_string c.Cel.slug) d.LD.omitted + in + Alcotest.(check (slist string compare)) "every candidate appears exactly once" + [ feria_slug; "day-winner"; "eclipsed"; "loser-a"; "loser-b" ] + bucketed; + (* Identity within [omitted], not just membership: "eclipsed" (a deferred + transfer candidate, RG 96-98) must carry the deferred reason, not + Precedence's native "admission limit reached" that "loser-a"/"loser-b" + -- the ones Precedence itself dropped -- carry. Without this, a bug + that folded [resolution.deferred] into [omitted] with the wrong reason, + or dropped [resolution.omitted]'s own reasons, would still pass the + slug-set check above. *) + let reason_of slug = + d.LD.omitted |> List.find (fun (c, _) -> Sl.to_string c.Cel.slug = slug) |> snd + in + Alcotest.(check string) "eclipsed carries the deferred reason" + "deferred: transfer placement not yet implemented (Task 6)" (reason_of "eclipsed"); + Alcotest.(check string) "loser-a carries Precedence's own admission-limit reason" + "omitted: admission limit reached" (reason_of "loser-a") + let suite = ( "Calendar", [ Alcotest.test_case "year covers every day" `Quick test_year_covers_every_day; @@ -169,4 +225,5 @@ let suite = test_lower_ranked_sanctoral_is_commemorated; Alcotest.test_case "year 9999 does not raise" `Quick test_year_9999_does_not_raise; Alcotest.test_case "day near the domain floor does not raise" `Quick - test_day_near_domain_floor_does_not_raise ] ) + test_day_near_domain_floor_does_not_raise; + Alcotest.test_case "full day accounting" `Quick test_full_day_accounting ] ) -- cgit v1.3 From f15e44dd4c1b871c2daeb952b1c8c848274ea1f1 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 21:03:00 +0200 Subject: kernel(calendar): place transferred celebrations (RG 96-98) Calendar.year now runs a placement pass after resolving every day: each deferred candidate (RG 95's I-class-only right of translation, via Precedence's Transfer disposition) is placed on the next day the rite's new Rite.t.transfer_target names as admissible, transferred_in/out are set on the two ends of the move, and the whole year is re-resolved to a fixed point, bounded by a hard max_transfer_rounds = 64 guard. transfer_target is rite-supplied rather than a generic search Calendar drives itself: RG 96's 'not I or II class' is not derivable from band or disposition alone (RG 91's own table lets a universal I-class feast outrank an ordinary Sunday in a raw contest, yet RG 96 forbids landing a translation there regardless), and the search's starting point is rite-specific too (the Annunciation exception). It takes an occupant callback exposing what Calendar currently resolves as observed on any date, so the rite never has to re-implement occurrence resolution. Two correctness properties drove most of the design: - A candidate's permanent natural loss at its own origin (the layer entry never moves) is rediscovered every round; left unfiltered this oscillates a placed candidate between two dates forever, since its own rank makes it look 'occupied' to a fresh search from its origin. Both the round loop's gather and the final per-day omitted accounting filter this out, keeping only sightings that are either brand new or losing at a candidate's *current* target (a fresh RG 97-98 bump). - RG 97-98's sort has to actually decide something, not just happen to agree with Precedence.resolve's own tie-break next round: a claimed-this-round overlay lets earlier-processed candidates in one round block later ones in the same pass, so two coinciding I-class feasts land on consecutive admissible days in the one round they collide, in band order. Also folds in Task 5's review finding: year_bounds clamps y to [1582, 9999] once, up front, rather than guarding start and stop independently (each guard only ever covered one of the two rite.year_start calls, leaving year 999 and year 100000 each able to call it out of domain through the other branch). --- lib/kernel/calendar.ml | 256 +++++++++++++++++++++++++++++++++++++++++++----- lib/kernel/calendar.mli | 29 +++--- lib/kernel/rite.ml | 2 + lib/kernel/rite.mli | 24 +++++ test/test_calendar.ml | 177 +++++++++++++++++++++++++++++---- test/test_validate.ml | 13 ++- 6 files changed, 444 insertions(+), 57 deletions(-) (limited to 'lib') diff --git a/lib/kernel/calendar.ml b/lib/kernel/calendar.ml index 1cdd1fa..1ad45a1 100644 --- a/lib/kernel/calendar.ml +++ b/lib/kernel/calendar.ml @@ -27,44 +27,249 @@ let domain_max_date = year by at most one, so [y] = 1582 is the sole way this branch is reached. Clamp [start] to 1 January 1583: "year 1582" becomes the truncated stretch from the domain floor up to the day before [rite.year_start 1583], - which is exactly the sliver a date there needs. *) + which is exactly the sliver a date there needs. + + [y] itself is clamped once, up front, to [1582, 9999] -- not left to each + branch's own guard. Task 5's review found that guarding [start] and [stop] + independently protected only one of their two [rite.year_start] calls + each: [start]'s guard (["y < 1583"]) leaves [stop]'s "y + 1" call + unguarded at the bottom (["year 999"] still called [year_start 1000], out + of domain), and [stop]'s guard (["y >= 9999"]) leaves [start]'s call + unguarded at the top (["year 100000"] still called [year_start 100000]). + Neither is reachable through [day] (see calendar.mli), but [year] is + public, and a direct out-of-contract call must not raise either. Clamping + [y] once closes both gaps with one check instead of two. *) let year_bounds (rite : ('s, 'r) Rite.t) (y : int) : Date.t * Date.t = + let y = max 1582 (min 9999 y) in let start = if y < 1583 then domain_min_date else rite.Rite.year_start y in let stop = if y >= 9999 then domain_max_date else Date.add_days (rite.Rite.year_start (y + 1)) (-1) in (start, stop) -(* [resolution.deferred] (RG 96-98 transfer candidates) has nowhere to be - PLACED yet -- Task 6 adds the fixed-point pass that does -- but it must - still be accounted for on the day it lost, not silently dropped: Task - 12's no-celebration-lost invariant reads [Liturgical_day.omitted], so a - deferred candidate folds in there too, with its own reason distinct from - Precedence's native omissions ("omitted: yielded to a higher day", - "omitted: admission limit reached"). *) -let deferred_reason = "deferred: transfer placement not yet implemented (Task 6)" - (* RG 91's contest for one date: the temporal office against every sanctoral - entry whose Date_spec resolves to it. [Layer.on_date] is keyed on exactly - (month, day), which for a [Fixed] spec -- the only form Plan 2 ships -- is - the same test as resolving the spec against [date]'s own year and - comparing, so no separate filter is needed here. *) -let resolve_day (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) (date : Date.t) : - ('s, 'r) Liturgical_day.t = + entry whose Date_spec resolves to it, plus whatever the placement pass + below has [injected] there so far (a celebration transferred in from an + impeded day elsewhere). [Layer.on_date] is keyed on exactly (month, day), + which for a [Fixed] spec -- the only form Plan 2 ships -- is the same test + as resolving the spec against [date]'s own year and comparing, so no + separate filter is needed here. + + [injected] is keyed by [Date.to_rata] rather than [Date.t] directly: + [Date.t] carries no [compare]-respecting hash, and rata-die is already the + canonical total order this module uses for date arithmetic. *) +let resolve_with_injected (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) + (injected : (int, 'r Precedence.candidate list) Hashtbl.t) (date : Date.t) : + ('s, 'r) Temporal.t * 's Precedence.context * 'r Precedence.resolution = let temporal = rite.Rite.temporal date in let temporal_candidate = { Precedence.cel = temporal.Temporal.office; origin = Precedence.Temporal } in - let sanctoral = + let natural = Layer.on_date idx ~month:(Date.month date) ~day:(Date.day date) |> List.map (fun (e : 'r Layer.entry) -> { Precedence.cel = e.Layer.cel; origin = Precedence.Sanctoral }) in + let arrived = try Hashtbl.find injected (Date.to_rata date) with Not_found -> [] in let ctx = { Precedence.date; season = temporal.Temporal.season; weekday = temporal.Temporal.weekday } in - let resolution = Precedence.resolve rite.Rite.rules ctx ~temporal:temporal_candidate ~sanctoral in + let resolution = + Precedence.resolve rite.Rite.rules ctx ~temporal:temporal_candidate ~sanctoral:(natural @ arrived) + in + (temporal, ctx, resolution) + +(* What Precedence.resolve currently reports as observed on [date], given the + placements decided so far -- this is exactly the [occupant] callback + Rite.transfer_target's search walks forward with (rite.mli explains why + that judgement has to come from the rite, not from here). *) +let occupant_of (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) + (injected : (int, 'r Precedence.candidate list) Hashtbl.t) (date : Date.t) : 'r Celebration.t = + let _, _, resolution = resolve_with_injected rite idx injected date in + resolution.Precedence.observed.Precedence.cel + +(* Hard guard on the placement fixed point (spec §2.4): every genuine + transfer moves a celebration strictly forward and the celebration set is + finite, so the round below always empties [deferred] within a handful of + rounds in practice (an RG 97-98 collision of N feasts on one date costs at + most N-1 extra rounds -- each round resolves the winner of whatever pile-up + occurred and re-defers the rest, one fewer each time). 64 is not tuned to + that bound; it is a defensive ceiling nothing in the 1962 calendar comes + close to, so that a rite/data combination this module has not anticipated + fails as a recorded, inspectable [omitted] reason (below) instead of + hanging the CLI. *) +let max_transfer_rounds = 64 + +let unconverged_reason = + "omitted: transfer placement did not converge within max_transfer_rounds (RG 96-98)" + +(* Rebuilds the per-date injection index from [assignment] (slug -> (origin, + target)) fresh each round, rather than accumulating it incrementally as + candidates are placed. A candidate re-deferred in a later round (its first + target turned out to already be claimed by a higher-band rival, see + [place_transfers]) must vacate its old target date entirely, not merely + gain a second one; rebuilding from a slug-keyed map, which holds exactly + one entry per candidate, gives that for free. An append-only structure + would instead leave the stale placement behind forever, and the round + loop would never see [deferred] empty out. *) +let injected_index_of_assignment (assignment : (string, Date.t * Date.t) Hashtbl.t) + (candidate_by_slug : (string, 'r Precedence.candidate) Hashtbl.t) : + (int, 'r Precedence.candidate list) Hashtbl.t = + let tbl : (int, 'r Precedence.candidate list) Hashtbl.t = Hashtbl.create 16 in + Hashtbl.iter + (fun slug (_origin, target) -> + let key = Date.to_rata target in + let c = Hashtbl.find candidate_by_slug slug in + Hashtbl.replace tbl key (c :: (try Hashtbl.find tbl key with Not_found -> []))) + assignment; + tbl + +(* The placement pass itself (spec §2.4 steps 1-4; step 5, recording + transferred_in/out, is [year]'s job once this reaches a fixed point). + + Each round: gather every currently-deferred candidate across the whole + year (fresh, against this round's [injected] state -- a candidate already + placed and now winning its target is no longer a loser anywhere and so + will not reappear here); if none, the fixed point is reached. Otherwise + sort ALL of them by band -- RG 97-98: this is the global ordering that + decides who transfers first when I-class feasts coincide -- ties break on + slug, same convention as Precedence.compare_by, so placement never depends + on the layer's own entry order. Then place each in turn, in that order. + + [claimed_this_round] is what makes the sort actually decide anything: it + starts empty every round and gains one entry per candidate placed so far + THIS round, and [occupant_with_claims] reports a claimed date as occupied + by whoever claimed it, layered on top of [injected] (last round's settled + state, frozen for the round -- see [injected_index_of_assignment] for why + that has to stay frozen rather than being updated in place). Without it, + every candidate in a round would search against the exact same snapshot + and a same-date collision would only be caught (and only one side of it + corrected) on re-resolution next round, one collision layer per round -- + RG 97-98's own ordering would still come out right in the end, but only + by accident of Precedence.resolve's own internal tie-break repeating this + module's, not because this module's sort ever decided anything. Layering + the claims instead means a same-round collision is resolved in the one + round it is found, in the sorted order, and the earlier RG 97-98 test + pins exactly that: it fails on "claims 2 Feb first" without this. *) +let place_transfers (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) (dates : Date.t array) : + (string, Date.t * Date.t) Hashtbl.t * (string, 'r Precedence.candidate) Hashtbl.t = + let assignment : (string, Date.t * Date.t) Hashtbl.t = Hashtbl.create 16 in + let candidate_by_slug : (string, 'r Precedence.candidate) Hashtbl.t = Hashtbl.create 16 in + let compare_deferred (_, ctx1, c1) (_, ctx2, c2) = + let b1 = rite.Rite.rules.Precedence.band ctx1 c1 in + let b2 = rite.Rite.rules.Precedence.band ctx2 c2 in + if b1 <> b2 then Int.compare b1 b2 + else Slug.compare c1.Precedence.cel.Celebration.slug c2.Precedence.cel.Celebration.slug + in + let round = ref 0 in + let converged = ref false in + let guard_hit = ref false in + while (not !converged) && not !guard_hit do + incr round; + if !round > max_transfer_rounds then guard_hit := true + else begin + let injected = injected_index_of_assignment assignment candidate_by_slug in + let raw = + Array.to_list dates + |> List.concat_map (fun date -> + let _, ctx, resolution = resolve_with_injected rite idx injected date in + List.map (fun c -> (date, ctx, c)) resolution.Precedence.deferred) + in + (* [raw] rediscovers every candidate's *permanent* natural loss at its + origin every round -- the layer entry never moves, so a candidate + already settled elsewhere still shows up losing at the date it was + always going to lose at. Left unfiltered, that stale sighting gets + placed again right next to the candidate's own already-settled + self, which -- because a placed candidate's own rank makes it look + "occupied" to a fresh search starting from its original origin -- + oscillates between two dates forever, never reaching [deferred = + []] (confirmed by removing this filter: "transferable" lands on 14 + Jan instead of 13 in test_transfer_moves_and_does_not_duplicate, + not merely "doesn't converge" -- the bug is a wrong answer, not + only a hang). A sighting is genuinely actionable only if the + candidate has never been placed yet (first time seen), or if it is + losing exactly at the date it is *currently* assigned to (a fresh + RG 97-98 bump: something else also landed there and out-ranked it) + -- any other date is the stale, permanent one and is dropped. *) + let deferred = + List.filter + (fun (date, _ctx, c) -> + match Hashtbl.find_opt assignment (Slug.to_string c.Precedence.cel.Celebration.slug) with + | None -> true + | Some (_, target) -> Date.compare date target = 0) + raw + in + if deferred = [] then converged := true + else begin + let claimed_this_round : (int, 'r Precedence.candidate) Hashtbl.t = Hashtbl.create 4 in + let occupant_with_claims d = + match Hashtbl.find_opt claimed_this_round (Date.to_rata d) with + | Some c -> c.Precedence.cel + | None -> occupant_of rite idx injected d + in + List.stable_sort compare_deferred deferred + |> List.iter (fun (origin, _ctx, c) -> + let target = rite.Rite.transfer_target c origin occupant_with_claims in + let slug = Slug.to_string c.Precedence.cel.Celebration.slug in + Hashtbl.replace claimed_this_round (Date.to_rata target) c; + Hashtbl.replace assignment slug (origin, target); + Hashtbl.replace candidate_by_slug slug c) + end + end + done; + (assignment, candidate_by_slug) + +(* The final build of one day, once placement has reached its fixed point (or + exhausted the guard): resolve against the settled [injected] state, then + layer on [transferred_in] (this date received an injected candidate that + went on to win) and [transferred_out] (some candidate's settled placement + originated here). + + [transferred_out] is a single [Date.t option] (Liturgical_day.mli), so it + cannot represent two different celebrations leaving the same origin day + for two different destinations. [transferred_out_of] is built with + last-write-wins for that (unreached) case; RG 97-98 collisions still + report correctly because what actually matters -- each celebration landing + on its own, correctly-ordered day, exactly once -- is carried by + [observed]/[transferred_in], not by this pointer. *) +let build_day (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) + (assignment : (string, Date.t * Date.t) Hashtbl.t) + (injected : (int, 'r Precedence.candidate list) Hashtbl.t) + (transferred_out_of : (int, Date.t) Hashtbl.t) (date : Date.t) : ('s, 'r) Liturgical_day.t = + let temporal, _ctx, resolution = resolve_with_injected rite idx injected date in + let arrived = try Hashtbl.find injected (Date.to_rata date) with Not_found -> [] in + let transferred_in = + arrived + |> List.find_opt (fun c -> + Slug.equal c.Precedence.cel.Celebration.slug + resolution.Precedence.observed.Precedence.cel.Celebration.slug) + |> Option.map (fun c -> c.Precedence.cel) + in + let transferred_out = + try Some (Hashtbl.find transferred_out_of (Date.to_rata date)) with Not_found -> None + in + (* [resolution.deferred] here is NOT "the placement pass never got to + these": it is the origin day's own permanent, structural loss -- the + layer entry that lost the RG 91 contest here never moves, so a + candidate successfully placed somewhere else still shows up losing at + the exact date it was always going to lose at (this is the same fact + [place_transfers]'s round loop has to filter around, see its comment). + A [deferred] sighting only belongs in [omitted] if it was never + actually settled anywhere -- i.e. the guard above was hit before this + candidate reached a day it wins. Settled elsewhere means genuinely + accounted for via [observed]/[transferred_in] on the day it landed and + [transferred_out] here, not via [omitted] too -- double-booking it in + both would fail Task 12's "appears exactly once" reading of this day + alone. *) + let unresolved c = + let slug = Slug.to_string c.Precedence.cel.Celebration.slug in + match Hashtbl.find_opt assignment slug with + | None -> true + | Some (_, target) -> + not (Slug.equal (occupant_of rite idx injected target).Celebration.slug c.Precedence.cel.Celebration.slug) + in let omitted = List.map (fun (c, reason) -> (c.Precedence.cel, reason)) resolution.Precedence.omitted - @ List.map (fun c -> (c.Precedence.cel, deferred_reason)) resolution.Precedence.deferred + @ (resolution.Precedence.deferred |> List.filter unresolved + |> List.map (fun c -> (c.Precedence.cel, unconverged_reason))) in { Liturgical_day.date; @@ -73,8 +278,8 @@ let resolve_day (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) (date : Date.t observed = resolution.Precedence.observed.Precedence.cel; commemorations = List.map (fun (c, p) -> (c.Precedence.cel, p)) resolution.Precedence.commemorations; - transferred_in = None; - transferred_out = None; + transferred_in; + transferred_out; omitted; citations = []; } @@ -90,7 +295,14 @@ let year (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) (y : int) : [year] is public, and a direct out-of-contract call must not raise either. *) let n = max 0 (Date.to_rata stop - Date.to_rata start + 1) in - Array.init n (fun i -> resolve_day rite idx (Date.add_days start i)) + let dates = Array.init n (fun i -> Date.add_days start i) in + let assignment, candidate_by_slug = place_transfers rite idx dates in + let injected = injected_index_of_assignment assignment candidate_by_slug in + let transferred_out_of : (int, Date.t) Hashtbl.t = Hashtbl.create 16 in + Hashtbl.iter + (fun _slug (origin, target) -> Hashtbl.replace transferred_out_of (Date.to_rata origin) target) + assignment; + Array.map (build_day rite idx assignment injected transferred_out_of) dates let day (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) (date : Date.t) : ('s, 'r) Liturgical_day.t = diff --git a/lib/kernel/calendar.mli b/lib/kernel/calendar.mli index 2469f2a..9fbd7e7 100644 --- a/lib/kernel/calendar.mli +++ b/lib/kernel/calendar.mli @@ -7,23 +7,28 @@ one pass -- and [day] is derived: it finds the liturgical year containing a date and indexes into it. Both are pure; neither caches. - This module resolves each day's temporal-vs-sanctoral contest but does - not yet place deferred transfers (RG 96-98): a losing candidate the - rite's rules send to [Precedence.Transfer] is not observed and not - commemorated on the day it lost, and [transferred_in]/[transferred_out] - both stay [None] everywhere -- but it is not silently dropped either. It - lands in that day's [Liturgical_day.omitted] with the reason ["deferred: - transfer placement not yet implemented (Task 6)"], alongside - [Precedence]'s own native omissions (yielded to a higher day; admission - limit reached), each with its own reason. Task 6 adds the fixed-point - placement pass that actually places these; until then, this is the - day's complete, honest accounting of what happened to every candidate. *) + Once every day's temporal-vs-sanctoral contest is resolved, [year] places + every deferred candidate (RG 96-98): a losing I-class candidate the + rite's rules send to [Precedence.Transfer] does not stay put -- it moves + to the next day [rite.transfer_target] names as admissible, and both + ends of the move are recorded ([transferred_in] on the day it arrives, + [transferred_out] on the day it left). Every deferred candidate is + accounted for exactly once: placed, or -- only if the placement fixed + point is not reached within the round guard, which nothing in the 1962 + calendar is expected to trigger -- left in [Liturgical_day.omitted] with + a reason that says so, never silently dropped. See [calendar.ml]'s + [place_transfers] for the algorithm and its termination argument. *) (** [year rite layer y] resolves every day of the liturgical year that opens in civil year [y]: from [rite.year_start y] through the day before [rite.year_start (y + 1)], inclusive of both ends. - Total over 1583..9999, including the boundary years: + Total over 1583..9999, including the boundary years, and beyond them too: + [y] is clamped to [1582, 9999] before either bound is computed (not just + guarded near the two edges independently -- see [year_bounds] in + [calendar.ml] for why that distinction matters), so [year] never raises + regardless of the [y] it is given, not only for values near the domain + edge. - At [y] = 9999, [rite.year_start (y + 1)] would ask for civil year 10000, out of {!Date}'s domain (this is the bug Plan 2 shipped in [Validate] and later fixed). The end of the walk clamps to 31 December diff --git a/lib/kernel/rite.ml b/lib/kernel/rite.ml index b948390..89fceb6 100644 --- a/lib/kernel/rite.ml +++ b/lib/kernel/rite.ml @@ -9,4 +9,6 @@ type ('s, 'r) t = { anchors : int -> (string * Date.t) list; rules : ('s, 'r) Precedence.rules; season_runs : 's list; + transfer_target : + 'r Precedence.candidate -> Date.t -> (Date.t -> 'r Celebration.t) -> Date.t; } diff --git a/lib/kernel/rite.mli b/lib/kernel/rite.mli index db8e86f..6d12dd4 100644 --- a/lib/kernel/rite.mli +++ b/lib/kernel/rite.mli @@ -15,4 +15,28 @@ type ('s, 'r) t = { (** the expected run-length-compressed season sequence over one liturgical year. NOT necessarily [vocab.seasons]: a rite may have one season appear in two separate runs (the modern form's Ordinary Time does). *) + transfer_target : + 'r Precedence.candidate -> Date.t -> (Date.t -> 'r Celebration.t) -> Date.t; + (** RG 96: where an impeded I-class feast goes. Given the deferred + candidate, the date it was impeded on, and [occupant] -- a callback + exposing what {!Calendar} currently resolves as observed on any + given date -- returns the date to place it on. + + Deliberately one rite-supplied function, not a generic search Calendar + drives itself: "not I or II class" is not derivable from [band] or + [disposition] alone. RG 91's own table would let a universal I-class + feast (entry 11) numerically outrank an ordinary Sunday (entry 15, + II class) in a raw occurrence contest -- entry 11 comes before entry + 15, and lower wins -- so testing "would the translated feast win + here" is not the same question as "is this day free to receive a + translation": RG 96 forbids landing on the Sunday regardless of + which one would structurally win. Only the rite knows which of its + own ranks are exempt from translation onto them. The rite also + owns the search's starting point, because RG 96's exception is + rite-specific too: the Annunciation does not search forward from + its own impeded date at all, it goes straight to the Monday after + Low Sunday (searching onward from there only if that day is itself + blocked). [occupant] is supplied rather than a raw layer/temporal + pair so the rite never has to re-implement occurrence resolution + just to answer "what sits here". *) } diff --git a/test/test_calendar.ml b/test/test_calendar.ml index d34611a..70823a4 100644 --- a/test/test_calendar.ml +++ b/test/test_calendar.ml @@ -75,9 +75,21 @@ module Fixture = struct let rules : (season, rank) P.rules = { P.band; disposition; admit = (fun ~observed:_ cs -> List.filteri (fun i _ -> i < 1) cs) } + (* RG 96, generic form: search forward from the day after [origin] for the + first day whose occupant is not "blocking" -- in this synthetic + vocabulary Hi stands in for I/II class, Lo for everything else (the same + convention [band] already uses). No Annunciation-style starting-point + override: that exception is EF-specific (RG 96) and belongs to the real + rite (Task 11, pinned by Task 17's golden years), not to this + abstraction-level fixture, which only has to prove Calendar's placement + mechanism, not EF's own rubrics. *) + let transfer_target (_ : rank P.candidate) (origin : D.t) (occupant : D.t -> rank Cel.t) : D.t = + let rec search d = if (occupant d).Cel.rank = Lo then d else search (D.add_days d 1) in + search (D.add_days origin 1) + let rite : (season, rank) Rite.t = { Rite.id = "synthetic-calendar"; vocab; year_start; temporal; anchors = (fun _ -> []); - rules; season_runs = [ A; B ] } + rules; season_runs = [ A; B ]; transfer_target } let entry ~month ~day ~slug ~rank = { Layer.date = (match Date_spec.fixed ~month ~day with Ok d -> d | Error e -> failwith e); @@ -105,6 +117,35 @@ module Fixture = struct Layer.of_entries ~id:"synthetic" ~name:"Synthetic sanctoral" [ big_feast; commem_worthy; day_winner; eclipsed; loser_a; loser_b ] + (* RG 96 (Task 6): "transferable" is impeded on 10 Jan by "blocker-a" (both + Hi; ties break on slug, "blocker-a" < "transferable", so "blocker-a" + wins and "transferable" is the loser). 11 and 12 Jan are ALSO occupied + by their own uncontested Hi-rank entries, so the placement search must + walk past more than one ineligible day, not just try origin+1 and stop. + 13 Jan carries nothing, so the feria (Lo) is the first admissible day. *) + let blocker_a = entry ~month:1 ~day:10 ~slug:"blocker-a" ~rank:Hi + let transferable = entry ~month:1 ~day:10 ~slug:"transferable" ~rank:Hi + let blocker_b = entry ~month:1 ~day:11 ~slug:"blocker-b" ~rank:Hi + let blocker_c = entry ~month:1 ~day:12 ~slug:"blocker-c" ~rank:Hi + + (* RG 97-98: three Hi-rank entries coincide on 1 Feb. Sorted by band then + slug (all three tie on band, since Fixture's [band] only reads rank): + "collision-winner" < "transfer-a" < "transfer-b". The winner keeps 1 + Feb; the other two -- both losers, both Hi, both [Transfer]-disposed -- + must transfer in that same order. 2 and 3 Feb carry nothing of their + own, so they are the two admissible days the pair must land on, + consecutively, in that order: "transfer-a" (the higher-precedence + loser) gets first claim on 2 Feb, pushing "transfer-b" to 3 Feb. *) + let collision_winner = entry ~month:2 ~day:1 ~slug:"collision-winner" ~rank:Hi + let transfer_a = entry ~month:2 ~day:1 ~slug:"transfer-a" ~rank:Hi + let transfer_b = entry ~month:2 ~day:1 ~slug:"transfer-b" ~rank:Hi + + let layer_with_collision = + Layer.of_entries ~id:"synthetic-with-collision" ~name:"Synthetic sanctoral (with collisions)" + [ big_feast; commem_worthy; day_winner; eclipsed; loser_a; loser_b; + blocker_a; transferable; blocker_b; blocker_c; + collision_winner; transfer_a; transfer_b ] + let liturgical_year_of date = let cy = D.year date in if D.compare date (year_start cy) >= 0 then cy else cy - 1 @@ -183,11 +224,19 @@ let test_day_near_domain_floor_does_not_raise () = (* Full-day accounting through the whole Calendar pipeline (Layer -> Calendar -> Liturgical_day), not just Precedence in isolation: every candidate fed in for 20 Dec 2026 -- the feria plus Fixture's four colliding sanctoral - entries -- appears exactly once across observed/commemorations/omitted. - Checked as a slug SET (Alcotest.slist), matching test_precedence.ml's own - "nothing silently lost" test: a length-only check would pass even if one - slug were duplicated into two buckets and another dropped, which this - project has shipped before (register finding). *) + entries -- is accounted for exactly once across + observed/commemorations/omitted/transferred_out. Checked as a slug SET + (Alcotest.slist), matching test_precedence.ml's own "nothing silently + lost" test: a length-only check would pass even if one slug were + duplicated into two buckets and another dropped, which this project has + shipped before (register finding). + + "eclipsed" -- the Hi-rank loser on 20 Dec -- no longer sits in [omitted] + here (that was Task 5's honest placeholder, before Task 6 existed to + place it): RG 95 gives an I-class loser the right of translation, so it + is genuinely gone from this day's own accounting, and its departure is + what [transferred_out] records instead. [test_transfer_moves_and_does_not_duplicate] + below is what actually pins where it lands. *) let test_full_day_accounting () = let date = mk 2026 12 20 in let d = C.day Fixture.rite Fixture.layer date in @@ -197,23 +246,109 @@ let test_full_day_accounting () = :: List.map (fun (c, _) -> Sl.to_string c.Cel.slug) d.LD.commemorations) @ List.map (fun (c, _) -> Sl.to_string c.Cel.slug) d.LD.omitted in - Alcotest.(check (slist string compare)) "every candidate appears exactly once" - [ feria_slug; "day-winner"; "eclipsed"; "loser-a"; "loser-b" ] + Alcotest.(check (slist string compare)) "every non-transferred candidate appears exactly once" + [ feria_slug; "day-winner"; "loser-a"; "loser-b" ] bucketed; - (* Identity within [omitted], not just membership: "eclipsed" (a deferred - transfer candidate, RG 96-98) must carry the deferred reason, not - Precedence's native "admission limit reached" that "loser-a"/"loser-b" - -- the ones Precedence itself dropped -- carry. Without this, a bug - that folded [resolution.deferred] into [omitted] with the wrong reason, - or dropped [resolution.omitted]'s own reasons, would still pass the + (* Identity within [omitted]: "loser-a"/"loser-b" -- the ones Precedence's + own [admit] dropped for exceeding the commemoration limit, not RG 96-98 + translation -- must carry that specific reason. Without this, a bug + that dropped [resolution.omitted]'s own reasons would still pass the slug-set check above. *) let reason_of slug = d.LD.omitted |> List.find (fun (c, _) -> Sl.to_string c.Cel.slug = slug) |> snd in - Alcotest.(check string) "eclipsed carries the deferred reason" - "deferred: transfer placement not yet implemented (Task 6)" (reason_of "eclipsed"); Alcotest.(check string) "loser-a carries Precedence's own admission-limit reason" - "omitted: admission limit reached" (reason_of "loser-a") + "omitted: admission limit reached" (reason_of "loser-a"); + (* Not "eclipsed is absent from bucketed" -- the [slist] check just above + already guarantees that (a 5-element set would fail it), so re-asserting + absence from the same list would be checking something already proven, + not something new. What IS new here: this day positively records that a + transfer happened, via a different field entirely. *) + Alcotest.(check bool) "20 Dec records that something transferred out" true + (d.LD.transferred_out <> None) + +(* Task 6's placement pass (RG 96-98), properties 1 and 2: a transferred + celebration appears exactly once in the whole year -- transfer moves, not + duplicates -- and [transferred_in]/[transferred_out] are set on the two + ends of the move and point at each other. "transferable" is impeded on 10 + Jan by "blocker-a" (same band, tie-broken by slug), and 11-12 Jan are also + occupied by their own uncontested Hi entries, so this also proves the + search walks past more than one ineligible day rather than only trying + origin+1. *) +let test_transfer_moves_and_does_not_duplicate () = + let days = C.year Fixture.rite Fixture.layer_with_collision 2026 in + let occurrences = + Array.to_list days + |> List.filter (fun d -> Sl.to_string d.LD.observed.Cel.slug = "transferable") + in + Alcotest.(check int) "appears exactly once" 1 (List.length occurrences); + let landed = List.hd occurrences in + Alcotest.(check string) "lands on the first day past the blocked run (13 Jan 2027)" + "2027-01-13" (D.to_iso8601 landed.LD.date); + Alcotest.(check bool) "marked as transferred in" true (landed.LD.transferred_in <> None); + Alcotest.(check string) "the arriving celebration is itself \"transferable\"" + "transferable" + (match landed.LD.transferred_in with + | Some c -> Sl.to_string c.Cel.slug + | None -> ""); + (* Located by its own known origin date, not by "the first day with + transferred_out set" -- layer_with_collision has more than one day that + transfers something out (20 Dec's "eclipsed", 1 Feb's "transfer-b"), so + that would silently pick up whichever happens to sort first in the + array rather than proving THIS origin points at THIS landing. *) + let origin = Array.to_list days |> List.find (fun d -> D.compare d.LD.date (mk 2027 1 10) = 0) in + Alcotest.(check bool) "origin points at the landing date" true + (origin.LD.transferred_out = Some landed.LD.date) + +(* Property 3: RG 97-98's ordering. Two Hi-rank losers coincide on 1 Feb + (with "collision-winner" keeping the day); band ties, so slug order IS + band order here, same convention Precedence.compare_by uses for real RG + 91 entries that tie within one table slot. Checked by DATE, not by + "b landed one day after a" -- Task 5's review flagged exactly that + style of check as satisfiable by construction (an Array.init built from + add_days would pass it trivially); asserting the literal landing dates + independently is what actually exercises the placement order. *) +let test_two_colliding_transferables_land_in_band_order () = + let days = C.year Fixture.rite Fixture.layer_with_collision 2026 in + let observed_on date = + Array.to_list days + |> List.find (fun d -> D.compare d.LD.date date = 0) + |> fun d -> Sl.to_string d.LD.observed.Cel.slug + in + Alcotest.(check string) "collision-winner keeps 1 Feb" "collision-winner" + (observed_on (mk 2027 2 1)); + Alcotest.(check string) "higher-precedence loser (transfer-a) claims 2 Feb first" "transfer-a" + (observed_on (mk 2027 2 2)); + Alcotest.(check string) "lower-precedence loser (transfer-b) is pushed to 3 Feb" "transfer-b" + (observed_on (mk 2027 2 3)); + let count slug = + Array.to_list days + |> List.filter (fun d -> Sl.to_string d.LD.observed.Cel.slug = slug) + |> List.length + in + Alcotest.(check int) "transfer-a appears exactly once in the year" 1 (count "transfer-a"); + Alcotest.(check int) "transfer-b appears exactly once in the year" 1 (count "transfer-b") + +(* Termination is a correctness requirement (brief): a rite whose + [transfer_target] always answers with the impeded day itself (never + strictly forward, so the pass can never reach a fixed point) must not + hang the computation. It has to hit [max_transfer_rounds] and come back + with the stuck candidate recorded as omitted -- not dropped, not looping + forever. Using plain [Fixture.layer] (20 Dec's "eclipsed" is the stuck + candidate) is enough; this is about the guard firing, not about any + particular collision shape. *) +let test_transfer_guard_records_failure_instead_of_looping () = + let broken_rite = { Fixture.rite with Rite.transfer_target = (fun _ origin _ -> origin) } in + let days = C.year broken_rite Fixture.layer 2026 in + let stuck = + Array.to_list days + |> List.exists (fun d -> + List.exists + (fun (_, reason) -> + reason = "omitted: transfer placement did not converge within max_transfer_rounds (RG 96-98)") + d.LD.omitted) + in + Alcotest.(check bool) "non-convergence is recorded rather than silently dropped or hung" true stuck let suite = ( "Calendar", @@ -226,4 +361,10 @@ let suite = Alcotest.test_case "year 9999 does not raise" `Quick test_year_9999_does_not_raise; Alcotest.test_case "day near the domain floor does not raise" `Quick test_day_near_domain_floor_does_not_raise; - Alcotest.test_case "full day accounting" `Quick test_full_day_accounting ] ) + Alcotest.test_case "full day accounting" `Quick test_full_day_accounting; + Alcotest.test_case "transfer moves and does not duplicate" `Quick + test_transfer_moves_and_does_not_duplicate; + Alcotest.test_case "two colliding transferables land in band order" `Quick + test_two_colliding_transferables_land_in_band_order; + Alcotest.test_case "transfer guard records failure instead of looping" `Quick + test_transfer_guard_records_failure_instead_of_looping ] ) diff --git a/test/test_validate.ml b/test/test_validate.ml index 31d7a3d..df8c99c 100644 --- a/test/test_validate.ml +++ b/test/test_validate.ml @@ -5,9 +5,9 @@ module V = Rite_ef.Vocab_ef module T = Rite_ef.Temporal_ef (* Plan 3's real EF precedence rules (Precedence_ef, Tasks 7-11) don't exist - yet -- Validate.run doesn't read [rules] at all (nothing does before - Task 5's Calendar), so a placeholder is enough to assemble a well-typed - Rite.t here. *) + yet -- Validate.run doesn't read [rules] or [transfer_target] at all + (nothing does before Task 5's Calendar and Task 6's placement pass), so a + placeholder is enough to assemble a well-typed Rite.t here. *) let ef_rules : (V.season, V.rank) P.rules = { P.band = (fun _ _ -> 0); disposition = (fun ~winner:_ ~loser:_ -> P.Omit); @@ -15,7 +15,8 @@ let ef_rules : (V.season, V.rank) P.rules = let ef_rite : (V.season, V.rank) Rite.t = { Rite.id = T.id; vocab = V.vocab; year_start = T.year_start; temporal = T.temporal; - anchors = T.anchors; rules = ef_rules; season_runs = V.seasons } + anchors = T.anchors; rules = ef_rules; season_runs = V.seasons; + transfer_target = (fun _ origin _ -> origin) } let run year = Val.run ef_rite ~year @@ -174,7 +175,9 @@ module Synthetic = struct let rite ?(vocab = vocab) ?(anchors = fun _ -> []) ?(season_runs = [ A; B ]) temporal : (season, rank) Rite.t = - { Rite.id = "synthetic"; vocab; year_start; temporal; anchors; rules; season_runs } + { Rite.id = "synthetic"; vocab; year_start; temporal; anchors; rules; season_runs; + (* Validate.run doesn't read this either (see [ef_rules] above). *) + transfer_target = (fun _ origin _ -> origin) } let run ?vocab ?anchors ?season_runs temporal = Val.run (rite ?vocab ?anchors ?season_runs temporal) ~year:2026 -- cgit v1.3 From 1d6be4ac281e62accfb905b137b3c6b494183ee4 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 21:29:13 +0200 Subject: kernel(calendar): fix multi-departure loss, band-order gap, off-array targets Four findings from Task 6 review, addressed on top of f15e44d. 1. transferred_out was a single Date.t option, so when RG 97-98 collides three or more feasts on one date (more than one loser), only the last one Hashtbl.iter happened to visit survived -- a genuinely lost move, and which one survived depended on OCaml's hash seed (OCAMLRUNPARAM=R), an environment read a kernel invariant forbids. RG 97-98 says coinciding feasts transfer "in order" -- plural -- so the type was wrong, not the fixture: transferred_out is now (Celebration.t * Date.t) list. transferred_in stays a single option, deliberately: a day receives at most one arrival (RG 96 sends each departure to the next non-I/II-class day, and the first to arrive occupies it). The per-day list is canonicalised (sorted by target date, then slug) after accumulation, the same fix layer.ml already applies to its own date-bucket index and for the same reason. Verified clean across 15 runs under OCAMLRUNPARAM=R; disabling the canonicalisation step showed the raw order genuinely flip between seeds, confirming the fix is load-bearing. 2. Every deferred candidate in the fixture was the same rank, so compare_deferred's band branch was unreachable and reversing it broke nothing -- the RG 97-98 test was pinning slug order, not band order. The fixture now has three ranks (Hi1 outranks Hi2, both transfer, both outrank Lo), with slugs chosen so band order and slug order disagree. Reversing the band comparison now fails the test on "higher-band loser claims 2 Feb first", received the wrong slug instead. 3. A transfer_target free to name any date could place a candidate outside the liturgical year's own start/stop bounds: invisible to year/build_day, so it would be observed nowhere and, since its origin's re-resolution would report it as settled, omitted nowhere either -- genuinely gone, contradicting calendar.mli's "never silently dropped". place_transfers now checks the range on every placement and routes an out-of-range one to a permanent-exclusion table instead of assignment, with its own cited omitted reason. 4. Precedence.resolve folds Transfer and Repose into one deferred case, and place_transfers routed all of it through transfer_target (RG 96's search), which is only correct for Transfer. Repose is RG 100-102's repositio, a distinct rubric this module does not implement. Documented rather than split into a second mechanism: nothing in the EF ruleset returns Repose (design spec section 1.3, "declared, not exercised"), so the gap is latent, not a live bug. Two new tests (origin records every departure; transfer target outside year is recorded not lost); the RG 97-98 test's fixture and assertions rewritten for finding 2. --- lib/kernel/calendar.ml | 157 +++++++++++++++++++++++-------- lib/kernel/calendar.mli | 31 +++++-- lib/kernel/liturgical_day.ml | 9 +- lib/kernel/liturgical_day.mli | 9 +- test/test_calendar.ml | 211 ++++++++++++++++++++++++++++-------------- 5 files changed, 298 insertions(+), 119 deletions(-) (limited to 'lib') diff --git a/lib/kernel/calendar.ml b/lib/kernel/calendar.ml index 1ad45a1..5d3572c 100644 --- a/lib/kernel/calendar.ml +++ b/lib/kernel/calendar.ml @@ -101,6 +101,20 @@ let max_transfer_rounds = 64 let unconverged_reason = "omitted: transfer placement did not converge within max_transfer_rounds (RG 96-98)" +(* A rite-supplied [transfer_target] is trusted to search strictly forward + (rite.mli), but nothing stops it naming a date past the end of the + liturgical year it was asked about -- e.g. an I-class feast impeded in + the last days before Advent I, whose first admissible day genuinely + falls in the following liturgical year's own territory (unproven to + occur in the real EF calendar, but not something this module can rule + out by construction). [place_transfers] never injects such a target: the + [dates] array is exactly what [year]/[build_day] walk to produce the + result, so a candidate placed outside it would be [observed]/ + [transferred_in] nowhere in the output at all -- gone, not merely + mis-filed, and silently so, contradicting [calendar.mli]'s "never + silently dropped". This reason makes that failure mode visible instead. *) +let out_of_range_reason = "omitted: transfer target falls outside the liturgical year (RG 96)" + (* Rebuilds the per-date injection index from [assignment] (slug -> (origin, target)) fresh each round, rather than accumulating it incrementally as candidates are placed. A candidate re-deferred in a later round (its first @@ -125,6 +139,22 @@ let injected_index_of_assignment (assignment : (string, Date.t * Date.t) Hashtbl (* The placement pass itself (spec §2.4 steps 1-4; step 5, recording transferred_in/out, is [year]'s job once this reaches a fixed point). + Every [Precedence.Transfer]-*and*-[Precedence.Repose]-disposed loser lands + in [resolution.deferred] together -- [Precedence.resolve]'s own fold + matches them as one case, [Transfer | Repose -> ... :: defs ...] -- and + everything gathered below is routed through + [rite.transfer_target], i.e. RG 96's next-admissible-day search. That is + only correct for [Transfer]. [Repose] denotes RG 100-102's *repositio* + (perpetual impediment, reassigned to the next appropriate day and treated + as proper) -- a distinct rubric this module does not implement. It is + documented here rather than split into a second mechanism because nothing + currently produces [Repose]: the design spec records it as "declared, not + exercised" (§1.3) -- the EF ruleset (Tasks 7-9) returns it for nothing; + perpetual impediment arises from proper/diocesan calendars, which are + overlay content, out of this plan's scope. If a future rite's rules ever + do return [Repose], it would silently take the RG 96 path here, which + would be wrong -- worth knowing before that day, not discovering it then. + Each round: gather every currently-deferred candidate across the whole year (fresh, against this round's [injected] state -- a candidate already placed and now winning its target is no longer a loser anywhere and so @@ -148,11 +178,21 @@ let injected_index_of_assignment (assignment : (string, Date.t * Date.t) Hashtbl module's, not because this module's sort ever decided anything. Layering the claims instead means a same-round collision is resolved in the one round it is found, in the sorted order, and the earlier RG 97-98 test - pins exactly that: it fails on "claims 2 Feb first" without this. *) -let place_transfers (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) (dates : Date.t array) : - (string, Date.t * Date.t) Hashtbl.t * (string, 'r Precedence.candidate) Hashtbl.t = + pins exactly that: it fails on "claims 2 Feb first" without this. + + [~start ~stop] bound the [transfer_target] a placement is allowed to + settle on: outside that range it goes into [out_of_range] instead of + [assignment], permanently (never retried -- [transfer_target] is a pure + function of a candidate's own permanent origin and the occupancy state, + so asking it again would only recompute the same out-of-range answer). *) +let place_transfers (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) ~(start : Date.t) + ~(stop : Date.t) (dates : Date.t array) : + (string, Date.t * Date.t) Hashtbl.t + * (string, 'r Precedence.candidate) Hashtbl.t + * (string, Date.t * Date.t) Hashtbl.t = let assignment : (string, Date.t * Date.t) Hashtbl.t = Hashtbl.create 16 in let candidate_by_slug : (string, 'r Precedence.candidate) Hashtbl.t = Hashtbl.create 16 in + let out_of_range : (string, Date.t * Date.t) Hashtbl.t = Hashtbl.create 4 in let compare_deferred (_, ctx1, c1) (_, ctx2, c2) = let b1 = rite.Rite.rules.Precedence.band ctx1 c1 in let b2 = rite.Rite.rules.Precedence.band ctx2 c2 in @@ -185,16 +225,22 @@ let place_transfers (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) (dates : D Jan instead of 13 in test_transfer_moves_and_does_not_duplicate, not merely "doesn't converge" -- the bug is a wrong answer, not only a hang). A sighting is genuinely actionable only if the - candidate has never been placed yet (first time seen), or if it is - losing exactly at the date it is *currently* assigned to (a fresh - RG 97-98 bump: something else also landed there and out-ranked it) - -- any other date is the stale, permanent one and is dropped. *) + candidate has never been placed yet (first time seen, and not + already known unplaceable -- [out_of_range] gets the same + permanent exclusion [assignment] does, for the same reason), or if + it is losing exactly at the date it is *currently* assigned to (a + fresh RG 97-98 bump: something else also landed there and + out-ranked it) -- any other date is the stale, permanent one and is + dropped. *) let deferred = List.filter (fun (date, _ctx, c) -> - match Hashtbl.find_opt assignment (Slug.to_string c.Precedence.cel.Celebration.slug) with - | None -> true - | Some (_, target) -> Date.compare date target = 0) + let slug = Slug.to_string c.Precedence.cel.Celebration.slug in + if Hashtbl.mem out_of_range slug then false + else + match Hashtbl.find_opt assignment slug with + | None -> true + | Some (_, target) -> Date.compare date target = 0) raw in if deferred = [] then converged := true @@ -209,31 +255,30 @@ let place_transfers (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) (dates : D |> List.iter (fun (origin, _ctx, c) -> let target = rite.Rite.transfer_target c origin occupant_with_claims in let slug = Slug.to_string c.Precedence.cel.Celebration.slug in - Hashtbl.replace claimed_this_round (Date.to_rata target) c; - Hashtbl.replace assignment slug (origin, target); - Hashtbl.replace candidate_by_slug slug c) + if Date.compare target start < 0 || Date.compare target stop > 0 then + Hashtbl.replace out_of_range slug (origin, target) + else begin + Hashtbl.replace claimed_this_round (Date.to_rata target) c; + Hashtbl.replace assignment slug (origin, target); + Hashtbl.replace candidate_by_slug slug c + end) end end done; - (assignment, candidate_by_slug) + (assignment, candidate_by_slug, out_of_range) (* The final build of one day, once placement has reached its fixed point (or exhausted the guard): resolve against the settled [injected] state, then layer on [transferred_in] (this date received an injected candidate that - went on to win) and [transferred_out] (some candidate's settled placement - originated here). - - [transferred_out] is a single [Date.t option] (Liturgical_day.mli), so it - cannot represent two different celebrations leaving the same origin day - for two different destinations. [transferred_out_of] is built with - last-write-wins for that (unreached) case; RG 97-98 collisions still - report correctly because what actually matters -- each celebration landing - on its own, correctly-ordered day, exactly once -- is carried by - [observed]/[transferred_in], not by this pointer. *) + went on to win) and [transferred_out] (whichever candidates' settled + placements originated here -- RG 97-98 lets that be more than one; see + [Liturgical_day.transferred_out]). *) let build_day (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) (assignment : (string, Date.t * Date.t) Hashtbl.t) + (out_of_range : (string, Date.t * Date.t) Hashtbl.t) (injected : (int, 'r Precedence.candidate list) Hashtbl.t) - (transferred_out_of : (int, Date.t) Hashtbl.t) (date : Date.t) : ('s, 'r) Liturgical_day.t = + (transferred_out_of : (int, ('r Celebration.t * Date.t) list) Hashtbl.t) (date : Date.t) : + ('s, 'r) Liturgical_day.t = let temporal, _ctx, resolution = resolve_with_injected rite idx injected date in let arrived = try Hashtbl.find injected (Date.to_rata date) with Not_found -> [] in let transferred_in = @@ -244,7 +289,7 @@ let build_day (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) |> Option.map (fun c -> c.Precedence.cel) in let transferred_out = - try Some (Hashtbl.find transferred_out_of (Date.to_rata date)) with Not_found -> None + try Hashtbl.find transferred_out_of (Date.to_rata date) with Not_found -> [] in (* [resolution.deferred] here is NOT "the placement pass never got to these": it is the origin day's own permanent, structural loss -- the @@ -253,23 +298,30 @@ let build_day (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) the exact date it was always going to lose at (this is the same fact [place_transfers]'s round loop has to filter around, see its comment). A [deferred] sighting only belongs in [omitted] if it was never - actually settled anywhere -- i.e. the guard above was hit before this - candidate reached a day it wins. Settled elsewhere means genuinely - accounted for via [observed]/[transferred_in] on the day it landed and - [transferred_out] here, not via [omitted] too -- double-booking it in - both would fail Task 12's "appears exactly once" reading of this day - alone. *) + actually settled anywhere -- i.e. it is stuck in [out_of_range], or the + guard above was hit before it reached a day it wins. Settled elsewhere + means genuinely accounted for via [observed]/[transferred_in] on the + day it landed and [transferred_out] here, not via [omitted] too -- + double-booking it in both would fail Task 12's "appears exactly once" + reading of this day alone. *) let unresolved c = let slug = Slug.to_string c.Precedence.cel.Celebration.slug in - match Hashtbl.find_opt assignment slug with - | None -> true - | Some (_, target) -> - not (Slug.equal (occupant_of rite idx injected target).Celebration.slug c.Precedence.cel.Celebration.slug) + if Hashtbl.mem out_of_range slug then true + else + match Hashtbl.find_opt assignment slug with + | None -> true + | Some (_, target) -> + not (Slug.equal (occupant_of rite idx injected target).Celebration.slug c.Precedence.cel.Celebration.slug) + in + let reason_for c = + if Hashtbl.mem out_of_range (Slug.to_string c.Precedence.cel.Celebration.slug) then + out_of_range_reason + else unconverged_reason in let omitted = List.map (fun (c, reason) -> (c.Precedence.cel, reason)) resolution.Precedence.omitted @ (resolution.Precedence.deferred |> List.filter unresolved - |> List.map (fun c -> (c.Precedence.cel, unconverged_reason))) + |> List.map (fun c -> (c.Precedence.cel, reason_for c))) in { Liturgical_day.date; @@ -296,13 +348,36 @@ let year (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) (y : int) : either. *) let n = max 0 (Date.to_rata stop - Date.to_rata start + 1) in let dates = Array.init n (fun i -> Date.add_days start i) in - let assignment, candidate_by_slug = place_transfers rite idx dates in + let assignment, candidate_by_slug, out_of_range = place_transfers rite idx ~start ~stop dates in let injected = injected_index_of_assignment assignment candidate_by_slug in - let transferred_out_of : (int, Date.t) Hashtbl.t = Hashtbl.create 16 in + let transferred_out_of : (int, ('r Celebration.t * Date.t) list) Hashtbl.t = Hashtbl.create 16 in Hashtbl.iter - (fun _slug (origin, target) -> Hashtbl.replace transferred_out_of (Date.to_rata origin) target) + (fun slug (origin, target) -> + let cel = (Hashtbl.find candidate_by_slug slug).Precedence.cel in + let key = Date.to_rata origin in + Hashtbl.replace transferred_out_of key + ((cel, target) :: (try Hashtbl.find transferred_out_of key with Not_found -> []))) assignment; - Array.map (build_day rite idx assignment injected transferred_out_of) dates + (* Canonicalise each day's departures: the accumulation above walks + [assignment] via [Hashtbl.iter], whose bucket order is not guaranteed + stable across runs (OCaml's hash seed can be randomised via + OCAMLRUNPARAM=R), so a day with more than one departure -- RG 97-98's + coinciding-feasts case -- would otherwise report them in a + run-dependent order: an environment read, in a kernel whose invariants + forbid one. [Layer.index_by_date] guards against exactly this by + re-sorting each date bucket after building it (layer.ml); same fix, + same reason. Sorted by target date -- which, for a correctly-converged + year, is also RG 97-98's own order: the higher-precedence loser claims + the earlier admissible day -- ties (not expected, but not assumed + impossible) broken on slug. *) + let by_target_then_slug (c1, t1) (c2, t2) = + let dc = Date.compare t1 t2 in + if dc <> 0 then dc else Slug.compare c1.Celebration.slug c2.Celebration.slug + in + Hashtbl.iter + (fun k v -> Hashtbl.replace transferred_out_of k (List.sort by_target_then_slug v)) + transferred_out_of; + Array.map (build_day rite idx assignment out_of_range injected transferred_out_of) dates let day (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) (date : Date.t) : ('s, 'r) Liturgical_day.t = diff --git a/lib/kernel/calendar.mli b/lib/kernel/calendar.mli index 9fbd7e7..1c0b0ed 100644 --- a/lib/kernel/calendar.mli +++ b/lib/kernel/calendar.mli @@ -11,13 +11,30 @@ every deferred candidate (RG 96-98): a losing I-class candidate the rite's rules send to [Precedence.Transfer] does not stay put -- it moves to the next day [rite.transfer_target] names as admissible, and both - ends of the move are recorded ([transferred_in] on the day it arrives, - [transferred_out] on the day it left). Every deferred candidate is - accounted for exactly once: placed, or -- only if the placement fixed - point is not reached within the round guard, which nothing in the 1962 - calendar is expected to trigger -- left in [Liturgical_day.omitted] with - a reason that says so, never silently dropped. See [calendar.ml]'s - [place_transfers] for the algorithm and its termination argument. *) + ends of the move are recorded: [transferred_in] on the day it arrives + (at most one -- RG 96 sends each departure to the next day that is not I + or II class, and the first to arrive occupies it), [transferred_out] on + the day it left (a list, not an option: RG 97-98 has coinciding I-class + feasts transfer "in order", so one day can lose more than one). Every + deferred candidate is accounted for exactly once: placed, or -- only if + the placement fixed point is not reached within the round guard (which + nothing in the 1962 calendar is expected to trigger), or the rite's own + [transfer_target] names a date outside this liturgical year's own range + (unproven to occur in the real EF calendar, but not ruled out by + construction) -- left in [Liturgical_day.omitted] with a reason that + says which, never silently dropped. See [calendar.ml]'s + [place_transfers] for the algorithm and its termination argument. + + [Precedence.Repose]-disposed losers are gathered the same way + [Precedence.Transfer]-disposed ones are (Precedence folds both into + [deferred] as one case) and are routed through the same RG 96 search. + That is only correct for [Transfer]: [Repose] denotes RG 100-102's + *repositio*, a distinct rubric this module does not implement. Nothing + in the EF ruleset currently returns [Repose] (design spec §1.3: + "declared, not exercised" -- perpetual impediment arises from + proper/diocesan calendars, out of this plan's scope), so the gap is + latent rather than a live bug; documented here rather than given a + second mechanism for a disposition nothing emits. *) (** [year rite layer y] resolves every day of the liturgical year that opens in civil year [y]: from [rite.year_start y] through the day before diff --git a/lib/kernel/liturgical_day.ml b/lib/kernel/liturgical_day.ml index cbaca9c..bbb52b8 100644 --- a/lib/kernel/liturgical_day.ml +++ b/lib/kernel/liturgical_day.ml @@ -12,8 +12,13 @@ type ('s, 'r) t = { commemorations : ('r Celebration.t * Precedence.privilege) list; transferred_in : 'r Celebration.t option; (** arrived here from an impeded day *) - transferred_out : Date.t option; - (** this day's celebration went there *) + transferred_out : ('r Celebration.t * Date.t) list; + (** celebrations that left this day, and where each one went. A list, + not an option: RG 97-98 has coinciding I-class feasts transfer + "in order" -- plural -- so a day can lose more than one. Asymmetric + with [transferred_in] deliberately: a day receives at most one + arrival, because RG 96 sends each departure to the next day that + is not I or II class, and the first to arrive occupies it. *) omitted : ('r Celebration.t * string) list; (** with the reason, never silent -- Task 12's no-celebration-lost invariant reads this *) diff --git a/lib/kernel/liturgical_day.mli b/lib/kernel/liturgical_day.mli index 38e7c76..a109251 100644 --- a/lib/kernel/liturgical_day.mli +++ b/lib/kernel/liturgical_day.mli @@ -10,8 +10,13 @@ type ('s, 'r) t = { commemorations : ('r Celebration.t * Precedence.privilege) list; transferred_in : 'r Celebration.t option; (** arrived here from an impeded day *) - transferred_out : Date.t option; - (** this day's celebration went there *) + transferred_out : ('r Celebration.t * Date.t) list; + (** celebrations that left this day, and where each one went. A list, + not an option: RG 97-98 has coinciding I-class feasts transfer + "in order" -- plural -- so a day can lose more than one. Asymmetric + with [transferred_in] deliberately: a day receives at most one + arrival, because RG 96 sends each departure to the next day that + is not I or II class, and the first to arrive occupies it. *) omitted : ('r Celebration.t * string) list; (** with the reason, never silent -- Task 12's no-celebration-lost invariant reads this *) diff --git a/test/test_calendar.ml b/test/test_calendar.ml index 70823a4..505994e 100644 --- a/test/test_calendar.ml +++ b/test/test_calendar.ml @@ -9,8 +9,16 @@ let mk y m d = match D.make ~year:y ~month:m ~day:d with Ok t -> t | Error e -> (* A synthetic rite -- not EF -- so Calendar's behaviour is proven against the abstraction, not against EF's own real (and much larger) data. Two - seasons, two ranks: enough to exercise the type parameters without - dragging in real liturgical logic Calendar itself does not compute. *) + seasons, three ranks: enough to exercise the type parameters without + dragging in real liturgical logic Calendar itself does not compute. + + Three ranks, not two: Task 6 review finding 2. With only one + Transfer-disposed rank, every deferred candidate ties on [band] and + [compare_deferred]'s [b1 <> b2] branch (the one RG 97-98 actually depends + on -- coinciding I-class feasts transfer in TABLE order, not slug order) + was unreachable; reversing it broke no test. [Hi1] outranks [Hi2], both + outrank [Lo], both are [Transfer]-disposed -- so two colliding + transferables can now differ by band, not only by slug. *) module Fixture = struct module Vocab = Colitur_kernel.Vocab module Colour = Colitur_kernel.Colour @@ -20,16 +28,16 @@ module Fixture = struct module Date_spec = Colitur_kernel.Date_spec type season = A | B - type rank = Hi | Lo + type rank = Hi1 | Hi2 | Lo let season_to_string = function A -> "a" | B -> "b" let season_of_string = function "a" -> Some A | "b" -> Some B | _ -> None - let rank_to_string = function Hi -> "hi" | Lo -> "lo" - let rank_of_string = function "hi" -> Some Hi | "lo" -> Some Lo | _ -> None + let rank_to_string = function Hi1 -> "hi1" | Hi2 -> "hi2" | Lo -> "lo" + let rank_of_string = function "hi1" -> Some Hi1 | "hi2" -> Some Hi2 | "lo" -> Some Lo | _ -> None let vocab : (season, rank) Vocab.t = { Vocab.seasons = [ A; B ]; season_to_string; season_of_string; - ranks = [ Hi; Lo ]; rank_to_string; rank_of_string } + ranks = [ Hi1; Hi2; Lo ]; rank_to_string; rank_of_string } let weekday_index d = match D.weekday d with @@ -59,14 +67,15 @@ module Fixture = struct let temporal date : (season, rank) Temporal.t = { Temporal.season = season date; week = None; weekday = D.weekday date; office = office date } - (* Band: Hi beats Lo; Temporal breaks a tie in its own favour -- the same - convention test_precedence.ml uses. *) + (* Band: Hi1 beats Hi2 beats Lo; Temporal breaks a tie against a Lo-rank + Sanctoral entry in its own favour -- the same convention + test_precedence.ml uses. *) let band (_ : season P.context) (c : rank P.candidate) = - (match c.P.cel.Cel.rank with Hi -> 10 | Lo -> 20) + (match c.P.cel.Cel.rank with Hi1 -> 5 | Hi2 -> 10 | Lo -> 20) - (match c.P.origin with P.Temporal -> 1 | P.Sanctoral -> 0) let disposition ~winner:_ ~(loser : rank P.candidate) = - match loser.P.cel.Cel.rank with Lo -> P.Commemorate P.Ordinary | Hi -> P.Transfer + match loser.P.cel.Cel.rank with Lo -> P.Commemorate P.Ordinary | Hi1 | Hi2 -> P.Transfer (* Admits at most one commemoration -- mirrors test_precedence.ml's own example and, unlike "admit everything", actually gives the accounting @@ -77,12 +86,12 @@ module Fixture = struct (* RG 96, generic form: search forward from the day after [origin] for the first day whose occupant is not "blocking" -- in this synthetic - vocabulary Hi stands in for I/II class, Lo for everything else (the same - convention [band] already uses). No Annunciation-style starting-point - override: that exception is EF-specific (RG 96) and belongs to the real - rite (Task 11, pinned by Task 17's golden years), not to this - abstraction-level fixture, which only has to prove Calendar's placement - mechanism, not EF's own rubrics. *) + vocabulary Hi1/Hi2 stand in for I/II class, Lo for everything else (the + same convention [band] already uses). No Annunciation-style + starting-point override: that exception is EF-specific (RG 96) and + belongs to the real rite (Task 11, pinned by Task 17's golden years), + not to this abstraction-level fixture, which only has to prove + Calendar's placement mechanism, not EF's own rubrics. *) let transfer_target (_ : rank P.candidate) (origin : D.t) (occupant : D.t -> rank Cel.t) : D.t = let rec search d = if (occupant d).Cel.rank = Lo then d else search (D.add_days d 1) in search (D.add_days origin 1) @@ -96,20 +105,20 @@ module Fixture = struct cel = Cel.make ~slug:(Sl.of_string_exn slug) ~rank ~colour:Colour.White ~layer:"synthetic-sanctoral" () } - let big_feast = entry ~month:12 ~day:8 ~slug:"big-feast" ~rank:Hi + let big_feast = entry ~month:12 ~day:8 ~slug:"big-feast" ~rank:Hi1 let commem_worthy = entry ~month:12 ~day:15 ~slug:"commem-worthy" ~rank:Lo (* 20 Dec: four sanctoral entries on one date, for the full-accounting test. - "day-winner" and "eclipsed" tie on band (both Hi, both Sanctoral); ties - break on slug, so "day-winner" wins and "eclipsed" -- a Hi-rank loser -- - is [Transfer]-disposed, landing in [deferred]. "loser-a" and "loser-b" - are both Lo, both [Commemorate]-disposed, but [admit] only keeps one: - the other lands in Precedence's own [omitted] ("admission limit - reached"), distinct from "eclipsed"'s deferred reason. Four candidates, - three different fates -- observed, one specific omission reason, two - more. *) - let day_winner = entry ~month:12 ~day:20 ~slug:"day-winner" ~rank:Hi - let eclipsed = entry ~month:12 ~day:20 ~slug:"eclipsed" ~rank:Hi + "day-winner" and "eclipsed" tie on band (both Hi1, both Sanctoral); + ties break on slug, so "day-winner" wins and "eclipsed" -- a Hi1-rank + loser -- is [Transfer]-disposed, landing in [deferred]. "loser-a" and + "loser-b" are both Lo, both [Commemorate]-disposed, but [admit] only + keeps one: the other lands in Precedence's own [omitted] ("admission + limit reached"), distinct from "eclipsed"'s deferred reason. Four + candidates, three different fates -- observed, one specific omission + reason, two more. *) + let day_winner = entry ~month:12 ~day:20 ~slug:"day-winner" ~rank:Hi1 + let eclipsed = entry ~month:12 ~day:20 ~slug:"eclipsed" ~rank:Hi1 let loser_a = entry ~month:12 ~day:20 ~slug:"loser-a" ~rank:Lo let loser_b = entry ~month:12 ~day:20 ~slug:"loser-b" ~rank:Lo @@ -118,33 +127,40 @@ module Fixture = struct [ big_feast; commem_worthy; day_winner; eclipsed; loser_a; loser_b ] (* RG 96 (Task 6): "transferable" is impeded on 10 Jan by "blocker-a" (both - Hi; ties break on slug, "blocker-a" < "transferable", so "blocker-a" + Hi1; ties break on slug, "blocker-a" < "transferable", so "blocker-a" wins and "transferable" is the loser). 11 and 12 Jan are ALSO occupied - by their own uncontested Hi-rank entries, so the placement search must + by their own uncontested Hi1-rank entries, so the placement search must walk past more than one ineligible day, not just try origin+1 and stop. 13 Jan carries nothing, so the feria (Lo) is the first admissible day. *) - let blocker_a = entry ~month:1 ~day:10 ~slug:"blocker-a" ~rank:Hi - let transferable = entry ~month:1 ~day:10 ~slug:"transferable" ~rank:Hi - let blocker_b = entry ~month:1 ~day:11 ~slug:"blocker-b" ~rank:Hi - let blocker_c = entry ~month:1 ~day:12 ~slug:"blocker-c" ~rank:Hi - - (* RG 97-98: three Hi-rank entries coincide on 1 Feb. Sorted by band then - slug (all three tie on band, since Fixture's [band] only reads rank): - "collision-winner" < "transfer-a" < "transfer-b". The winner keeps 1 - Feb; the other two -- both losers, both Hi, both [Transfer]-disposed -- - must transfer in that same order. 2 and 3 Feb carry nothing of their - own, so they are the two admissible days the pair must land on, - consecutively, in that order: "transfer-a" (the higher-precedence - loser) gets first claim on 2 Feb, pushing "transfer-b" to 3 Feb. *) - let collision_winner = entry ~month:2 ~day:1 ~slug:"collision-winner" ~rank:Hi - let transfer_a = entry ~month:2 ~day:1 ~slug:"transfer-a" ~rank:Hi - let transfer_b = entry ~month:2 ~day:1 ~slug:"transfer-b" ~rank:Hi + let blocker_a = entry ~month:1 ~day:10 ~slug:"blocker-a" ~rank:Hi1 + let transferable = entry ~month:1 ~day:10 ~slug:"transferable" ~rank:Hi1 + let blocker_b = entry ~month:1 ~day:11 ~slug:"blocker-b" ~rank:Hi1 + let blocker_c = entry ~month:1 ~day:12 ~slug:"blocker-c" ~rank:Hi1 + + (* RG 97-98: three entries coincide on 1 Feb, spanning both Transfer- + disposed ranks so band order and slug order genuinely disagree (Task 6 + review finding 2). "collision-winner" and "transfer-hi1" both tie at + the BETTER band (Hi1, 5); "transfer-hi2" is at the WORSE band (Hi2, + 10). Within the Hi1 tie, slug decides: "collision-winner" < "transfer- + hi1", so "collision-winner" keeps 1 Feb. Of the two losers, + "transfer-hi1" (band 5) outranks "transfer-hi2" (band 10) -- by BAND, + not by slug: "transfer-b" (transfer-hi2's slug) sorts alphabetically + *before* "transfer-z" (transfer-hi1's slug). A sort that used slug + instead of band, or compared band backwards, would place "transfer-b" + on 2 Feb instead of "transfer-z" -- exactly the wrong-order failure + mode finding 2 flagged as unreachable in the old two-Hi-rank fixture. + 2 and 3 Feb carry nothing of their own, so they are the two admissible + days the pair must land on, consecutively, in band order: + "transfer-hi1" claims 2 Feb, pushing "transfer-hi2" to 3 Feb. *) + let collision_winner = entry ~month:2 ~day:1 ~slug:"collision-winner" ~rank:Hi1 + let transfer_hi1 = entry ~month:2 ~day:1 ~slug:"transfer-z" ~rank:Hi1 + let transfer_hi2 = entry ~month:2 ~day:1 ~slug:"transfer-b" ~rank:Hi2 let layer_with_collision = Layer.of_entries ~id:"synthetic-with-collision" ~name:"Synthetic sanctoral (with collisions)" [ big_feast; commem_worthy; day_winner; eclipsed; loser_a; loser_b; blocker_a; transferable; blocker_b; blocker_c; - collision_winner; transfer_a; transfer_b ] + collision_winner; transfer_hi1; transfer_hi2 ] let liturgical_year_of date = let cy = D.year date in @@ -231,7 +247,7 @@ let test_day_near_domain_floor_does_not_raise () = duplicated into two buckets and another dropped, which this project has shipped before (register finding). - "eclipsed" -- the Hi-rank loser on 20 Dec -- no longer sits in [omitted] + "eclipsed" -- the Hi1-rank loser on 20 Dec -- no longer sits in [omitted] here (that was Task 5's honest placeholder, before Task 6 existed to place it): RG 95 gives an I-class loser the right of translation, so it is genuinely gone from this day's own accounting, and its departure is @@ -265,14 +281,14 @@ let test_full_day_accounting () = not something new. What IS new here: this day positively records that a transfer happened, via a different field entirely. *) Alcotest.(check bool) "20 Dec records that something transferred out" true - (d.LD.transferred_out <> None) + (d.LD.transferred_out <> []) (* Task 6's placement pass (RG 96-98), properties 1 and 2: a transferred celebration appears exactly once in the whole year -- transfer moves, not duplicates -- and [transferred_in]/[transferred_out] are set on the two ends of the move and point at each other. "transferable" is impeded on 10 Jan by "blocker-a" (same band, tie-broken by slug), and 11-12 Jan are also - occupied by their own uncontested Hi entries, so this also proves the + occupied by their own uncontested Hi1 entries, so this also proves the search walks past more than one ineligible day rather than only trying origin+1. *) let test_transfer_moves_and_does_not_duplicate () = @@ -292,22 +308,31 @@ let test_transfer_moves_and_does_not_duplicate () = | Some c -> Sl.to_string c.Cel.slug | None -> ""); (* Located by its own known origin date, not by "the first day with - transferred_out set" -- layer_with_collision has more than one day that - transfers something out (20 Dec's "eclipsed", 1 Feb's "transfer-b"), so - that would silently pick up whichever happens to sort first in the - array rather than proving THIS origin points at THIS landing. *) + transferred_out <> []" -- layer_with_collision has more than one day + that transfers something out (20 Dec's "eclipsed", 1 Feb's two losers), + so that would silently pick up whichever happens to sort first in the + array rather than proving THIS origin points at THIS landing. Its own + origin has exactly one departure -- unlike 1 Feb below -- so a single + pair pins it. *) let origin = Array.to_list days |> List.find (fun d -> D.compare d.LD.date (mk 2027 1 10) = 0) in - Alcotest.(check bool) "origin points at the landing date" true - (origin.LD.transferred_out = Some landed.LD.date) - -(* Property 3: RG 97-98's ordering. Two Hi-rank losers coincide on 1 Feb - (with "collision-winner" keeping the day); band ties, so slug order IS - band order here, same convention Precedence.compare_by uses for real RG - 91 entries that tie within one table slot. Checked by DATE, not by - "b landed one day after a" -- Task 5's review flagged exactly that - style of check as satisfiable by construction (an Array.init built from - add_days would pass it trivially); asserting the literal landing dates - independently is what actually exercises the placement order. *) + Alcotest.(check int) "exactly one departure recorded at the origin" 1 + (List.length origin.LD.transferred_out); + let departed_cel, departed_to = List.hd origin.LD.transferred_out in + Alcotest.(check string) "the departed celebration is \"transferable\"" "transferable" + (Sl.to_string departed_cel.Cel.slug); + Alcotest.(check string) "it points at the landing date" (D.to_iso8601 landed.LD.date) + (D.to_iso8601 departed_to) + +(* Property 3: RG 97-98's ordering, genuinely by band (Task 6 review finding + 2) -- see the [layer_with_collision] comment for how the fixture is built + so band order and slug order actively disagree here: "transfer-hi1" + (slug "transfer-z", band 5) must claim 2 Feb before "transfer-hi2" (slug + "transfer-b", band 10), even though "transfer-b" sorts alphabetically + first. Checked by DATE, not by "b landed one day after a" -- Task 5's + review flagged exactly that style of check as satisfiable by construction + (an Array.init built from add_days would pass it trivially); asserting + the literal landing dates independently is what actually exercises the + placement order. *) let test_two_colliding_transferables_land_in_band_order () = let days = C.year Fixture.rite Fixture.layer_with_collision 2026 in let observed_on date = @@ -317,18 +342,66 @@ let test_two_colliding_transferables_land_in_band_order () = in Alcotest.(check string) "collision-winner keeps 1 Feb" "collision-winner" (observed_on (mk 2027 2 1)); - Alcotest.(check string) "higher-precedence loser (transfer-a) claims 2 Feb first" "transfer-a" + Alcotest.(check string) "higher-band loser (transfer-z, Hi1) claims 2 Feb first" "transfer-z" (observed_on (mk 2027 2 2)); - Alcotest.(check string) "lower-precedence loser (transfer-b) is pushed to 3 Feb" "transfer-b" + Alcotest.(check string) "lower-band loser (transfer-b, Hi2) is pushed to 3 Feb" "transfer-b" (observed_on (mk 2027 2 3)); let count slug = Array.to_list days |> List.filter (fun d -> Sl.to_string d.LD.observed.Cel.slug = slug) |> List.length in - Alcotest.(check int) "transfer-a appears exactly once in the year" 1 (count "transfer-a"); + Alcotest.(check int) "transfer-z appears exactly once in the year" 1 (count "transfer-z"); Alcotest.(check int) "transfer-b appears exactly once in the year" 1 (count "transfer-b") +(* Task 6 review finding 1: RG 97-98 says coinciding I-class feasts transfer + "in order" -- plural -- so 1 Feb's origin must record BOTH departures + ("transfer-z" -> 2 Feb, "transfer-b" -> 3 Feb), not just one. The + original [Date.t option] could only ever hold one; with three entries + colliding on the same date it silently dropped whichever [Hashtbl.iter] + visited last, which depends on OCaml's hash seed (OCAMLRUNPARAM=R) -- an + environment read in a kernel whose invariants forbid one. Sorting both + sides before comparing makes this assertion itself independent of + [transferred_out]'s own (now canonicalised, but not part of the + contract) internal order. *) +let test_origin_records_every_departure () = + let days = C.year Fixture.rite Fixture.layer_with_collision 2026 in + let origin = Array.to_list days |> List.find (fun d -> D.compare d.LD.date (mk 2027 2 1) = 0) in + let departures = + origin.LD.transferred_out + |> List.map (fun (c, target) -> (Sl.to_string c.Cel.slug, D.to_iso8601 target)) + |> List.sort compare + in + Alcotest.(check (list (pair string string))) + "both losers' departures are recorded, order-independently" + (List.sort compare [ ("transfer-z", "2027-02-02"); ("transfer-b", "2027-02-03") ]) + departures + +(* Task 6 review finding 3: a rite whose [transfer_target] names a date + outside the liturgical year's own [start, stop] must not make the + candidate vanish. "eclipsed" is impeded on 20 Dec as usual, but this + rite's search jumps 5000 days forward -- far past [stop] -- instead of + walking to the next admissible day. It must never become [observed] + anywhere in the array (there is nowhere in the array for it to land), + and its origin must record the specific out-of-range reason, not the + generic non-convergence one (this placement decides on round 1; the + round guard is never even approached). *) +let test_transfer_target_outside_year_is_recorded_not_lost () = + let stray_rite = + { Fixture.rite with Rite.transfer_target = (fun _ origin _ -> D.add_days origin 5000) } + in + let days = C.year stray_rite Fixture.layer 2026 in + let observed_anywhere = + Array.to_list days |> List.exists (fun d -> Sl.to_string d.LD.observed.Cel.slug = "eclipsed") + in + Alcotest.(check bool) "never becomes observed anywhere in the year" false observed_anywhere; + let origin = Array.to_list days |> List.find (fun d -> D.compare d.LD.date (mk 2026 12 20) = 0) in + let reason_of slug = + origin.LD.omitted |> List.find (fun (c, _) -> Sl.to_string c.Cel.slug = slug) |> snd + in + Alcotest.(check string) "recorded with the out-of-range reason, not silently dropped" + "omitted: transfer target falls outside the liturgical year (RG 96)" (reason_of "eclipsed") + (* Termination is a correctness requirement (brief): a rite whose [transfer_target] always answers with the impeded day itself (never strictly forward, so the pass can never reach a fixed point) must not @@ -366,5 +439,9 @@ let suite = test_transfer_moves_and_does_not_duplicate; Alcotest.test_case "two colliding transferables land in band order" `Quick test_two_colliding_transferables_land_in_band_order; + Alcotest.test_case "origin records every departure" `Quick + test_origin_records_every_departure; + Alcotest.test_case "transfer target outside year is recorded not lost" `Quick + test_transfer_target_outside_year_is_recorded_not_lost; Alcotest.test_case "transfer guard records failure instead of looping" `Quick test_transfer_guard_records_failure_instead_of_looping ] ) -- cgit v1.3 From 436ba75e27d2aa61b1c6035a22157b40f1a9834b Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 22:01:24 +0200 Subject: rite(ef): RG 91 Table of Precedence MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Precedence_ef.band transcribes RG 91's 28-entry Table of Precedence (rules-register.md §4) for the EF rite: given a day's context and a candidate celebration, returns the table's own entry number, 1-28 (I class 1-13, II class 14-21, III class 22-26, IV class 27-28); lower wins. Every branch carries its entry number and register citation in a comment, checked in the table's own numeric order. Two entries are transcribed as the register states them even though they invert the pattern the rest of the table follows: at III class, 23 (particular calendars) outranks 24 (universal), the reverse of how 11/12 and 14/16/19/20 rank a universal feast ahead of a proper one at I and II class. Sanctoral-origin, layer-decided entries (11-13, 14/16/19/20, 23/24) follow the brief's structural insight: a celebration whose layer is not the universal base is an overlay -- proper, or indult if its layer id also carries the indult prefix. Neither the universal-layer id nor the indult prefix is an RG citation; both are colitur's own data-modelling convention, exposed from the module so whichever task loads the real EF sanctoral overlays can align to them. Vigils (21, 26) are read off the temporal cycle's own -vigil slug suffix rather than gated on origin, since a II/III-class vigil can be either temporal-origin (Ascension, already produced by temporal_ef) or sanctoral-origin (a saint's vigil, no task has loaded yet); Ember days (part of entry 18) are read off temporal_ef's own ember slug prefixes rather than re-derived, since the September anchor is independently flagged there as one of the more contested dates in the calendar. A candidate shape the table has no row for (e.g. a Class1 vigil that is not Nativity or Pentecost, or a Class4 candidate marked as a vigil -- RG 91 has no IV-class vigil either) returns a dedicated unclassified sentinel (max_int) rather than being folded into a same-rank entry it does not belong to. test_precedence_ef.ml is table-driven: one Alcotest.test_case per RG 91 entry (55 rows total, several entries covered by more than one named day so a single missed offset cannot hide behind a passing sibling), each date computed from Computus.gregorian_easter rather than hand-typed, so an arithmetic slip cannot pass by accident. --- lib/rites/rite_ef/precedence_ef.ml | 173 ++++++++++++++++++++++++++++++ lib/rites/rite_ef/precedence_ef.mli | 35 +++++++ test/test_colitur.ml | 2 +- test/test_precedence_ef.ml | 202 ++++++++++++++++++++++++++++++++++++ 4 files changed, 411 insertions(+), 1 deletion(-) create mode 100644 lib/rites/rite_ef/precedence_ef.ml create mode 100644 lib/rites/rite_ef/precedence_ef.mli create mode 100644 test/test_precedence_ef.ml (limited to 'lib') diff --git a/lib/rites/rite_ef/precedence_ef.ml b/lib/rites/rite_ef/precedence_ef.ml new file mode 100644 index 0000000..50da4a7 --- /dev/null +++ b/lib/rites/rite_ef/precedence_ef.ml @@ -0,0 +1,173 @@ +(* 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, a vigil of + the Lord) 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. + - A sanctoral feast's entry (11-13 I class, 14/16/19/20 II class, 23/24 + III class) is decided by its [rank] plus, per the brief's structural + insight, 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 (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 + +(* Ember days are identified by the temporal cycle's own slug convention + (rite_ef/temporal_ef.ml's [ember]: "ef--ember-"), 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. *) +let is_ember_18 slug = + String.starts_with ~prefix:"ef-advent-ember-" slug + || String.starts_with ~prefix:"ef-lent-ember-" slug + || String.starts_with ~prefix:"ef-september-ember-" slug + +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 = String.ends_with ~suffix:"-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 + 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. *) + else if (not is_temporal) && rank = Class1 && m = 11 && d = 2 then 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. *) + else if (not is_temporal) && (not is_vigil) && rank = Class2 && is_universal layer + && 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 15 + (* 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 diff --git a/lib/rites/rite_ef/precedence_ef.mli b/lib/rites/rite_ef/precedence_ef.mli new file mode 100644 index 0000000..e8d4a11 --- /dev/null +++ b/lib/rites/rite_ef/precedence_ef.mli @@ -0,0 +1,35 @@ +(** RG 91's Table of Precedence for the EF (1962) rite: ranks any candidate + for a given day by its RG 91 entry number. See + docs/research/rules-register.md §4, whose 28-entry transcription this + module follows line by line. *) + +open Colitur_kernel + +(** The universal (base) sanctoral layer's {!Celebration.t}.layer id. A + Sanctoral-origin candidate whose layer is anything else is an overlay: + "proper" (RG 91 entries 12, 19, 23) unless its layer id also carries + {!indult_prefix} ("indult", entries 13, 20). This id and the prefix are + colitur's own data-modelling convention, not an RG citation -- RG 91 + prescribes the ranking, not a machine encoding for it. Whichever task + loads the real EF sanctoral base layer and its overlays must either + reuse these two constants or this classifier will misfile them. *) +val universal_layer : string + +(** See {!universal_layer}. *) +val indult_prefix : string + +(** Returned for a candidate shape RG 91's 28-entry table has no row for -- + e.g. a [Class1] vigil that is not the Nativity or Pentecost (entries 5, + 9 are the only I-class vigils the table names), or a [Class4] candidate + also marked as a vigil. Deliberately outside 1..28 and larger than any + real entry, so an unclassified candidate can never win an occurrence + contest by accident; a caller that sees it back knows the shape needs a + new rule, not a silently wrong one. *) +val unclassified : int + +(** [band ctx c]: RG 91's Table of Precedence. Returns the table's own entry + number -- I class 1-13, II class 14-21, III class 22-26, IV class 27-28; + lower wins (see {!Precedence.rules.band}). Total over every candidate + {!Precedence.resolve} or {!Calendar} can construct, including shapes the + 1962 table itself does not describe (see {!unclassified}). *) +val band : Vocab_ef.season Precedence.context -> Vocab_ef.rank Precedence.candidate -> int diff --git a/test/test_colitur.ml b/test/test_colitur.ml index a97e35c..a9cacd2 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -3,4 +3,4 @@ let () = Alcotest.run "colitur" [ Test_date.suite; Test_computus.suite; Test_colour.suite; Test_slug.suite; Test_names.suite; Test_overlay.suite; Test_temporal_ef.suite; Test_validate.suite; Test_precedence.suite; - Test_calendar.suite ] + Test_calendar.suite; Test_precedence_ef.suite ] diff --git a/test/test_precedence_ef.ml b/test/test_precedence_ef.ml new file mode 100644 index 0000000..fb05582 --- /dev/null +++ b/test/test_precedence_ef.ml @@ -0,0 +1,202 @@ +(* RG 91's Table of Precedence, transcribed by Rite_ef.Precedence_ef.band. + Table-driven, one row (hence one Alcotest.test_case) per RG 91 entry, so a + misplaced or missing entry names itself in the failure output instead of + failing anonymously (docs/research/rules-register.md §4). Each row's date + is checked against the register to make sure it is not ALSO an instance of + some other entry at the same band (the vacuous-test trap this project has + caught before -- see the Advent-Ember-day note on entry 18 below). *) + +module P = Colitur_kernel.Precedence +module Cel = Colitur_kernel.Celebration +module S = Colitur_kernel.Slug +module Col = Colitur_kernel.Colour +module D = Colitur_kernel.Date +module Sub = Colitur_kernel.Subject +module Comp = Colitur_kernel.Computus +module T = Rite_ef.Temporal_ef +module V = Rite_ef.Vocab_ef +module PE = Rite_ef.Precedence_ef + +let mk y m dd = match D.make ~year:y ~month:m ~day:dd with Ok t -> t | Error e -> failwith e + +(* [T.season] is the same function Calendar itself would use to build a + context, so a row's [season]/[weekday] are exactly what the real engine + would compute for that date, not a hand-picked value that might not + actually occur together with it. *) +let ctx date = { P.date; season = T.season date; weekday = D.weekday date } + +let cand ?(origin = P.Temporal) ?(rank = V.Class1) ?(subject = Sub.Temporal) ?(layer = "temporal") + slug = + { P.cel = Cel.make ~slug:(S.of_string_exn slug) ~rank ~colour:Col.White ~subject ~layer (); + origin } + +(* Every Easter-relative date below is anchored to this single computed + Easter rather than a hand-typed calendar date, so an arithmetic slip in a + test date cannot silently pass by accident. *) +let easter = Comp.gregorian_easter 2026 +let off n = D.add_days easter n + +(* (description, date, candidate, expected RG 91 entry). *) +let cases = + [ (* Entry 1 -- register line 327: Nativity, Easter Sunday, Pentecost Sunday. *) + ("1 Nativity", mk 2026 12 25, cand "ef-nativity", 1); + ("1 Easter Sunday", off 0, cand "ef-easter-sunday", 1); + ("1 Pentecost Sunday", off 49, cand "ef-pentecost", 1); + (* Entry 2 -- register line 328: Sacred Triduum. Thu-Sat of Holy Week, + NOT entry 7 (which stops at Wednesday -- see entry 7 below). *) + ("2 Holy Thursday", off (-3), cand "ef-holy-thursday", 2); + ("2 Good Friday", off (-2), cand "ef-good-friday", 2); + ("2 Holy Saturday", off (-1), cand "ef-holy-saturday", 2); + (* Entry 3 -- register line 329. *) + ("3 Epiphany", mk 2026 1 6, cand "ef-epiphany", 3); + ("3 Ascension", off 39, cand "ef-ascension", 3); + ("3 Trinity", off 56, cand "ef-trinity", 3); + ("3 Corpus Christi", off 60, cand "ef-corpus-christi", 3); + ("3 Sacred Heart", off 68, cand "ef-sacred-heart", 3); + ("3 Christ the King", T.christ_the_king 2026, cand "ef-christ-the-king", 3); + (* Entry 4 -- register line 330. Sanctoral-origin: neither feast is part + of temporal_ef's movable cycle. *) + ( "4 Immaculate Conception", mk 2026 12 8, + cand ~origin:P.Sanctoral ~subject:Sub.Bvm ~layer:PE.universal_layer + "ef-immaculate-conception", + 4 ); + ("4 Assumption", mk 2026 8 15, cand ~origin:P.Sanctoral ~subject:Sub.Bvm ~layer:PE.universal_layer "ef-assumption", 4); + (* Entry 5 -- register line 331. *) + ("5 Nativity Vigil", mk 2026 12 24, cand "ef-nativity-vigil", 5); + ("5 Octave day (Circumcision)", mk 2026 1 1, cand "ef-circumcision", 5); + (* Entry 6 -- register line 332. *) + ("6 Advent Sunday", T.advent_start 2026, cand "ef-advent-sunday-1", 6); + ("6 Lent Sunday", off (-42), cand "ef-lent-sunday-1", 6); + ("6 Passion Sunday (I Passiontide)", off (-14), cand "ef-passion-sunday", 6); + ("6 Palm Sunday (II Passiontide)", off (-7), cand "ef-palm-sunday", 6); + ("6 Low Sunday", off 7, cand "ef-low-sunday", 6); + (* Entry 7 -- register line 333: Ash Wednesday and Mon/Tue/Wed of Holy + Week ONLY -- Thu-Sat are entry 2 above, not this entry. *) + ("7 Ash Wednesday", off (-46), cand "ef-ash-wednesday", 7); + ("7 Monday of Holy Week", off (-6), cand "ef-holy-monday", 7); + ("7 Tuesday of Holy Week", off (-5), cand "ef-holy-tuesday", 7); + ("7 Wednesday of Holy Week", off (-4), cand "ef-holy-wednesday", 7); + (* Entry 8 -- register line 334. *) + ("8 All Souls", mk 2026 11 2, cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-all-souls", 8); + (* Entry 9 -- register line 335. *) + ("9 Pentecost Vigil", off 48, cand "ef-pentecost-vigil", 9); + (* Entry 10 -- register line 336: both range boundaries, to guard the + off-by-one an inclusive Easter-offset window invites. *) + ("10 Easter octave, day+1", off 1, cand "ef-easter-1-mon", 10); + ("10 Easter octave, day+6", off 6, cand "ef-easter-1-sat", 10); + ("10 Pentecost octave, day+50", off 50, cand "ef-pentecost-1-mon", 10); + ("10 Pentecost octave, day+55", off 55, cand "ef-pentecost-1-sat", 10); + (* Entry 11 -- register line 337. *) + ( "11 Universal I-class feast", mk 2026 6 29, + cand ~origin:P.Sanctoral ~subject:Sub.Saint ~layer:PE.universal_layer "ef-ss-peter-paul", + 11 ); + (* Entry 12 -- register line 338. The one non-base-layer case the brief + asks for explicitly: same date/rank/subject as 11, only the layer + differs, so this row isolates the layer test as the deciding factor. *) + ( "12 Proper I-class feast (non-base layer)", mk 2026 6 29, + cand ~origin:P.Sanctoral ~subject:Sub.Saint ~layer:"diocese-warsaw" "ef-local-patron", + 12 ); + (* Entry 13 -- register line 339. *) + ( "13 Indult I-class feast", mk 2026 6 29, + cand ~origin:P.Sanctoral ~subject:Sub.Saint ~layer:(PE.indult_prefix ^ "local-grant") + "ef-indult-feast-1", + 13 ); + (* Entry 14 -- register line 341. *) + ( "14 Feast of the Lord, II class", mk 2026 7 1, + cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Lord ~layer:PE.universal_layer + "ef-precious-blood", + 14 ); + (* Entry 15 -- register line 342: an ordinary Sunday not named at entry 6 + -- Septuagesima is II class (RG 11-12 names only Advent/Lent/ + Passiontide/Easter/Low/Pentecost as I class). *) + ("15 II-class Sunday (Septuagesima)", off (-63), cand ~rank:V.Class2 "ef-septuagesima-sunday", 15); + (* Entry 16 -- register line 342. *) + ( "16 Universal II-class feast, not of the Lord", mk 2026 1 20, + cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Saint ~layer:PE.universal_layer + "ef-some-saint", + 16 ); + (* Entry 17 -- register line 343: days WITHIN the Nativity octave (26-28 + Dec are Stephen/John/Innocents -- sanctoral, not this entry; 1 Jan is + entry 5's Octave DAY, not this entry either). *) + ("17 Nativity octave, 29 Dec", mk 2026 12 29, cand ~rank:V.Class2 "ef-nativity-octave-day-5", 17); + ("17 Nativity octave, 31 Dec", mk 2026 12 31, cand ~rank:V.Class2 "ef-nativity-octave-day-7", 17); + (* Entry 18 -- register line 343-344: Advent 17-23 Dec ferias AND the + Ember days of Advent/Lent/September share this one entry. The second + row is deliberately a Lent date (season Lent, NOT Advent) to prove the + Ember-slug path fires on its own, not merely because it also happens + to fall in the Dec 17-23 window -- the exact trap the brief warns + about, worked the other way round: this Ember day must NOT be + mistaken for an ordinary entry-22 Lent feria either. *) + ("18 Advent 17-23 Dec feria", mk 2026 12 21, cand ~rank:V.Class2 "ef-advent-4-mon", 18); + ("18 Lent Ember Wednesday", off (-39), cand ~rank:V.Class2 "ef-lent-ember-wed", 18); + (* Entry 19 -- register line 344. *) + ( "19 Proper II-class feast", mk 2026 1 20, + cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Saint ~layer:"diocese-warsaw" + "ef-local-saint-2", + 19 ); + (* Entry 20 -- register line 345. *) + ( "20 Indult II-class feast", mk 2026 1 20, + cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Saint + ~layer:(PE.indult_prefix ^ "local-grant-2") "ef-indult-feast-2", + 20 ); + (* Entry 21 -- register line 345 (RG 28-34). Two rows: the Ascension + Vigil is the one II-class vigil temporal_ef already produces today + (temporal-origin); the Assumption Vigil stands in for the + sanctoral-origin case no task has loaded data for yet -- proving + [band] does not gate this entry on [origin] (see precedence_ef.ml's + file comment). *) + ("21 Ascension Vigil (temporal-origin)", off 38, cand ~rank:V.Class2 "ef-ascension-vigil", 21); + ( "21 Assumption Vigil (sanctoral-origin)", mk 2026 8 14, + cand ~origin:P.Sanctoral ~rank:V.Class2 ~layer:PE.universal_layer "ef-assumption-vigil", + 21 ); + (* Entry 22 -- register line 347-348 (corrected: ends at Palm Sunday, not + Passion Sunday). Both a Lent and a Passiontide feria, clear of Ash + Wednesday, Holy Week and the Ember days. *) + ("22 Lent feria", off (-41), cand ~rank:V.Class3 "ef-lent-1-mon", 22); + ("22 Passiontide feria", off (-12), cand ~rank:V.Class3 "ef-passiontide-1-tue", 22); + (* Entry 23 -- register line 349. NOTE the table's own order here is the + REVERSE of 11/12 and 14/16/19/20 above: entry 23 (particular + calendars) is numbered BELOW entry 24 (universal), so a proper + III-class feast outranks a universal one -- transcribed as the + register states it, not "corrected" to match the other classes. *) + ( "23 Proper III-class feast (non-base layer)", mk 2026 6 30, + cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:"diocese-warsaw" "ef-local-saint-3", + 23 ); + (* Entry 24 -- register line 349. *) + ( "24 Universal III-class feast", mk 2026 6 30, + cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "ef-some-saint-3", + 24 ); + (* Entry 25 -- register line 350. *) + ("25 Advent feria to 16 Dec", mk 2026 12 1, cand ~rank:V.Class3 "ef-advent-1-tue", 25); + (* Entry 26 -- register line 350. *) + ( "26 III-class vigil", mk 2026 8 9, + cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "ef-lawrence-vigil", + 26 ); + (* Entry 27 -- register line 352: an otherwise-unoccupied IV-class + Saturday. *) + ( "27 Office of the BVM on Saturday", off 62, + cand ~rank:V.Class4 "ef-time-after-pentecost-1-sat", + 27 ); + (* Entry 28 -- register line 352: the unqualified IV-class catch-all. *) + ("28 IV-class feria", off 65, cand ~rank:V.Class4 "ef-time-after-pentecost-1-tue", 28); + (* Not an RG 91 row at all: a I-class candidate marked as a vigil, which + is not the Nativity or Pentecost (entries 5/9, the only I-class + vigils the table names) and so has no entry to fall into. Proves the + documented fallback -- not entry 11/12/13, which the [not is_vigil] + guard exists specifically to keep this out of. *) + ( "unclassified: I-class vigil outside Nativity/Pentecost", mk 2026 3 10, + cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-mystery-vigil", + PE.unclassified ); + (* RG 91's own vigil list (register lines 381-384) stops at III class -- + there is no IV-class vigil for entry 28's ferial catch-all to absorb. *) + ( "unclassified: IV-class candidate marked as a vigil", mk 2026 6 20, + cand ~rank:V.Class4 "ef-second-mystery-vigil", PE.unclassified ) + ] + +let suite = + ( "Precedence_ef", + List.map + (fun (desc, date, c, expect) -> + Alcotest.test_case desc `Quick (fun () -> + Alcotest.(check int) desc expect (PE.band (ctx date) c))) + cases ) -- cgit v1.3 From 553dc44d2ba0e131e7f2ac79dc755641afcd6a1c Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 22:26:17 +0200 Subject: rite(ef): fix entry 8's Sunday exception and entry 14's over-restriction Review of 436ba75 found two calendar defects and one coupling risk. Entry 8 (All Souls) dropped register line 334's own qualifier, "(yields to an occurring Sunday)" -- it returned 8 unconditionally, so on 2 November falling on a Sunday (2025, 2031, 2036, 2042 in the 2005-2050 differential window), All Souls incorrectly outranked and observed over the Sunday. 2 November is always Time_after_pentecost and never coincides with any other entry's own date, so the only rival this exception ever has is an ordinary entry-15 II-class Sunday; on such a Sunday, band now returns one worse than entry 15's own value rather than the literal 8 -- strictly worse, not merely different, since an exact tie would fall to Precedence.resolve's slug tie-break, which for "ef-all-souls" against a Sunday slug would make All Souls win the tie anyway. Entry 8's own rank is untouched, so Task 8's disposition still sees a true I-class candidate to transfer. Entry 14 (Feasts of the Lord, II class) added a universal-layer restriction the register's line 341 does not carry -- contrast entry 16 at line 342, which explicitly says "not of the Lord"; RG 37c (register line 393) also speaks of "II-class feasts of the Lord" with no universal qualifier. Dropped the layer test: a proper or indult feast of the Lord now bands 14, not 19/20. Also exposes vigil_suffix and ember_prefixes from precedence_ef.mli, matching universal_layer/indult_prefix's existing "colitur convention, not an RG citation" treatment -- both were previously private literals duplicated in the test file, so a rename of temporal_ef.ml's slug format could have drifted silently past both sides agreeing with each other. Two test rows now build their candidate from Temporal_ef.temporal's own real output (entry 18's Lent Ember day, entry 21's Ascension Vigil) instead of a hand-typed slug, closing that specific coupling. Adds the three cheap rows review named as closing the remaining unpinned guards (a temporal-origin Class1 candidate on an unnamed date; a universal Class2 vigil of the Lord; a non-universal Class3 vigil), plus a resolve()-level test proving the Sunday is actually observed over All Souls, not just that band returns the right integer in isolation. --- lib/rites/rite_ef/precedence_ef.ml | 109 +++++++++++++++++++++++++----------- lib/rites/rite_ef/precedence_ef.mli | 29 +++++++++- test/test_precedence_ef.ml | 102 +++++++++++++++++++++++++++++++-- 3 files changed, 198 insertions(+), 42 deletions(-) (limited to 'lib') diff --git a/lib/rites/rite_ef/precedence_ef.ml b/lib/rites/rite_ef/precedence_ef.ml index 50da4a7..0716177 100644 --- a/lib/rites/rite_ef/precedence_ef.ml +++ b/lib/rites/rite_ef/precedence_ef.ml @@ -9,22 +9,27 @@ 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, a vigil of - the Lord) 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. - - A sanctoral feast's entry (11-13 I class, 14/16/19/20 II class, 23/24 - III class) is decided by its [rank] plus, per the brief's structural - insight, 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 (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. + - 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 @@ -46,19 +51,33 @@ let unclassified = max_int let is_indult layer = String.starts_with ~prefix:indult_prefix layer let is_universal layer = String.equal layer universal_layer -(* Ember days are identified by the temporal cycle's own slug convention - (rite_ef/temporal_ef.ml's [ember]: "ef--ember-"), 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 +(* 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"). Exposed so a future task naming a + sanctoral vigil (Task 10: Assumption, John Baptist, Peter & Paul, + Lawrence -- only Ascension exists today) uses the same suffix; a + differently-named vigil would band 16/24 instead of 21/26, silently. *) +let vigil_suffix = "-vigil" + +let is_vigil slug = String.ends_with ~suffix:vigil_suffix 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--ember-"), 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. *) -let is_ember_18 slug = - String.starts_with ~prefix:"ef-advent-ember-" slug - || String.starts_with ~prefix:"ef-lent-ember-" slug - || String.starts_with ~prefix:"ef-september-ember-" slug + 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-" ] + +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 = @@ -68,7 +87,7 @@ let band (ctx : Vocab_ef.season Precedence.context) (c : Vocab_ef.rank Precedenc 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 = String.ends_with ~suffix:"-vigil" slug 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 @@ -77,6 +96,11 @@ let band (ctx : Vocab_ef.season Precedence.context) (c : Vocab_ef.rank Precedenc (* 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 @@ -101,8 +125,23 @@ let band (ctx : Vocab_ef.season Precedence.context) (c : Vocab_ef.rank Precedenc (* 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. *) - else if (not is_temporal) && rank = Class1 && m = 11 && d = 2 then 8 + (* 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. *) @@ -116,12 +155,16 @@ let band (ctx : Vocab_ef.season Precedence.context) (c : Vocab_ef.rank Precedenc 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. *) - else if (not is_temporal) && (not is_vigil) && rank = Class2 && is_universal layer - && subject = Subject.Lord - then 14 + (* 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 15 + 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, diff --git a/lib/rites/rite_ef/precedence_ef.mli b/lib/rites/rite_ef/precedence_ef.mli index e8d4a11..63fb0a1 100644 --- a/lib/rites/rite_ef/precedence_ef.mli +++ b/lib/rites/rite_ef/precedence_ef.mli @@ -18,6 +18,24 @@ val universal_layer : string (** See {!universal_layer}. *) val indult_prefix : string +(** Slug suffix marking a celebration as a vigil (RG 91 entries 21, 26), + e.g. "ef-ascension-vigil". Also colitur's own convention, not an RG + citation, exposed for the same reason as {!universal_layer}: only the + Ascension Vigil exists today (rite_ef/temporal_ef.ml); the Assumption, + John Baptist, Peter & Paul and Lawrence vigils arrive as sanctoral data + in a future task, and must use this same suffix or {!band} will band + them 16/24 (an ordinary feast of the same rank) instead of 21/26. *) +val vigil_suffix : string + +(** Slug prefixes marking a celebration as one of RG 91 entry 18's three + Ember-day sets (Advent, Lent, September -- the Pentecost/Whitsun set is + I class and matched by entry 10 before this is ever consulted). Also + colitur's own convention mirroring rite_ef/temporal_ef.ml's own "ef- + -ember-" slug format, not re-derived from first principles; exposed + so a rename of that format has somewhere to be caught other than a + silently-wrong entry 18. *) +val ember_prefixes : string list + (** Returned for a candidate shape RG 91's 28-entry table has no row for -- e.g. a [Class1] vigil that is not the Nativity or Pentecost (entries 5, 9 are the only I-class vigils the table names), or a [Class4] candidate @@ -29,7 +47,12 @@ val unclassified : int (** [band ctx c]: RG 91's Table of Precedence. Returns the table's own entry number -- I class 1-13, II class 14-21, III class 22-26, IV class 27-28; - lower wins (see {!Precedence.rules.band}). Total over every candidate - {!Precedence.resolve} or {!Calendar} can construct, including shapes the - 1962 table itself does not describe (see {!unclassified}). *) + lower wins (see {!Precedence.rules.band}) -- EXCEPT where the table's own + text states an exception: entry 8 (All Souls, register line 334) reads + "yields to an occurring Sunday", so on a Sunday this returns a value that + loses to entry 15 rather than the literal integer 8 (see the comment on + entry 8 in precedence_ef.ml for the exact value and why). Total over + every candidate {!Precedence.resolve} or {!Calendar} can construct, + including shapes the 1962 table itself does not describe (see + {!unclassified}). *) val band : Vocab_ef.season Precedence.context -> Vocab_ef.rank Precedence.candidate -> int diff --git a/test/test_precedence_ef.ml b/test/test_precedence_ef.ml index fb05582..7033978 100644 --- a/test/test_precedence_ef.ml +++ b/test/test_precedence_ef.ml @@ -30,6 +30,17 @@ let cand ?(origin = P.Temporal) ?(rank = V.Class1) ?(subject = Sub.Temporal) ?(l { P.cel = Cel.make ~slug:(S.of_string_exn slug) ~rank ~colour:Col.White ~subject ~layer (); origin } +(* A candidate built from [Temporal_ef.temporal]'s own real output, not a + hand-typed slug -- review finding 3: [band]'s Ember/vigil detection reads + temporal_ef.ml's slug conventions, and a row that also hand-types the same + literal proves nothing if that convention ever drifts (both sides would + drift together, silently). Rows built with this instead fail loudly on + such a drift, because they source the slug from the same place [band] + itself is implicitly trusting. *) +let of_temporal date = + let day = T.temporal date in + { P.cel = day.Colitur_kernel.Temporal.office; origin = P.Temporal } + (* Every Easter-relative date below is anchored to this single computed Easter rather than a hand-typed calendar date, so an arithmetic slip in a test date cannot silently pass by accident. *) @@ -76,8 +87,20 @@ let cases = ("7 Monday of Holy Week", off (-6), cand "ef-holy-monday", 7); ("7 Tuesday of Holy Week", off (-5), cand "ef-holy-tuesday", 7); ("7 Wednesday of Holy Week", off (-4), cand "ef-holy-wednesday", 7); - (* Entry 8 -- register line 334. *) - ("8 All Souls", mk 2026 11 2, cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-all-souls", 8); + (* Entry 8 -- register line 334. 2 Nov 2026 is a Monday (verified + independently below the table), so this row is the plain case. The + register's own qualifying case -- "yields to an occurring Sunday" -- + gets its own row and its own end-to-end test after this table (2 Nov + 2025 is a real Sunday). *) + ("8 All Souls (non-Sunday)", mk 2026 11 2, cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-all-souls", 8); + (* Entry 8's qualifier: "(yields to an occurring Sunday)". 2 Nov 2025 is + a Sunday, so this must NOT be 8 -- it must lose to entry 15 (16 = + entry 15's own value + 1, the exact value precedence_ef.ml documents + and justifies at entry 8's branch). The end-to-end resolve-level + proof that the Sunday actually wins the day is + [test_all_souls_yields_to_sunday] below; this row pins the specific + integer [band] returns. *) + ("8 All Souls (yields to a Sunday, 2 Nov 2025)", mk 2025 11 2, cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-all-souls", 16); (* Entry 9 -- register line 335. *) ("9 Pentecost Vigil", off 48, cand "ef-pentecost-vigil", 9); (* Entry 10 -- register line 336: both range boundaries, to guard the @@ -101,11 +124,20 @@ let cases = cand ~origin:P.Sanctoral ~subject:Sub.Saint ~layer:(PE.indult_prefix ^ "local-grant") "ef-indult-feast-1", 13 ); - (* Entry 14 -- register line 341. *) + (* Entry 14 -- register line 341, deliberately UNQUALIFIED (contrast + entry 16, line 342, which explicitly says "not of the Lord"). *) ( "14 Feast of the Lord, II class", mk 2026 7 1, cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Lord ~layer:PE.universal_layer "ef-precious-blood", 14 ); + (* Entry 14, non-base layer: unlike 11-13/16/19/20/23/24, entry 14 draws + no universal/proper/indult line at all, so this must STILL be 14, not + 19 -- the exact restriction review finding 2 flagged and this row + exists to keep from silently coming back. *) + ( "14 Feast of the Lord, II class (non-base layer)", mk 2026 7 2, + cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Lord ~layer:"diocese-warsaw" + "ef-local-feast-of-the-lord", + 14 ); (* Entry 15 -- register line 342: an ordinary Sunday not named at entry 6 -- Septuagesima is II class (RG 11-12 names only Advent/Lent/ Passiontide/Easter/Low/Pentecost as I class). *) @@ -128,7 +160,10 @@ let cases = about, worked the other way round: this Ember day must NOT be mistaken for an ordinary entry-22 Lent feria either. *) ("18 Advent 17-23 Dec feria", mk 2026 12 21, cand ~rank:V.Class2 "ef-advent-4-mon", 18); - ("18 Lent Ember Wednesday", off (-39), cand ~rank:V.Class2 "ef-lent-ember-wed", 18); + (* Sourced from Temporal_ef.temporal's own output (see [of_temporal]) + rather than a hand-typed "ef-lent-ember-wed" -- closes review finding + 3's coupling concern for the Ember prefixes specifically. *) + ("18 Lent Ember Wednesday (from Temporal_ef.temporal)", off (-39), of_temporal (off (-39)), 18); (* Entry 19 -- register line 344. *) ( "19 Proper II-class feast", mk 2026 1 20, cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Saint ~layer:"diocese-warsaw" @@ -145,10 +180,20 @@ let cases = sanctoral-origin case no task has loaded data for yet -- proving [band] does not gate this entry on [origin] (see precedence_ef.ml's file comment). *) - ("21 Ascension Vigil (temporal-origin)", off 38, cand ~rank:V.Class2 "ef-ascension-vigil", 21); + (* Sourced from Temporal_ef.temporal's own output (see [of_temporal]) + rather than a hand-typed "ef-ascension-vigil" -- closes review finding + 3's coupling concern for [vigil_suffix]. *) + ("21 Ascension Vigil (from Temporal_ef.temporal)", off 38, of_temporal (off 38), 21); ( "21 Assumption Vigil (sanctoral-origin)", mk 2026 8 14, cand ~origin:P.Sanctoral ~rank:V.Class2 ~layer:PE.universal_layer "ef-assumption-vigil", 21 ); + (* Also review finding 3 / "worth doing": a UNIVERSAL-layer Class2 vigil + whose subject is the Lord must still be 21, not 14 -- pins entry 14's + [not is_vigil] guard even after finding 2 dropped its layer test. *) + ( "21 Universal II-class vigil of the Lord", mk 2026 6 23, + cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Lord ~layer:PE.universal_layer + "ef-precious-blood-vigil", + 21 ); (* Entry 22 -- register line 347-348 (corrected: ends at Palm Sunday, not Passion Sunday). Both a Lent and a Passiontide feria, clear of Ash Wednesday, Holy Week and the Ember days. *) @@ -172,6 +217,11 @@ let cases = ( "26 III-class vigil", mk 2026 8 9, cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "ef-lawrence-vigil", 26 ); + (* Also worth doing: a NON-universal-layer Class3 vigil must still be 26, + not 23 -- pins entry 23's [not is_vigil] guard. *) + ( "26 III-class vigil (non-base layer)", mk 2026 8 10, + cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:"diocese-warsaw" "ef-local-patron-vigil", + 26 ); (* Entry 27 -- register line 352: an otherwise-unoccupied IV-class Saturday. *) ( "27 Office of the BVM on Saturday", off 62, @@ -187,16 +237,56 @@ let cases = ( "unclassified: I-class vigil outside Nativity/Pentecost", mk 2026 3 10, cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-mystery-vigil", PE.unclassified ); + (* Also worth doing: a temporal-origin Class1 candidate on a date none of + entries 1/2/3/5/6/7/9/10 name. 15 Jul 2026 is a Wednesday, off=101 + from Easter -- clear of every Easter-relative window this module + checks, and not one of the fixed dates either. Without the + [not is_temporal] guard on entries 11-13, this would wrongly reach 12 + (its default layer, "temporal", is not [universal_layer] and does not + carry [indult_prefix], so it reads as "proper" by the layer test + alone -- precisely the bug the guard exists to prevent; see the + [not is_temporal] guard's role in the entry-25 mutation test recorded + in the task report). *) + ("unclassified: I-class temporal candidate on an unnamed date", mk 2026 7 15, cand "ef-unnamed-day", PE.unclassified); (* RG 91's own vigil list (register lines 381-384) stops at III class -- there is no IV-class vigil for entry 28's ferial catch-all to absorb. *) ( "unclassified: IV-class candidate marked as a vigil", mk 2026 6 20, cand ~rank:V.Class4 "ef-second-mystery-vigil", PE.unclassified ) ] +(* Review finding 1's end-to-end proof: on a real Sunday landing on 2 + November, [Precedence.resolve] -- not just [band] in isolation -- observes + the Sunday, not All Souls. This exercises the exact mechanism the finding + named ("resolve observes the lowest band, so whenever 2 November falls on + a Sunday, All Souls wins and the Sunday loses"), rather than only the + integer [band] returns for the standalone row above. [disposition] and + [admit] are stubs -- only [observed] is under test here. *) +let test_all_souls_yields_to_sunday () = + let date = mk 2025 11 2 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 all_souls = cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-all-souls" in + let rules = + { P.band = (fun c cd -> PE.band c cd); + disposition = (fun ~winner:_ ~loser:_ -> P.Omit); + admit = (fun ~observed:_ cs -> 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" + "ef-time-after-pentecost-sunday-x" + (S.to_string resolution.P.observed.P.cel.Cel.slug) + let suite = ( "Precedence_ef", List.map (fun (desc, date, c, expect) -> Alcotest.test_case desc `Quick (fun () -> Alcotest.(check int) desc expect (PE.band (ctx date) c))) - cases ) + cases + @ [ Alcotest.test_case "8 All Souls yields to a Sunday (resolve-level)" `Quick + test_all_souls_yields_to_sunday ] ) -- cgit v1.3 From 07c87370d6a0de687b42a41d967135578f014bdc Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 22:46:30 +0200 Subject: rite(ef): occurrence dispositions (RG 92-95, 33, 94) Precedence_ef.disposition decides the loser's fate in an occurrence: a Commemoration_only celebration is always commemorated (it can never win or transfer); a I- or II-class vigil impeded by any Sunday or a I-class feast is entirely omitted (RG 33), checked before the generic rule below or the Nativity/Pentecost Vigil could wrongly transfer; any other I-class loser transfers (RG 95 -- only I class has the right of translation); everything else is commemorated, with the admit-or-omit decision left to RG 108-111's admission count (Task 9). RG 94 needs no code: resolve always compares a loser against the day's actual winner, never against a departed sibling, so no commemoration can ride along with a transferred feast in this design. This is the branch that completes Task 7's carried All Souls fix: once it loses to an occurring Sunday, its untouched Class1 rank routes it to Transfer via the generic rule, not a special case. Landing on 3 November is Rite.transfer_target's job, not wired up yet. Commemorate carries an interim Precedence.Ordinary privilege pending Task 9's RG 109 implementation, exposed as interim_privilege for that task to replace. Table-driven tests cover each rule, including RG 33's boundary from both sides and a Commemoration_only loser that is also Class1 and vigil-shaped to pin the branch ordering. Mutation-tested: disabling RG 33, either direction of RG 95's rank condition, or the Commemoration_only priority check each fail exactly the rows built to catch them. --- lib/rites/rite_ef/precedence_ef.ml | 95 +++++++++++++++++++++++ lib/rites/rite_ef/precedence_ef.mli | 46 +++++++++++ test/test_precedence_ef.ml | 148 +++++++++++++++++++++++++++++++++++- 3 files changed, 285 insertions(+), 4 deletions(-) (limited to 'lib') diff --git a/lib/rites/rite_ef/precedence_ef.ml b/lib/rites/rite_ef/precedence_ef.ml index 0716177..d8d64a8 100644 --- a/lib/rites/rite_ef/precedence_ef.ml +++ b/lib/rites/rite_ef/precedence_ef.ml @@ -214,3 +214,98 @@ let band (ctx : Vocab_ef.season Precedence.context) (c : Vocab_ef.rank Precedenc "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--sunday-" 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 "any Sunday or a I-class feast": every RG 91 entry that can ever + outrank a II-class vigil (entry 21) without itself being a Sunday is I + class by the table's own structure (entries 1-13), so [rank = Class1] + alone already covers every way a I-class vigil (entries 5, 9 -- Nativity, + Pentecost) can be impeded at all; the slug check is what a II-class vigil + impeded by an ordinary Sunday (entry 15, rank Class2) needs, since that + winner's own rank is not Class1. *) +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) + +(* 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 + +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. *) + Precedence.Commemorate interim_privilege + 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 then + (* RG 95: only I-class feasts have the right of translation. This is the + branch that completes Task 7's All Souls fix (register line 334, RG + 91 entry 8): All Souls is I class and not a vigil, so once it loses + to an occurring Sunday it reaches here and transfers -- to 3 + November per the register, but WHERE it lands is + Rite.transfer_target's job (RG 96), not this function's; disposition + only says THAT it moves. *) + Precedence.Transfer + else + (* 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. + + 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 interim_privilege diff --git a/lib/rites/rite_ef/precedence_ef.mli b/lib/rites/rite_ef/precedence_ef.mli index 63fb0a1..9fe8789 100644 --- a/lib/rites/rite_ef/precedence_ef.mli +++ b/lib/rites/rite_ef/precedence_ef.mli @@ -56,3 +56,49 @@ val unclassified : int including shapes the 1962 table itself does not describe (see {!unclassified}). *) val band : Vocab_ef.season Precedence.context -> Vocab_ef.rank Precedence.candidate -> int + +(** RG 33's marker: every Sunday slug this rite's temporal cycle produces + (temporal_ef.ml's [named] and [sunday_slug]) contains this substring; + nothing else {!band} classifies does. Also colitur's own convention, not + an RG citation -- see {!universal_layer} -- exposed for the same reason + as {!vigil_suffix}: a rename of temporal_ef's Sunday-slug format has + 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), + except RG 33's vigil omission, which also reads the winner: + - a {!Celebration.status} of [Commemoration_only] is always + [Commemorate] (checked first: it can never win -- see + {!Precedence.resolve} -- and, by that same status's own definition, + already denotes an office with nothing left to translate, so it never + transfers either; not itself a further RG citation beyond RG 93's + general four-mechanism statement above); + - a [Class1] or [Class2] loser whose slug marks it a vigil ({!vigil_suffix}) + is [Omit] when the winner is any Sunday ({!sunday_marker}) or itself + [Class1] (RG 33 -- entirely omitted, not merely commemorated); + - any other [Class1] loser is [Transfer] (RG 95 -- only I class has the + 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. + + Total over every winner/loser pair {!Precedence.resolve} or {!Calendar} + can construct: [Vocab_ef.rank] (RG 8) and {!Celebration.status} are both + closed variants, so the four cases above exhaust every representable + shape -- there is no fifth, "unclassified" case the way {!band} needs + one, because this function's own return type has no such slot to fall + into by accident. *) +val disposition : + winner:Vocab_ef.rank Precedence.candidate -> + loser:Vocab_ef.rank Precedence.candidate -> + Precedence.disposition diff --git a/test/test_precedence_ef.ml b/test/test_precedence_ef.ml index 7033978..3b2d5f6 100644 --- a/test/test_precedence_ef.ml +++ b/test/test_precedence_ef.ml @@ -25,9 +25,9 @@ let mk y m dd = match D.make ~year:y ~month:m ~day:dd with Ok t -> t | Error e - actually occur together with it. *) let ctx date = { P.date; season = T.season date; weekday = D.weekday date } -let cand ?(origin = P.Temporal) ?(rank = V.Class1) ?(subject = Sub.Temporal) ?(layer = "temporal") - slug = - { P.cel = Cel.make ~slug:(S.of_string_exn slug) ~rank ~colour:Col.White ~subject ~layer (); +let cand ?(origin = P.Temporal) ?(rank = V.Class1) ?(status = Cel.Feast) ?(subject = Sub.Temporal) + ?(layer = "temporal") slug = + { P.cel = Cel.make ~slug:(S.of_string_exn slug) ~rank ~status ~colour:Col.White ~subject ~layer (); origin } (* A candidate built from [Temporal_ef.temporal]'s own real output, not a @@ -281,6 +281,136 @@ let test_all_souls_yields_to_sunday () = "ef-time-after-pentecost-sunday-x" (S.to_string resolution.P.observed.P.cel.Cel.slug) +(* Task 8: [disposition] -- what happens to the day's LOSING candidate (RG + 92-95, 33, 94; register lines 316-325, 381-384). Table-driven like [band]'s + own [cases] above, one row per rule, each checked against a description of + which register clause it pins. [disposition] takes no context (see + precedence.mli's [rules.disposition]), so "is the winner a Sunday" is read + off the winner's own slug the same way [band] itself reads "is this a + vigil" off the loser's -- see precedence_ef.ml's [sunday_marker]. *) + +let string_of_disposition = function + | P.Omit -> "Omit" + | P.Commemorate P.Privileged -> "Commemorate(Privileged)" + | P.Commemorate P.Ordinary -> "Commemorate(Ordinary)" + | P.Transfer -> "Transfer" + | P.Repose -> "Repose" + +(* A II-class ordinary Sunday, built the same way [test_all_souls_yields_to_sunday] + builds its Sunday -- a hand-typed slug matching temporal_ef.ml's own + "ef--sunday-" convention, since [disposition] only ever reads + this string, never the real computed date. *) +let an_ordinary_sunday = + cand ~rank:V.Class2 "ef-time-after-pentecost-sunday-11" + +let disposition_cases = + [ (* RG 95 -- register line 323-325: only I-class feasts transfer; a + II-class feast loses to a I-class day and is COMMEMORATED, not + transferred. Paired with the next row (a I-class loser, same shape of + winner) so the discriminating factor is provably the LOSER's own + rank, not the winner's -- the brief's explicit "one without the other + proves nothing" pairing. *) + ( "RG95 II-class feast loses to I-class day -> Commemorate", + cand "ef-nativity", + cand ~origin:P.Sanctoral ~rank:V.Class2 ~layer:PE.universal_layer "ef-some-saint", + "Commemorate(Ordinary)" ); + ( "RG95 I-class feast loses to a higher I-class day -> Transfer", + cand "ef-nativity", + cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-local-i-class-feast", + "Transfer" ); + (* RG 33 -- register line 383-384: a I/II-class vigil impeded by any + Sunday or a I-class feast is entirely OMITTED, not commemorated. The + vigil is sourced from [Temporal_ef.temporal]'s own real output (as + [of_temporal]'s existing callers above do), not a hand-typed + "ef-ascension-vigil", so a drift in temporal_ef's vigil-slug + convention cannot silently defeat this row the way a duplicated + literal could. This is the row the brief singles out as most likely + to pass vacuously if the fallback below happened to already be + [Omit] -- it is not: the fallback is [Commemorate] (see the next two + rows), so this genuinely exercises RG 33's own branch. *) + ( "RG33 II-class vigil loses to an ordinary Sunday -> Omit", + an_ordinary_sunday, + of_temporal (off 38) (* Ascension Vigil *), + "Omit" ); + ( "RG33 II-class vigil loses to a I-class feast (non-Sunday) -> Omit", + cand "ef-immaculate-conception", + of_temporal (off 38), + "Omit" ); + (* RG 33's own boundary, proved from both sides so the rule is shown to + gate on the WINNER too, not "any vigil is always omitted": *) + ( "RG33 boundary: vigil loses to an ordinary (non-Sunday, non-I-class) \ + II-class day -> Commemorate, NOT Omit", + cand ~origin:P.Sanctoral ~rank:V.Class2 ~layer:PE.universal_layer "ef-some-other-feast", + of_temporal (off 38), + "Commemorate(Ordinary)" ); + ( "RG33 boundary: a III-class vigil (outside RG33's I/II-class scope) \ + loses to a Sunday -> Commemorate, NOT Omit", + an_ordinary_sunday, + cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "ef-lawrence-vigil", + "Commemorate(Ordinary)" ); + (* Brief: a Commemoration_only loser is ALWAYS Commemorate -- checked + 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. *) + ( "Commemoration_only loser is always Commemorate, even if I-class and \ + vigil-shaped, even losing to a Sunday", + an_ordinary_sunday, + cand ~origin:P.Sanctoral ~status:Cel.Commemoration_only ~layer:PE.universal_layer + "ef-suppressed-vigil", + "Commemorate(Ordinary)" ); + (* 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. *) + ( "III-class feast loses to a I-class day -> Commemorate", + cand "ef-nativity", + cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "ef-some-saint-3", + "Commemorate(Ordinary)" ); + ( "IV-class feria loses to a II-class Sunday -> Commemorate", + an_ordinary_sunday, + cand ~rank:V.Class4 "ef-time-after-pentecost-1-sat", + "Commemorate(Ordinary)" ) + ] + +(* 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 + be TRANSFERRED, not commemorated and not omitted. All Souls is I class + (RG 91 entry 8's own [rank] field, untouched by the Sunday-exception band + bump -- see precedence_ef.ml's comment on entry 8), so RG 95's rank + condition alone should route it to [Transfer]. *) +let test_all_souls_disposition_is_transfer () = + let sunday = an_ordinary_sunday in + let all_souls = cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-all-souls" in + Alcotest.(check string) "All Souls loses to a Sunday and transfers" + "Transfer" + (string_of_disposition (PE.disposition ~winner:sunday ~loser:all_souls)) + +(* The same fact, proved end-to-end through [Precedence.resolve] with the + REAL [PE.band] and REAL [PE.disposition] wired together (Task 7's own + integration test above still stubs [disposition] to a constant [Omit], + which is exactly what this task must not leave true) -- All Souls must + land in [deferred], not [commemorations] or [omitted]. WHERE it is placed + (3 November, RG 96) is [Rite.transfer_target]'s job, out of this task's + scope; this only proves [resolve] hands it to the transfer path at all. *) +let test_all_souls_transfers_end_to_end () = + let date = mk 2025 11 2 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 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:_ cs -> 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" ] + (List.map (fun c -> S.to_string c.P.cel.Cel.slug) resolution.P.deferred); + Alcotest.(check int) "nothing commemorated" 0 (List.length resolution.P.commemorations); + Alcotest.(check int) "nothing omitted" 0 (List.length resolution.P.omitted) + let suite = ( "Precedence_ef", List.map @@ -289,4 +419,14 @@ let suite = Alcotest.(check int) desc expect (PE.band (ctx date) c))) cases @ [ Alcotest.test_case "8 All Souls yields to a Sunday (resolve-level)" `Quick - test_all_souls_yields_to_sunday ] ) + test_all_souls_yields_to_sunday ] + @ 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)))) + disposition_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 ] ) -- cgit v1.3 From 8c6788053dce2a365e3ddf22eccc9c68e641f32e Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 22:56:07 +0200 Subject: rite(ef): fix false justification in impedes_vigil's comment Review finding: the comment claimed every RG 91 entry that can outrank a II-class vigil (entry 21) without being a Sunday is I class 'by the table's own structure (entries 1-13)'. False -- 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 entry 21, and none is a Sunday. The code was always correct: impedes_vigil implements RG 33's own two named conditions (any Sunday, or a I-class feast) directly, and does not depend on the band table's numeric ordering at all. Reworded to say so, citing the counter-example entries the review named instead of appealing to a table structure that does not guarantee what the old comment claimed. Comment-only change; no logic, signature, or test changes. --- lib/rites/rite_ef/precedence_ef.ml | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) (limited to 'lib') diff --git a/lib/rites/rite_ef/precedence_ef.ml b/lib/rites/rite_ef/precedence_ef.ml index d8d64a8..02181ed 100644 --- a/lib/rites/rite_ef/precedence_ef.ml +++ b/lib/rites/rite_ef/precedence_ef.ml @@ -243,13 +243,17 @@ let contains_substring s ~needle = let is_sunday_slug slug = contains_substring slug ~needle:sunday_marker -(* RG 33's "any Sunday or a I-class feast": every RG 91 entry that can ever - outrank a II-class vigil (entry 21) without itself being a Sunday is I - class by the table's own structure (entries 1-13), so [rank = Class1] - alone already covers every way a I-class vigil (entries 5, 9 -- Nativity, - Pentecost) can be impeded at all; the slug check is what a II-class vigil - impeded by an ordinary Sunday (entry 15, rank Class2) needs, since that - winner's own rank is not Class1. *) +(* 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 -- cgit v1.3 From 2ad350e0f97a99f76ac1d2d95cfa210f7393c777 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 23:25:39 +0200 Subject: rite(ef): commemoration privilege and admission (RG 108-111) Precedence_ef.privilege_of classifies a commemoration candidate against RG 109's closed list of privileged commemorations (a Sunday; a I-class day; a day within the Octave of the Nativity; a September Ember day; a feria of Advent, Lent or Passiontide; the Major Rogations in Mass), read entirely off the candidate's own rank/slug/origin, no context needed. Major Rogations (f) is left unimplemented rather than guessed: no producer for the Major Litanies exists anywhere in this codebase yet. disposition's two Commemorate sites now call privilege_of instead of Task 8's interim_privilege placeholder, which is removed entirely (binding and .mli export both gone). Precedence_ef.admit applies RG 111's four admission counts, keyed on the observed day's own class and Sunday-ness: a I-class day admits none except one privileged commemoration; a II-class Sunday admits one, but a privileged commemoration due displaces any ordinary one regardless of dignity; any other II-class day admits one by dignity alone, with no such override; III/IV-class days admit at most two by dignity. Ties break on slug, matching Precedence.compare_by, so the admitted set never depends on input order. Every admitted candidate is a value taken unchanged from the input list, never rebuilt, so Precedence.resolve's physical-equality-based dropped/omitted accounting keeps working -- closing a note left open since Task 2. Tests: RG 109 category rows (one per reachable category, plus boundary rows proving Advent/Lent Ember days and Minor Rogations are correctly excluded), RG 111 admission rows checked on slug identity rather than count, an order-independence check, and three end-to-end integration tests proving the admission limit's drop lands in resolution.omitted rather than vanishing. --- lib/rites/rite_ef/precedence_ef.ml | 224 ++++++++++++++++++++++++-- lib/rites/rite_ef/precedence_ef.mli | 62 ++++++-- test/test_precedence_ef.ml | 310 +++++++++++++++++++++++++++++++++++- 3 files changed, 567 insertions(+), 29 deletions(-) (limited to 'lib') 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 + -- 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-", + 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 ] ) -- cgit v1.3 From 3583448631c1f1cf0767728d605a858fcb810cfc Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 23:41:33 +0200 Subject: rite(ef): an impeded I-class Sunday commemorates, not transfers disposition's Class1 branch was unconditional on rank, so an impeded I-class Sunday (Advent/Lent/Passiontide/Low Sunday) currently transferred like a feast. RG 95 (register lines 323, 363) restricts the right of translation to I-class FEASTS -- RG 91's own table lists Sundays as a separate row (entry 6, line 332) from feasts (entries 11-13, lines 337-339) -- and RG 109(a) (line 374) lists "of a Sunday" as a privileged commemoration category, which presupposes an impeded Sunday stays put rather than moving to another day. Excludes is_sunday_slug losers from the Transfer branch so they fall through to the existing Commemorate (privilege_of loser) branch, which already tags them Privileged via RG 109(a) with no further change. Fires on real dates in the 2005-2050 differential window: 24 December on Advent IV in 2023, 2028, 2034, 2045; 8 December on an Advent Sunday in 2024, 2030, 2041. Verified no previously-passing Transfer assertion used a Sunday-shaped loser (grepped test_precedence_ef.ml, test_calendar.ml -- which uses its own synthetic rite unrelated to Precedence_ef.disposition -- test_colitur.ml, test_validate.ml); confirmed by mutation-reverting the fix and observing exactly the one new test fail, nothing else. --- lib/rites/rite_ef/precedence_ef.ml | 36 +++++++++++++++++++++++++----------- lib/rites/rite_ef/precedence_ef.mli | 27 +++++++++++++++++---------- test/test_precedence_ef.ml | 22 ++++++++++++++++++++++ 3 files changed, 64 insertions(+), 21 deletions(-) (limited to 'lib') diff --git a/lib/rites/rite_ef/precedence_ef.ml b/lib/rites/rite_ef/precedence_ef.ml index 06bbf7c..ff6f991 100644 --- a/lib/rites/rite_ef/precedence_ef.ml +++ b/lib/rites/rite_ef/precedence_ef.ml @@ -383,20 +383,34 @@ let disposition ~(winner : Vocab_ef.rank Precedence.candidate) 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 then - (* RG 95: only I-class feasts have the right of translation. This is the + 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 and not a vigil, so once it loses - to an occurring Sunday it reaches here and transfers -- to 3 - November per the register, but WHERE it lands is - Rite.transfer_target's job (RG 96), not this function's; disposition - only says THAT it moves. *) + 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 per the register, but WHERE it lands + is Rite.transfer_target's job (RG 96), not this function's; + disposition only says THAT it moves. *) Precedence.Transfer else - (* 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 - ([admit], below), not this function's decision; this only opens the + (* 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]. diff --git a/lib/rites/rite_ef/precedence_ef.mli b/lib/rites/rite_ef/precedence_ef.mli index 9c3af95..e1b3638 100644 --- a/lib/rites/rite_ef/precedence_ef.mli +++ b/lib/rites/rite_ef/precedence_ef.mli @@ -78,19 +78,26 @@ val sunday_marker : string - a [Class1] or [Class2] loser whose slug marks it a vigil ({!vigil_suffix}) is [Omit] when the winner is any Sunday ({!sunday_marker}) or itself [Class1] (RG 33 -- entirely omitted, not merely commemorated); - - any other [Class1] loser is [Transfer] (RG 95 -- only I class has the - 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 its real RG 109 privilege - (see {!admit} below). + - any other [Class1] loser that is NOT a Sunday ({!sunday_marker}) is + [Transfer] (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, from feasts, entries 11-13, so a Sunday is + never a "feast" in RG 95's sense and does not transfer even when + impeded by a higher I-class day. 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 -- including an impeded I-class Sunday -- is + [Commemorate], carrying its real RG 109 privilege (see {!admit} + below); RG 109(a) (register line 374) lists "of a Sunday" as a + privileged commemoration category precisely because an impeded Sunday + stays put rather than moving to another day. Total over every winner/loser pair {!Precedence.resolve} or {!Calendar} can construct: [Vocab_ef.rank] (RG 8) and {!Celebration.status} are both - closed variants, so the four cases above exhaust every representable - shape -- there is no fifth, "unclassified" case the way {!band} needs - one, because this function's own return type has no such slot to fall - into by accident. *) + closed variants, so the cases above exhaust every representable shape -- + there is no fifth, "unclassified" case the way {!band} needs one, + because this function's own return type has no such slot to fall into + by accident. *) val disposition : winner:Vocab_ef.rank Precedence.candidate -> loser:Vocab_ef.rank Precedence.candidate -> diff --git a/test/test_precedence_ef.ml b/test/test_precedence_ef.ml index f3fd357..09c41fd 100644 --- a/test/test_precedence_ef.ml +++ b/test/test_precedence_ef.ml @@ -318,6 +318,28 @@ let disposition_cases = cand "ef-nativity", cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-local-i-class-feast", "Transfer" ); + (* Fix round 1 (post-Task-9 review): RG 95 (register lines 323, 363) + restricts the right of translation to I-class FEASTS -- RG 91's own + table lists Sundays as a separate row (entry 6, register line 332) + from feasts (entries 11-13, lines 337-339) -- so an impeded I-class + Sunday must NOT transfer, unlike the plain I-class feast row above: + same [Class1] rank, same kind of winner, the ONLY difference is that + this loser's slug carries [PE.sunday_marker]. RG 109(a) (register + line 374) confirms this from the other direction: "of a Sunday" is a + privileged commemoration category, which presupposes an impeded + Sunday stays put rather than moving to another day the way a feast + does. Sourced from [Temporal_ef.temporal]'s own real output (Advent I + Sunday 2026, Class1, "ef-advent-sunday-1"), the same coupling-safety + reason [of_temporal]'s other callers use it -- this is also a + realistic shape: 8 December falls on an Advent Sunday in 2024, 2030 + and 2041 (Immaculate Conception, RG 91 entry 4, outranking entry 6), + and 24 December falls on Advent IV in 2023, 2028, 2034 and 2045 (the + Nativity Vigil, also entry 5 outranking entry 6). *) + ( "RG95/RG109(a): an impeded I-class SUNDAY does NOT transfer -- it is \ + Commemorated and Privileged", + cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-immaculate-conception", + of_temporal (T.advent_start 2026), + "Commemorate(Privileged)" ); (* RG 33 -- register line 383-384: a I/II-class vigil impeded by any Sunday or a I-class feast is entirely OMITTED, not commemorated. The vigil is sourced from [Temporal_ef.temporal]'s own real output (as -- cgit v1.3 From 7f183c847f8b67c88ad6ea3bf2d635c5c0534651 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 12 Aug 2026 00:44:36 +0200 Subject: cli: colitur day dumps resolved liturgical days Assembles Rite_ef.context (lib/rites/rite_ef/rite_ef.ml[i]): temporal, anchors and vocab from Temporal_ef; rules from Precedence_ef's band, disposition and admit; season_runs = Vocab_ef.seasons; transfer_target newly implemented here. transfer_target (RG 96): the next following day that is not I or II class, with the Annunciation's own exception (Monday after Low Sunday). Terminates by a structural step bound on its internal search, independent of Calendar's own round guard, which bounds rounds across a year, not one call's walk; documented as an obligation on rite.mli's transfer_target field, which did not previously state it. Fixes the vigil-naming mismatch Task 7's review predicted: the sanctoral bootstrap names its vigils with a vigil-of-X prefix (lectio's own convention), while Precedence_ef's is_vigil only recognised the temporal cycle's own X-vigil suffix. Both are now recognised, fixing RG 91 entries 21/26 and RG 33's vigil omission for the four affected celebrations. Verified by unit test and by mutation-testing the fix (reverting it fails exactly the new rows) and against real output across several years. Suppresses data/ef/sanctoral.sexp's vigil-of-christmas via a new overlay, data/ef/adjustments.sexp: it is the same celebration as the temporal cycle's own ef-nativity-vigil, both dated 24 December. colitur day : one line per civil-year day, temporal and sanctoral fully resolved through Layer, Overlay, Precedence_ef and Calendar -- the first CLI path exercising the whole Plan 3 pipeline against real data. Verified the All Souls transfer chain (Tasks 7-8-11) end to end against real output for both a Sunday year (2025, lands on 3 Nov) and a non-Sunday year (2026, observed directly on 2 Nov). --- bin/main.ml | 137 +++++++++++++++++++++++++++++++++++- data/ef/adjustments.sexp | 13 ++++ lib/kernel/rite.mli | 22 +++++- lib/rites/rite_ef/precedence_ef.ml | 112 +++++++++++++++++++++++++++-- lib/rites/rite_ef/precedence_ef.mli | 68 ++++++++++++++++-- lib/rites/rite_ef/rite_ef.ml | 24 +++++++ lib/rites/rite_ef/rite_ef.mli | 35 +++++++++ test/cli.t | 67 +++++++++++++++++- test/dune | 2 +- test/test_precedence_ef.ml | 130 +++++++++++++++++++++++++++++++++- 10 files changed, 594 insertions(+), 16 deletions(-) create mode 100644 data/ef/adjustments.sexp create mode 100644 lib/rites/rite_ef/rite_ef.ml create mode 100644 lib/rites/rite_ef/rite_ef.mli (limited to 'lib') diff --git a/bin/main.ml b/bin/main.ml index 896a6bd..53cae87 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -41,8 +41,142 @@ let temporal_report y = d := D.add_days !d 1 done +(* Task 11: the fully resolved EF calendar (temporal AND sanctoral, + occurrence and transfers applied), one line per civil-year day -- + "YYYY-MM-DD weekday season week slug rank colour [+commemoration-slug]...". + [temporal_report] above only ever showed the temporal cycle in isolation + ([Rite_ef.Temporal_ef.temporal] directly, no sanctoral layer, no + [Precedence] contest); this is the first CLI path that runs every piece + Plan 3 built -- [Colitur_kernel.Layer], [Overlay], [Precedence_ef], + [Calendar] -- against real data. *) + +(* [data/ef/sanctoral.sexp] and [data/ef/adjustments.sexp] are located + relative to the BUILD TREE, not the process's own cwd: cwd varies with + how the binary is invoked (a user's shell for `dune exec colitur --`, a + dune cram test's own sandboxed temp directory for `test/cli.t`) and + nothing in this project's build pins it to the repository root. A + build-time constant substituted via dune's [%{workspace_root}] was tried + first and rejected: it is resolved RELATIVE TO THE BUILD ACTION'S OWN + directory (empirically "." here, not an absolute path -- dune keeps + build actions relocatable), so it silently reproduces the same + cwd-dependence this is trying to eliminate, just baked in at build time + instead of read at run time; confirmed by the resulting `colitur day` + failing to find its own data outside the exact directory the build + happened to run in. + + [Sys.executable_name] does not have that problem -- on Linux it resolves + through /proc/self/exe, which the kernel always reports as the + executable's own canonical absolute path, even when the process was + launched through a symlink (verified against dune's own cram sandbox, + which places exactly such a symlink; see the task report). dune's default + ("no [(sandbox ...)] declared") build context mirrors the ENTIRE source + tree under _build/default/, unconditionally, so climbing from + _build/default/bin/main.exe up two directories and back down into data/ + always finds both files, regardless of the caller's own cwd. + + Known limitation, not yet exercised by this project: a `dune install`- + style deployment (executable copied to a prefix with no adjacent _build/ + default/data/) would need a different resolution strategy; there is no + install story yet (README.md: `dune exec` only), so this is not a + regression against anything this project currently supports. *) +let data_dir () = Filename.dirname (Filename.dirname Sys.executable_name) ^ "/data/ef" + +(* Loads the universal sanctoral layer and applies the one hand-authored + overlay over it (data/ef/adjustments.sexp -- see that file's own header): + [Overlay.apply]'s diagnostics are never silently dropped (Overlay.mli), + so any that come back -- expected to be none in the committed data; see + the overlay file's own comment on when one WOULD fire -- are printed to + stderr, loudly, without aborting the run. *) +let load_ef_layer () = + let dir = data_dir () in + let sanctoral_path = Filename.concat dir "sanctoral.sexp" in + let adjustments_path = Filename.concat dir "adjustments.sexp" in + match Colitur_kernel.Layer.load Rite_ef.Vocab_ef.rank_of_sexp sanctoral_path with + | Error e -> Error (Printf.sprintf "failed to load %s: %s" sanctoral_path e) + | Ok layer -> ( + match Colitur_kernel.Overlay.load Rite_ef.Vocab_ef.rank_of_sexp adjustments_path with + | Error e -> Error (Printf.sprintf "failed to load %s: %s" adjustments_path e) + | Ok overlay -> + let layer, diagnostics = Colitur_kernel.Overlay.apply layer overlay in + List.iter + (fun d -> Printf.eprintf "colitur: %s\n" (Colitur_kernel.Overlay.diagnostic_to_string d)) + diagnostics; + Ok layer) + +let day_line (d : (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_kernel.Liturgical_day.t) + = + let t = d.Colitur_kernel.Liturgical_day.temporal in + let cel = d.Colitur_kernel.Liturgical_day.observed in + let week = + match t.Colitur_kernel.Temporal.week with Some n -> string_of_int n | None -> "-" + in + let commemoration_suffix (c, _) = + " +" ^ Colitur_kernel.Slug.to_string c.Colitur_kernel.Celebration.slug + in + let commemorations = + String.concat "" (List.map commemoration_suffix d.Colitur_kernel.Liturgical_day.commemorations) + in + Printf.printf "%s %s %s %s %s %s %s%s\n" (D.to_iso8601 d.Colitur_kernel.Liturgical_day.date) + (D.weekday_to_string t.Colitur_kernel.Temporal.weekday) + (Rite_ef.Vocab_ef.season_to_string t.Colitur_kernel.Temporal.season) + week + (Colitur_kernel.Slug.to_string cel.Colitur_kernel.Celebration.slug) + (Rite_ef.Vocab_ef.rank_to_string cel.Colitur_kernel.Celebration.rank) + (Colitur_kernel.Colour.to_string cel.Colitur_kernel.Celebration.colour) + commemorations + +(* One civil year, Jan 1 - Dec 31, matching [temporal_report]'s own scan -- + NOT one liturgical year: [Colitur_kernel.Calendar.year] resolves a single + Advent-anchored liturgical year, which straddles two civil years, so a + civil year's worth of output needs the tail of the liturgical year that + opened the PREVIOUS civil year (covers roughly 1 Jan - 28 Nov) plus the + liturgical year that opens within this one (roughly 29 Nov - 31 Dec). + Both are computed once each -- not once per day via [Calendar.day], which + would recompute the whole (~365-day) placement pass up to 365 times over + for the days sharing one liturgical year (calendar.mli's own "pays it + once" cost model assumes exactly this usage: call [year], not [day] in a + loop). *) +let day_report y = + match load_ef_layer () with + | Error msg -> + Printf.eprintf "colitur: %s\n" msg; + exit 2 + | Ok layer -> + let module Cal = Colitur_kernel.Calendar in + let by_rata : (int, (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_kernel.Liturgical_day.t) Hashtbl.t = + Hashtbl.create 400 + in + let index days = + Array.iter + (fun (d : (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_kernel.Liturgical_day.t) -> + Hashtbl.replace by_rata (D.to_rata d.Colitur_kernel.Liturgical_day.date) d) + days + in + index (Cal.year Rite_ef.context layer (y - 1)); + index (Cal.year Rite_ef.context layer y); + let jan1 = match D.make ~year:y ~month:1 ~day:1 with Ok t -> t | Error e -> failwith e in + let dec31 = match D.make ~year:y ~month:12 ~day:31 with Ok t -> t | Error e -> failwith e in + let d = ref jan1 in + while D.compare !d dec31 <= 0 do + (match Hashtbl.find_opt by_rata (D.to_rata !d) with + | Some day -> day_line day + | None -> + (* Unreachable for any [y] in 1583..9999: the two indexed + liturgical years jointly cover [year_start (y-1), year_start + (y+1)), which contains all of civil year [y] + (calendar.mli). Not a [failwith] -- an out-of-domain [d] + inside this loop is impossible by construction (jan1/dec31 + are themselves validated in range, and [add_days] only ever + advances within the same civil year here) -- but a silent + skip would violate the same "never silently dropped" + standard the kernel holds itself to, so a gap surfaces + loudly on stderr rather than as a quietly short year. *) + Printf.eprintf "colitur: internal error: no resolved day for %s\n" (D.to_iso8601 !d)); + d := D.add_days !d 1 + done + let usage () = - prerr_endline "colitur: usage: colitur easter | colitur temporal "; + prerr_endline "colitur: usage: colitur easter | colitur temporal | colitur day "; exit 2 let with_year ys f = @@ -57,4 +191,5 @@ let () = match Sys.argv with | [| _; "easter"; ys |] -> with_year ys easter_report | [| _; "temporal"; ys |] -> with_year ys temporal_report + | [| _; "day"; ys |] -> with_year ys day_report | _ -> usage () diff --git a/data/ef/adjustments.sexp b/data/ef/adjustments.sexp new file mode 100644 index 0000000..85d7fa1 --- /dev/null +++ b/data/ef/adjustments.sexp @@ -0,0 +1,13 @@ +; data/ef/adjustments.sexp -- hand-authored overlay over data/ef/sanctoral.sexp +; (Task 11). NOT generated by tools/bootstrap_sanctoral.ml -- edit directly. +; +; Suppresses `vigil-of-christmas` (24 Dec, data/ef/sanctoral.sexp, lectio's +; own bootstrapped entry): it is the SAME celebration as colitur's temporal +; cycle's own `ef-nativity-vigil` (rite_ef/temporal_ef.ml's [named], also 24 +; Dec, RG 91 entry 5), not a second, distinct one. Once the sanctoral layer +; is live, that date would otherwise carry two candidates for one feast. +; Recorded as an Overlay directive rather than filtered out of the bootstrap +; or special-cased in code, per the task brief -- an auditable, diagnosable +; removal (Overlay.apply's own diagnostic fires if this slug is ever absent, +; e.g. after a re-bootstrap that renames it), not a silent drop. +((id ef-adjustments) (directives ((Suppress vigil-of-christmas)))) diff --git a/lib/kernel/rite.mli b/lib/kernel/rite.mli index 6d12dd4..ffe9471 100644 --- a/lib/kernel/rite.mli +++ b/lib/kernel/rite.mli @@ -38,5 +38,25 @@ type ('s, 'r) t = { Low Sunday (searching onward from there only if that day is itself blocked). [occupant] is supplied rather than a raw layer/temporal pair so the rite never has to re-implement occurrence resolution - just to answer "what sits here". *) + just to answer "what sits here". + + OBLIGATIONS (not enforced by the type, and {!Calendar}'s own + termination argument depends on both): the result must be + {b strictly later} than the [Date.t] argument (the date the + candidate was impeded on) -- {!Calendar}'s placement pass treats + [target = origin] or [target < origin] as a legitimate placement, + not an error, so a rite whose search can stand still or go + backward would silently loop candidates in place or resurrect an + already-superseded occupant rather than failing loudly. The call + must also {b terminate} on its own: {!Calendar}'s round guard + (calendar.ml's [max_transfer_rounds]) bounds how many ROUNDS the + whole-year placement pass takes, which is a distinct, outer thing + from whatever internal search a single call to this function runs + -- an implementation that walks forward day by day looking for an + admissible date, without its own bound, can hang the caller + outright on a rite/data shape it does not handle, never reaching + the round guard at all. See rite_ef/precedence_ef.ml's + [transfer_target] for a concrete termination argument (a + structural step bound, not an appeal to the real calendar's own + structure). *) } diff --git a/lib/rites/rite_ef/precedence_ef.ml b/lib/rites/rite_ef/precedence_ef.ml index ff6f991..e1c13d1 100644 --- a/lib/rites/rite_ef/precedence_ef.ml +++ b/lib/rites/rite_ef/precedence_ef.ml @@ -55,13 +55,22 @@ let is_universal layer = String.equal layer universal_layer {!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"). Exposed so a future task naming a - sanctoral vigil (Task 10: Assumption, John Baptist, Peter & Paul, - Lawrence -- only Ascension exists today) uses the same suffix; a - differently-named vigil would band 16/24 instead of 21/26, silently. *) + [named], e.g. "ef-ascension-vigil"). *) let vigil_suffix = "-vigil" -let is_vigil slug = String.ends_with ~suffix:vigil_suffix slug +(* 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/ @@ -519,3 +528,96 @@ let admit ~(observed : Vocab_ef.rank Precedence.candidate) (* 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, register-transcribed: "(Annunciation + exception): -> Monday after Low Sunday." 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 + +(* 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. If the bound is + reached, the last date visited is returned WITHOUT probing [occupant] + again -- one more finite (not necessarily admissible) date, not a + further search -- because the val 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 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 ordinary branch + starts the search at [Date.add_days origin 1] and [search_from] only ever + advances forward from its own starting point, so the result is always >= + origin + 1. The Annunciation branch starts instead at 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. *) +let transfer_target (c : Vocab_ef.rank Precedence.candidate) (origin : Date.t) + (occupant : Date.t -> Vocab_ef.rank Celebration.t) : Date.t = + let start = + if Slug.to_string c.Precedence.cel.Celebration.slug = annunciation_slug 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. *) + Date.add_days (Computus.gregorian_easter (Date.year origin)) 8 + else Date.add_days origin 1 + in + search_from occupant 0 start diff --git a/lib/rites/rite_ef/precedence_ef.mli b/lib/rites/rite_ef/precedence_ef.mli index e1b3638..d06b058 100644 --- a/lib/rites/rite_ef/precedence_ef.mli +++ b/lib/rites/rite_ef/precedence_ef.mli @@ -19,14 +19,31 @@ val universal_layer : string val indult_prefix : string (** Slug suffix marking a celebration as a vigil (RG 91 entries 21, 26), - e.g. "ef-ascension-vigil". Also colitur's own convention, not an RG - citation, exposed for the same reason as {!universal_layer}: only the - Ascension Vigil exists today (rite_ef/temporal_ef.ml); the Assumption, - John Baptist, Peter & Paul and Lawrence vigils arrive as sanctoral data - in a future task, and must use this same suffix or {!band} will band - them 16/24 (an ordinary feast of the same rank) instead of 21/26. *) + e.g. "ef-ascension-vigil" -- colitur's own temporal-cycle convention + (rite_ef/temporal_ef.ml's [named]). Also colitur's own convention, not + an RG citation, exposed for the same reason as {!universal_layer}. See + {!vigil_prefix} for the sanctoral data's own, different convention: a + vigil can arrive named either way, and {!band}/{!disposition} must + recognise both. *) val vigil_suffix : string +(** Slug prefix marking a celebration as a vigil, e.g. "vigil-of-st-lawrence" + -- the sanctoral data's own convention (data/ef/sanctoral.sexp, adopted + verbatim from lectio's naming, per spec §4.4's "slugs are lectionary keys, + not re-derived"). Also colitur's own convention, not an RG citation -- + see {!universal_layer}. Task 10 bootstrapped four real sanctoral vigils + named this way (St Lawrence 08-09, Sts Peter & Paul 06-28, the Assumption + 08-14, the Nativity of St John the Baptist 06-23; a fifth, Christmas, is + suppressed as a duplicate of the temporal cycle's own "ef-nativity-vigil" + -- see data/ef/adjustments.sexp), none of which end in {!vigil_suffix}: + without this prefix also being checked, {!band} would misfile all four at + 16/24 (an ordinary feast of the same rank) instead of RG 91's 21/26, and + RG 33's vigil omission ({!disposition}'s [is_vigil] test, the same + predicate) would never fire for them either -- two rubrics silently + broken for four celebrations, exactly what Task 7's review predicted + when it asked for {!vigil_suffix} to be exposed. *) +val vigil_prefix : string + (** Slug prefixes marking a celebration as one of RG 91 entry 18's three Ember-day sets (Advent, Lent, September -- the Pentecost/Whitsun set is I class and matched by entry 10 before this is ever consulted). Also @@ -153,3 +170,42 @@ val admit : observed:Vocab_ef.rank Precedence.candidate -> (Vocab_ef.rank Precedence.candidate * Precedence.privilege) list -> (Vocab_ef.rank Precedence.candidate * Precedence.privilege) list + +(** The Annunciation's own bootstrapped slug (data/ef/sanctoral.sexp, Task + 10), reused verbatim by {!transfer_target} to recognise RG 96's named + exception. Not an RG citation -- see {!universal_layer} -- exposed so a + future re-bootstrap that renames the slug has somewhere to be caught + other than a silently-wrong transfer target. *) +val annunciation_slug : string + +(** [transfer_target c origin occupant]: RG 96 (docs/research/rules-register + .md §4, "Transfer/translation") -- where an impeded I-class feast, once + {!disposition} has decided it is [Transfer]-disposed, is placed. This + *is* {!Colitur_kernel.Rite.t}.transfer_target; see that field's own + fuller rationale for why the search has to be rite-supplied at all. + + RG 96's own rule: the next following day whose currently-resolved + occupant is not I or II class (read off [Vocab_ef.rank], RG 8's dignity + -- not {!band}'s finer occurrence-table entry, the same distinction + {!admit} draws for RG 111). RG 96's own named exception: the + Annunciation ({!annunciation_slug}) does not search from [origin + 1] at + all -- it starts at the Monday after Low Sunday for [origin]'s own civil + year, searching onward from there only if that day is itself occupied by + a blocking class. + + Total, terminating, and its result is always strictly later than + [origin] -- {!Colitur_kernel.Rite.t}.transfer_target's own obligations, + which {!Colitur_kernel.Calendar}'s placement pass relies on and its own + round guard does not itself enforce (calendar.ml's [place_transfers] + bounds ROUNDS across a whole year, not one call's internal walk). + Terminating by a structural bound on the internal walk (max 400 days, + an engineering ceiling, not an RG citation -- see the .ml), not by an + argument about the real 1962 calendar's own structure, so a rite/data + shape this function has not anticipated fails FINITELY rather than + hanging the caller. Strictly later than [origin]: the ordinary search + starts at [origin + 1] and only ever advances forward from there; the + Annunciation's own starting point is provably later than 25 March for + every representable year (Easter's documented range, register §0) -- + see the .ml for the full argument. *) +val transfer_target : + Vocab_ef.rank Precedence.candidate -> Date.t -> (Date.t -> Vocab_ef.rank Celebration.t) -> Date.t diff --git a/lib/rites/rite_ef/rite_ef.ml b/lib/rites/rite_ef/rite_ef.ml new file mode 100644 index 0000000..7a29421 --- /dev/null +++ b/lib/rites/rite_ef/rite_ef.ml @@ -0,0 +1,24 @@ +(* This module's name matches the library's own name ("rite_ef"), so dune + treats it as the library's top-level module instead of generating one + automatically -- every sibling module this library defines must be + re-exported here explicitly, or external references to e.g. + [Rite_ef.Temporal_ef] (bin/main.ml, every test/ file that opens this + rite) stop resolving. *) +module Vocab_ef = Vocab_ef +module Temporal_ef = Temporal_ef +module Precedence_ef = Precedence_ef + +open Colitur_kernel + +let context : (Vocab_ef.season, Vocab_ef.rank) Rite.t = + { Rite.id = Temporal_ef.id; + vocab = Vocab_ef.vocab; + year_start = Temporal_ef.year_start; + temporal = Temporal_ef.temporal; + anchors = Temporal_ef.anchors; + rules = + { Precedence.band = Precedence_ef.band; + disposition = Precedence_ef.disposition; + admit = Precedence_ef.admit }; + season_runs = Vocab_ef.seasons; + transfer_target = Precedence_ef.transfer_target } diff --git a/lib/rites/rite_ef/rite_ef.mli b/lib/rites/rite_ef/rite_ef.mli new file mode 100644 index 0000000..e2b3e6d --- /dev/null +++ b/lib/rites/rite_ef/rite_ef.mli @@ -0,0 +1,35 @@ +(** The EF (1962) rite module: this library's top-level module (its filename + matches the library's own name "rite_ef", so dune uses it as the + library's entry point directly rather than generating one -- see the + .ml's own comment). Re-exports every sibling module this library + defines, so [Rite_ef.Vocab_ef], [Rite_ef.Temporal_ef] and + [Rite_ef.Precedence_ef] keep resolving exactly as they did before this + module existed. *) + +module Vocab_ef = Vocab_ef +module Temporal_ef = Temporal_ef +module Precedence_ef = Precedence_ef + +(** The EF rite, bundled (design spec's [RITE] signature, realised as a + {!Colitur_kernel.Rite.t} value rather than a functor -- see rite.mli): + - [id], [vocab], [year_start], [temporal], [anchors]: {!Temporal_ef} + unchanged (RG 71-77 seasons, RG 91's named movable days). + - [rules]: {!Precedence_ef}'s three RG 91/92-95/108-111 functions, + wrapped as one {!Colitur_kernel.Precedence.rules} record. + - [season_runs]: {!Vocab_ef.seasons} itself -- the EF liturgical year + visits each of its eight seasons exactly once, in that same order + (Advent-anchored, matching [year_start]), so the expected + run-length-compressed sequence {!Colitur_kernel.Rite.t.season_runs} + wants IS the vocabulary's own canonical list, not a separate one. + - [transfer_target]: {!Precedence_ef.transfer_target}, RG 96 (see that + value's own documentation for the termination and forward-progress + argument {!Colitur_kernel.Rite.t.transfer_target}'s contract requires). + + Deliberately carries no [sanctoral]/[lectionary] fields the way the + original design-doc sketch of [RITE] does: {!Colitur_kernel.Rite.t} (the + type actually shipped, Plan 2) keeps the sanctoral {!Colitur_kernel.Layer.t} + a separate argument to {!Colitur_kernel.Calendar.year}/[day] rather than + embedding it here, so a caller can load data/ef/sanctoral.sexp (plus + data/ef/adjustments.sexp's overlay) however suits it -- bin/main.ml's + [load_ef_layer] is the one this module ships with. *) +val context : (Vocab_ef.season, Vocab_ef.rank) Colitur_kernel.Rite.t diff --git a/test/cli.t b/test/cli.t index feb7c49..77968e6 100644 --- a/test/cli.t +++ b/test/cli.t @@ -17,7 +17,7 @@ A year outside the supported domain is rejected (exit 2): No/garbage arguments give a usage error (exit 2): $ colitur - colitur: usage: colitur easter | colitur temporal + colitur: usage: colitur easter | colitur temporal | colitur day [2] The EF temporal cycle for a year, one line per day: @@ -41,3 +41,68 @@ A year outside the supported domain is rejected (exit 2): $ colitur temporal 1000 colitur: year 1000 out of range 1583..9999 [2] + +The resolved EF calendar for a year (Task 11) -- temporal AND sanctoral, +occurrence and transfers applied: one line per civil-year day, +"YYYY-MM-DD weekday season week slug rank colour [+commemoration-slug]...". + + $ colitur day 2026 | wc -l + 365 + +Easter is the observed day exactly once, and carries no commemoration (an +impeded I class day admits at most one PRIVILEGED commemoration, RG 111, and +nothing outranks Easter to be impeded by it in the first place): + + $ colitur day 2026 | grep -c '^2026-04-05 ' + 1 + $ colitur day 2026 | grep '^2026-04-05 ' + 2026-04-05 sunday paschaltide 1 ef-easter-sunday class-1 white + +Ash Wednesday: I class (RG 91 entry 7), violet, no numbered week (it falls 4 +days before Lent I's own origin -- rite_ef/temporal_ef.ml's [week]): + + $ colitur day 2026 | grep '^2026-02-18 ' + 2026-02-18 wednesday lent - ef-ash-wednesday class-1 violet + +Christmas: I class, white (RG 91 entry 1): + + $ colitur day 2026 | grep '^2026-12-25 ' + 2026-12-25 friday christmastide - ef-nativity class-1 white + +All Souls (2 Nov, RG 91 entry 8) end to end: 2 Nov 2025 is a Sunday (verified +independently -- 1 Jan 2025 is a Wednesday, day-of-year 306, (3+305) mod 7 = +0 = Sunday), so entry 8 yields to it (still an ordinary II-class Sunday, +"sunday" in season time-after-pentecost, colour green -- the week number +itself is not re-asserted here, already covered by test_temporal_ef.ml); RG +95 then transfers All Souls (I class, not a Sunday, not a vigil) and RG 96 +places it on 3 Nov, the next day that is not I or II class: + + $ colitur day 2025 | grep -c 'commemoration-of-all-souls' + 1 + $ colitur day 2025 | grep '^2025-11-02 ' | sed -E 's/ [0-9]+ ef-time-after-pentecost-sunday-[0-9]+ / ef-time-after-pentecost-sunday- /' + 2025-11-02 sunday time-after-pentecost ef-time-after-pentecost-sunday- class-2 green + $ colitur day 2025 | grep '^2025-11-03 ' + 2025-11-03 monday time-after-pentecost 21 commemoration-of-all-souls class-1 black + +(week 21: Pentecost 2025 is 8 June (colitur easter 2025); 8 Jun - 3 Nov is +148 days, floor_div(148, 7) = 21 -- rite_ef/temporal_ef.ml's own [week] +formula, hand-verified before promoting this line, not merely printed and +trusted.) + +All Souls observed directly on 2 Nov in a year where it does not fall on a +Sunday: 2 Nov 2026 is a Monday (1 Jan 2026 is a Thursday, same day-of-year +306 offset, (4+305) mod 7 = 1 = Monday): + + $ colitur day 2026 | grep -c 'commemoration-of-all-souls' + 1 + $ colitur day 2026 | grep '^2026-11-02 ' + 2026-11-02 monday time-after-pentecost 23 commemoration-of-all-souls class-1 black + +(week 23: Pentecost 2026 is 24 May (colitur easter 2026); 24 May - 2 Nov is +162 days, floor_div(162, 7) = 23 -- same formula, same independent check.) + +A year outside the supported domain is rejected (exit 2): + + $ colitur day 1000 + colitur: year 1000 out of range 1583..9999 + [2] diff --git a/test/dune b/test/dune index bb8e474..be24839 100644 --- a/test/dune +++ b/test/dune @@ -6,4 +6,4 @@ (pps ppx_sexp_conv))) (cram - (deps %{bin:colitur})) + (deps %{bin:colitur} ../data/ef/sanctoral.sexp ../data/ef/adjustments.sexp)) diff --git a/test/test_precedence_ef.ml b/test/test_precedence_ef.ml index a95b321..084d708 100644 --- a/test/test_precedence_ef.ml +++ b/test/test_precedence_ef.ml @@ -222,6 +222,22 @@ let cases = ( "26 III-class vigil (non-base layer)", mk 2026 8 10, cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:"diocese-warsaw" "ef-local-patron-vigil", 26 ); + (* Task 11, issue (a): the sanctoral bootstrap (data/ef/sanctoral.sexp) + names its vigils with lectio's OWN "vigil-of-X" PREFIX convention, not + [PE.vigil_suffix]'s "-vigil" SUFFIX every row above uses -- exactly + the mismatch Task 7's review predicted. These two rows use the real + bootstrapped slugs verbatim (data/ef/sanctoral.sexp: 28 Jun, 9 Aug), + proving [band] recognises the prefix convention too: without it, both + would misfile at 16/24 (an ordinary feast of the same rank) instead + of 21/26. *) + ( "21 II-class vigil via the sanctoral data's own \"vigil-of-X\" prefix", + mk 2026 6 28, + cand ~origin:P.Sanctoral ~rank:V.Class2 ~layer:PE.universal_layer "vigil-of-sts-peter-paul", + 21 ); + ( "26 III-class vigil via the sanctoral data's own \"vigil-of-X\" prefix", + mk 2026 8 9, + cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "vigil-of-st-lawrence", + 26 ); (* Entry 27 -- register line 352: an otherwise-unoccupied IV-class Saturday. *) ( "27 Office of the BVM on Saturday", off 62, @@ -370,6 +386,21 @@ let disposition_cases = an_ordinary_sunday, cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "ef-lawrence-vigil", "Commemorate(Ordinary)" ); + (* Task 11, issue (a): [disposition]'s own [is_vigil] check (the RG 33 + omission test) is a SEPARATE call site from [band]'s -- both read the + same private [is_vigil], but each needed its own witness, since a fix + to one call site could in principle miss the other. Real bootstrapped + slug (data/ef/sanctoral.sexp's "vigil-of-the-assumption", 14 Aug), + not a hand-typed one, for the same coupling-safety reason [of_temporal] + rows use real data elsewhere in this file. Before the fix this vigil + was invisible to [is_vigil] entirely, so it would have fallen through + to the ordinary Commemorate branch below instead of Omit -- the exact + failure the task brief describes. *) + ( "RG33 (prefix convention): a \"vigil-of-X\"-named II-class vigil loses \ + to an ordinary Sunday -> Omit", + an_ordinary_sunday, + cand ~origin:P.Sanctoral ~rank:V.Class2 ~layer:PE.universal_layer "vigil-of-the-assumption", + "Omit" ); (* Brief: a Commemoration_only loser is ALWAYS Commemorate -- checked 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 @@ -778,6 +809,94 @@ let test_all_souls_transfers_end_to_end () = Alcotest.(check int) "nothing commemorated" 0 (List.length resolution.P.commemorations); Alcotest.(check int) "nothing omitted" 0 (List.length resolution.P.omitted) +(* Task 11: [PE.transfer_target] -- RG 96 ("the next following day that is + not I or II class") plus its Annunciation exception. [occupant] is a + synthetic callback ({!Colitur_kernel.Rite.t.transfer_target}'s own + [occupant] parameter), not a real [Calendar]-driven one -- the CLI's own + end-to-end proof (colitur day, All Souls landing on 3 Nov 2025 and the + Annunciation landing on 5 Apr 2027, see test/cli.t and the task report) + is what wires this against real data; these rows isolate the search + function itself. *) + +(* [blocked] returns Class1 (blocking) for exactly the listed dates, Class4 + (not blocking) everywhere else -- enough to exercise [is_blocking]'s own + two-way test (RG 96 speaks of I OR II class; Class1 alone is enough to + prove the blocking side, [test_transfer_target_terminates...] below adds + nothing by varying it further). *) +let occupant_blocking_on blocked_dates (d : D.t) : V.rank Cel.t = + let blocking = List.exists (fun bd -> D.compare bd d = 0) blocked_dates in + Cel.make ~slug:(S.of_string_exn "occupant") ~rank:(if blocking then V.Class1 else V.Class4) + ~colour:Col.Green ~layer:"synthetic" () + +let occupant_always_blocking (_ : D.t) : V.rank Cel.t = + Cel.make ~slug:(S.of_string_exn "occupant") ~rank:V.Class1 ~colour:Col.Green ~layer:"synthetic" () + +(* General RG 96 search: two consecutive blocked days past [origin], proving + the search walks past MORE than one ineligible day rather than only + trying [origin + 1] and stopping (the same shape Calendar's own + synthetic fixture pins for the abstraction -- this pins it for the real + EF search function). *) +let test_transfer_target_general_multi_step_search () = + let origin = mk 2026 1 10 in + let occupant = occupant_blocking_on [ mk 2026 1 11; mk 2026 1 12 ] in + let c = cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-some-i-class-feast" in + let target = PE.transfer_target c origin occupant in + Alcotest.(check string) "lands on the first day past the blocked run" + "2026-01-13" (D.to_iso8601 target) + +(* RG 96's Annunciation exception: starts the search at the Monday after Low + Sunday, NOT [origin + 1] -- occupant is unconditionally free, so a + general-path implementation would return [origin + 1] (26 March), a date + this test explicitly rules out as well as pinning the real expected one, + so the assertion genuinely discriminates the two starting points rather + than merely checking "some date after origin". *) +let test_transfer_target_annunciation_starts_at_monday_after_low_sunday () = + let origin = mk 2026 3 25 in + let occupant = occupant_blocking_on [] in + let c = cand ~origin:P.Sanctoral ~layer:PE.universal_layer PE.annunciation_slug in + let target = PE.transfer_target c origin occupant in + let monday_after_low_sunday = D.add_days (Comp.gregorian_easter 2026) 8 in + Alcotest.(check string) "lands on the Monday after Low Sunday (Easter + 8)" + (D.to_iso8601 monday_after_low_sunday) (D.to_iso8601 target); + Alcotest.(check bool) "NOT the general path's origin + 1 (discriminates the branch)" true + (D.compare target (D.add_days origin 1) <> 0) + +(* RG 96's own qualifier on the exception -- "searching onward from there + only if that day is itself blocked" (rite.mli) -- is [search_from]'s + ORDINARY behaviour, not a second mechanism: block the Monday after Low + Sunday itself and confirm the search continues exactly one more day. *) +let test_transfer_target_annunciation_searches_onward_if_blocked () = + let origin = mk 2026 3 25 in + let monday_after_low_sunday = D.add_days (Comp.gregorian_easter 2026) 8 in + let occupant = occupant_blocking_on [ monday_after_low_sunday ] in + let c = cand ~origin:P.Sanctoral ~layer:PE.universal_layer PE.annunciation_slug in + let target = PE.transfer_target c origin occupant in + Alcotest.(check string) "searches onward one more day when that Monday is itself blocked" + (D.to_iso8601 (D.add_days monday_after_low_sunday 1)) (D.to_iso8601 target) + +(* rite.mli's own obligations on [transfer_target] (Task 11 brief): the call + must TERMINATE and its result must be STRICTLY AFTER [origin], even for a + rite/data shape this function cannot have anticipated -- an occupant that + reports every single day as blocking, forever. Calendar's own round guard + (max_transfer_rounds) does not cover this: it bounds ROUNDS across a + whole year, not the internal walk one call to this function makes (see + precedence_ef.ml's own comment on [search_from] and [max_search_days]). + Deliberately NOT pinning the exact returned date against the private + [max_search_days] constant -- that would coalesce a behavioural contract + (terminates, makes forward progress) with an internal tuning value this + function is free to change; a generous, test-owned ceiling (1000 days, + comfortably past any realistic bound) is enough to prove termination is + genuine and not merely "didn't hang during this particular run". *) +let test_transfer_target_terminates_under_pathological_occupant () = + let origin = mk 2026 1 1 in + let c = cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-pathological-case" in + let target = PE.transfer_target c origin occupant_always_blocking in + Alcotest.(check bool) "strictly after origin" true (D.compare target origin > 0); + Alcotest.(check bool) + "terminates within a generous bound (proves the internal search is bounded, not merely lucky)" + true + (D.compare target (D.add_days origin 1000) <= 0) + let suite = ( "Precedence_ef", List.map @@ -819,4 +938,13 @@ let suite = test_privileged_lent_feria_admitted_end_to_end; Alcotest.test_case "II-class Sunday override: RG109(b) witness admitted over an ordinary saint, end-to-end" - `Quick test_ii_class_sunday_privileged_witness_admitted_end_to_end ] ) + `Quick test_ii_class_sunday_privileged_witness_admitted_end_to_end; + Alcotest.test_case "transfer_target: general RG96 search walks past more than one blocked day" + `Quick test_transfer_target_general_multi_step_search; + Alcotest.test_case "transfer_target: Annunciation exception starts at Monday after Low Sunday" + `Quick test_transfer_target_annunciation_starts_at_monday_after_low_sunday; + Alcotest.test_case + "transfer_target: Annunciation exception searches onward if that Monday is blocked" `Quick + test_transfer_target_annunciation_searches_onward_if_blocked; + Alcotest.test_case "transfer_target: terminates and stays forward under a pathological occupant" + `Quick test_transfer_target_terminates_under_pathological_occupant ] ) -- cgit v1.3 From 94fc488cc9c6b4a050d90c4250f6e166b40088e7 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 12 Aug 2026 01:16:22 +0200 Subject: rite(ef): clamp the RG96 search at the domain ceiling search_from could walk up to 400 days past origin before Calendar's own ~start ~stop clamp is ever consulted, and nothing stopped it probing occupant on a date past 31 December 9999 -- occupant chains through the real EF rite's temporal, which calls Computus.gregorian_easter, not total outside 1583..9999 (it Date.makes and failwiths on Error). Not reachable with the shipped sanctoral data alone, but reachable through the project's own primary extension path: an overlay adding an I-class feast on 25 December leaves nothing but Class2 Nativity-octave days for the rest of civil year 9999, so the unguarded search reached 1 January of year 10000 and crashed there with 'computus: year 10000 out of range 1583..9999'. 9999 is an in-range year and the kernel's contract is 'never raises on in-range input'. search_from now also stops, without probing occupant again, once it passes Date's own domain ceiling -- the same 'return a finite date, let Calendar's own out-of-range handling record it, never pretend to have found something admissible' contract the existing step-count guard already follows. Two new tests, both mutation-verified to actually reproduce the crash when the guard is removed (see the task report): a precedence_ef.ml unit test using the real Temporal_ef.temporal as occupant (a synthetic occupant can never discriminate this, since it never calls Computus itself), and a Calendar-level integration test reproducing the exact overlay-based scenario the review found. --- lib/rites/rite_ef/precedence_ef.ml | 35 +++++++++++++--- lib/rites/rite_ef/precedence_ef.mli | 11 +++-- test/dune | 2 +- test/test_colitur.ml | 2 +- test/test_precedence_ef.ml | 32 ++++++++++++++- test/test_rite_ef.ml | 81 +++++++++++++++++++++++++++++++++++++ 6 files changed, 150 insertions(+), 13 deletions(-) create mode 100644 test/test_rite_ef.ml (limited to 'lib') diff --git a/lib/rites/rite_ef/precedence_ef.ml b/lib/rites/rite_ef/precedence_ef.ml index e1c13d1..b9b1731 100644 --- a/lib/rites/rite_ef/precedence_ef.ml +++ b/lib/rites/rite_ef/precedence_ef.ml @@ -573,6 +573,27 @@ let annunciation_slug = "annunciation-of-the-blessed-virgin-mary" 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 @@ -581,17 +602,19 @@ let max_search_days = 400 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. If the bound is - reached, the last date visited is returned WITHOUT probing [occupant] - again -- one more finite (not necessarily admissible) date, not a - further search -- because the val the caller ([transfer_target]) is - still owed is "a date", never an exception; {!Calendar}'s own + 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 then d + 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 diff --git a/lib/rites/rite_ef/precedence_ef.mli b/lib/rites/rite_ef/precedence_ef.mli index d06b058..7318ccd 100644 --- a/lib/rites/rite_ef/precedence_ef.mli +++ b/lib/rites/rite_ef/precedence_ef.mli @@ -199,10 +199,13 @@ val annunciation_slug : string round guard does not itself enforce (calendar.ml's [place_transfers] bounds ROUNDS across a whole year, not one call's internal walk). Terminating by a structural bound on the internal walk (max 400 days, - an engineering ceiling, not an RG citation -- see the .ml), not by an - argument about the real 1962 calendar's own structure, so a rite/data - shape this function has not anticipated fails FINITELY rather than - hanging the caller. Strictly later than [origin]: the ordinary search + an engineering ceiling, not an RG citation -- see the .ml) AND a guard + at {!Colitur_kernel.Date}'s own domain ceiling (31 December 9999, + beyond which probing [occupant] can itself raise -- see the .ml's + [domain_max_date]), not by an argument about the real 1962 calendar's + own structure, so a rite/data shape this function has not anticipated + fails FINITELY rather than hanging or crashing the caller. Strictly + later than [origin]: the ordinary search starts at [origin + 1] and only ever advances forward from there; the Annunciation's own starting point is provably later than 25 March for every representable year (Easter's documented range, register §0) -- diff --git a/test/dune b/test/dune index be24839..dc81213 100644 --- a/test/dune +++ b/test/dune @@ -1,7 +1,7 @@ (test (name test_colitur) (libraries colitur_kernel rite_ef alcotest qcheck qcheck-alcotest sexplib) - (deps ../data/ef/sanctoral.sexp) + (deps ../data/ef/sanctoral.sexp ../data/ef/adjustments.sexp) (preprocess (pps ppx_sexp_conv))) diff --git a/test/test_colitur.ml b/test/test_colitur.ml index ba82fcd..9f74e34 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -3,4 +3,4 @@ let () = Alcotest.run "colitur" [ Test_date.suite; Test_computus.suite; Test_colour.suite; Test_slug.suite; Test_names.suite; Test_overlay.suite; Test_temporal_ef.suite; Test_validate.suite; Test_precedence.suite; - Test_calendar.suite; Test_precedence_ef.suite; Test_sanctoral_ef.suite ] + Test_calendar.suite; Test_precedence_ef.suite; Test_sanctoral_ef.suite; Test_rite_ef.suite ] diff --git a/test/test_precedence_ef.ml b/test/test_precedence_ef.ml index 084d708..0973a93 100644 --- a/test/test_precedence_ef.ml +++ b/test/test_precedence_ef.ml @@ -897,6 +897,34 @@ let test_transfer_target_terminates_under_pathological_occupant () = true (D.compare target (D.add_days origin 1000) <= 0) +(* Coordinator review: [search_from] must not probe [occupant] past + {!Date}'s own domain ceiling (31 December 9999). A SYNTHETIC occupant + (like [occupant_always_blocking] above) can never actually discriminate + this: it never calls [Computus.gregorian_easter] itself, so it cannot + raise regardless of whether the domain guard exists -- a test built on + one would only prove [search_from]'s unrelated step bound, not this fix. + [occupant] here is instead the REAL [Temporal_ef.temporal] (no sanctoral + layer needed: 29-31 Dec are ALREADY II class via [named]'s own Nativity- + octave-day entries, so three real, unbroken blocking days already sit at + the very end of the domain) -- exactly the shape that raises without the + fix: 1 January of civil year 10000 is next, and [Computus.gregorian_easter + 10000] does [Date.make ~year:10000 ...] and [failwith]s (the .ml's own + [domain_max_date] comment; also how the reviewer reproduced the bug + through the project's own overlay mechanism -- see the task report for + that end-to-end reproduction). Mutation-verified: reverting the domain + guard makes this test error with exactly that uncaught [Failure], not + merely fail an assertion (see the task report). *) +let test_transfer_target_does_not_raise_at_domain_ceiling () = + let origin = mk 9999 12 28 in + let occupant d = (T.temporal d).Colitur_kernel.Temporal.office in + let c = cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-domain-ceiling-case" in + let target = PE.transfer_target c origin occupant in + Alcotest.(check bool) "past 31 December 9999 (the guard engaged; nothing admissible remained \ + in-domain, so the search gave up at the ceiling rather than crashing)" + true + (D.compare target (mk 9999 12 31) > 0) + + let suite = ( "Precedence_ef", List.map @@ -947,4 +975,6 @@ let suite = "transfer_target: Annunciation exception searches onward if that Monday is blocked" `Quick test_transfer_target_annunciation_searches_onward_if_blocked; Alcotest.test_case "transfer_target: terminates and stays forward under a pathological occupant" - `Quick test_transfer_target_terminates_under_pathological_occupant ] ) + `Quick test_transfer_target_terminates_under_pathological_occupant; + Alcotest.test_case "transfer_target: does not raise probing past the domain ceiling" `Quick + test_transfer_target_does_not_raise_at_domain_ceiling ] ) diff --git a/test/test_rite_ef.ml b/test/test_rite_ef.ml new file mode 100644 index 0000000..7b60718 --- /dev/null +++ b/test/test_rite_ef.ml @@ -0,0 +1,81 @@ +(* Coordinator review (Task 11 fix round): integration tests wiring + [Rite_ef.context] together with the REAL data/ef/sanctoral.sexp + + data/ef/adjustments.sexp through [Colitur_kernel.Calendar] -- the same + pipeline `colitur day` uses, proven here at the OCaml level. *) + +module Cal = Colitur_kernel.Calendar +module Layer = Colitur_kernel.Layer +module Overlay = Colitur_kernel.Overlay +module LD = Colitur_kernel.Liturgical_day +module Slug = Colitur_kernel.Slug +module Date = Colitur_kernel.Date +module Date_spec = Colitur_kernel.Date_spec +module Cel = Colitur_kernel.Celebration +module Colour = Colitur_kernel.Colour +module V = Rite_ef.Vocab_ef + +(* Relative to this test's own build directory (_build/default/test/), same + convention test_sanctoral_ef.ml uses -- test/dune declares both as deps + of the (test ...) stanza. *) +let sanctoral_path = "../data/ef/sanctoral.sexp" +let adjustments_path = "../data/ef/adjustments.sexp" + +let real_layer () = + let layer = + match Layer.load V.rank_of_sexp sanctoral_path with + | Ok l -> l + | Error e -> Alcotest.failf "%s: failed to load: %s" sanctoral_path e + in + let overlay = + match Overlay.load V.rank_of_sexp adjustments_path with + | Ok o -> o + | Error e -> Alcotest.failf "%s: failed to load: %s" adjustments_path e + in + let layer, diagnostics = Overlay.apply layer overlay in + Alcotest.(check (list string)) "the committed overlay applies cleanly, no diagnostics" [] + (List.map Overlay.diagnostic_to_string diagnostics); + layer + +let slug_of (c : V.rank Cel.t) = Slug.to_string c.Cel.slug + +(* Coordinator review, finding 2, reproduced through the project's OWN + extension path (an overlay), the same way the reviewer found it: adding + an I-class feast on 25 December (competing against, and losing to, the + real Nativity) forces an RG 96 search starting 26 December -- which, with + the real sanctoral data (Stephen/John/the Innocents, all II class) plus + the temporal cycle's own Nativity-octave-day entries (29-31 Dec, also II + class), is blocking every single day through 31 December 9999. Before the + domain-ceiling fix this raised (Computus: year 10000 out of range); + confirmed by mutation-testing at the precedence_ef.ml unit level (see the + task report) -- this is the same defect reproduced end to end, through + Calendar, with real data, exactly as the review found it. *) +let test_transfer_search_does_not_raise_at_domain_ceiling () = + let layer = real_layer () in + let impeding_entry : V.rank Layer.entry = + { Layer.date = (match Date_spec.fixed ~month:12 ~day:25 with Ok d -> d | Error e -> failwith e); + cel = + Cel.make ~slug:(Slug.of_string_exn "test-domain-ceiling-impeder") ~rank:V.Class1 + ~colour:Colour.White ~layer:Rite_ef.Precedence_ef.universal_layer () } + in + let overlay : V.rank Overlay.t = + { Overlay.id = "test-domain-ceiling"; directives = [ Overlay.Add impeding_entry ] } + in + let layer, _diagnostics = Overlay.apply layer overlay in + (* Must not raise -- the whole point of the fix. *) + let days = Cal.year Rite_ef.context layer 9999 in + Alcotest.(check bool) "year 9999 resolves without raising, even with an impeded Christmas Day" + true (Array.length days > 0); + let impeder_placed_or_recorded = + Array.to_list days + |> List.exists (fun d -> + slug_of d.LD.observed = "test-domain-ceiling-impeder" + || List.exists (fun (c, _) -> slug_of c = "test-domain-ceiling-impeder") d.LD.omitted) + in + Alcotest.(check bool) "the impeding candidate is accounted for (observed somewhere, or omitted \ + with a recorded reason) -- never silently dropped" + true impeder_placed_or_recorded + +let suite = + ( "Rite_ef (real data: overlay-in-effect, domain-ceiling)", + [ Alcotest.test_case "RG96 search does not raise at the domain ceiling (real data)" `Quick + test_transfer_search_does_not_raise_at_domain_ceiling ] ) -- cgit v1.3 From 9ce4527550fed24036f6f116474c1f67714f5194 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 12 Aug 2026 01:19:37 +0200 Subject: rite(ef): the Annunciation's RG96 exception is conditional, not unconditional The register was transcribed faithfully but was itself wrong: RG 96's Attamen (a), primary-source-verified from the scans and now corrected in the register, reads 'festum Annuntiationis B. Mariae Virg., quando est transferendum post Pascha, transfertur ... in feriam II post dominicam in albis' -- the Monday-after-Low-Sunday seat applies ONLY 'quando est transferendum post Pascha', when the feast is to be transferred PAST EASTER. The unconditional transcription made the exception fire on every impeded Annunciation regardless of cause. transfer_target now computes the general RG 96 target first, for every candidate, and overrides to the Monday after Low Sunday only when that general target itself falls after Easter Sunday -- testing the rubric's own condition directly rather than re-deriving a date-proximity rule from first principles. Confirmed against three real years the review named: 2007, 2012 and 2057 all previously sent the Annunciation to Easter + 8 (16 April, 16 April, 30 April respectively) when the correct, now-produced target is the next free day before Easter (26 March in each case -- Passion Sunday in 2007/2012, Lent III Sunday in 2057). Verified with actual CLI output for all three, before and after. Also cites RG 96 Attamen (b), the same primary-source passage, as the direct authority for All Souls' own move to the following Monday when impeded by a Sunday -- previously inferred from RG 91 entry 8's parenthetical plus the general walk, which happened to produce the right date; now stated directly. Rewrote the two existing Annunciation unit tests, whose synthetic occupants no longer trigger the (now correctly conditional) exception, and added a 2057 regression test using the real Temporal_ef.temporal as occupant plus a real-data cram pin -- both mutation-verified against the unconditional reading. --- lib/rites/rite_ef/precedence_ef.ml | 88 ++++++++++++++++++++++++------------- lib/rites/rite_ef/precedence_ef.mli | 32 +++++++++----- test/cli.t | 13 ++++++ test/test_precedence_ef.ml | 74 ++++++++++++++++++++++++------- 4 files changed, 152 insertions(+), 55 deletions(-) (limited to 'lib') diff --git a/lib/rites/rite_ef/precedence_ef.ml b/lib/rites/rite_ef/precedence_ef.ml index b9b1731..0feb3e0 100644 --- a/lib/rites/rite_ef/precedence_ef.ml +++ b/lib/rites/rite_ef/precedence_ef.ml @@ -405,9 +405,16 @@ let disposition ~(winner : Vocab_ef.rank Precedence.candidate) 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 per the register, but WHERE it lands - is Rite.transfer_target's job (RG 96), not this function's; - disposition only says THAT it moves. *) + 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" -- @@ -545,14 +552,23 @@ let admit ~(observed : Vocab_ef.rank Precedence.candidate) 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, register-transcribed: "(Annunciation - exception): -> Monday after Low Sunday." 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. *) +(* 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 @@ -620,27 +636,39 @@ let rec search_from (occupant : Date.t -> Vocab_ef.rank Celebration.t) (steps : (* [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 ordinary branch - starts the search at [Date.add_days origin 1] and [search_from] only ever - advances forward from its own starting point, so the result is always >= - origin + 1. The Annunciation branch starts instead at 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 + 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. *) + 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 start = - if Slug.to_string c.Precedence.cel.Celebration.slug = annunciation_slug 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. *) - Date.add_days (Computus.gregorian_easter (Date.year origin)) 8 - else Date.add_days origin 1 - in - search_from occupant 0 start + 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 diff --git a/lib/rites/rite_ef/precedence_ef.mli b/lib/rites/rite_ef/precedence_ef.mli index 7318ccd..8234bf3 100644 --- a/lib/rites/rite_ef/precedence_ef.mli +++ b/lib/rites/rite_ef/precedence_ef.mli @@ -187,11 +187,23 @@ val annunciation_slug : string RG 96's own rule: the next following day whose currently-resolved occupant is not I or II class (read off [Vocab_ef.rank], RG 8's dignity -- not {!band}'s finer occurrence-table entry, the same distinction - {!admit} draws for RG 111). RG 96's own named exception: the - Annunciation ({!annunciation_slug}) does not search from [origin + 1] at - all -- it starts at the Monday after Low Sunday for [origin]'s own civil - year, searching onward from there only if that day is itself occupied by - a blocking class. + {!admit} draws for RG 111). This general target is computed for EVERY + candidate, always, first. + + RG 96's own named exception (Attamen (a), primary-source-verified -- + see {!annunciation_slug}'s comment for the Latin and the register's own + correction note): for the Annunciation specifically, IF that general + target would fall after Easter Sunday itself ("quando est transferendum + post Pascha" -- when it is to be transferred past Easter), the + Annunciation is placed instead at the Monday after Low Sunday (its + [sedes propria]), searching onward from there only if that day is + itself occupied by a blocking class. The exception is CONDITIONAL, not + unconditional: an Annunciation impeded for a reason that resolves + BEFORE Easter (e.g. an ordinary Lent Sunday with a free feria the next + day) takes the general target like any other I-class feast. Operationally + the condition holds exactly when 25 March falls close enough to Easter + that the general walk crosses it -- concretely, when 25 March itself + falls within Holy Week or Easter Week. Total, terminating, and its result is always strictly later than [origin] -- {!Colitur_kernel.Rite.t}.transfer_target's own obligations, @@ -205,10 +217,10 @@ val annunciation_slug : string [domain_max_date]), not by an argument about the real 1962 calendar's own structure, so a rite/data shape this function has not anticipated fails FINITELY rather than hanging or crashing the caller. Strictly - later than [origin]: the ordinary search - starts at [origin + 1] and only ever advances forward from there; the - Annunciation's own starting point is provably later than 25 March for - every representable year (Easter's documented range, register §0) -- - see the .ml for the full argument. *) + later than [origin]: the general search starts at [origin + 1] and only + ever advances forward from there; the Annunciation's own alternate + starting point is provably later than 25 March for every representable + year (Easter's documented range, register §0) -- see the .ml for the + full argument. *) val transfer_target : Vocab_ef.rank Precedence.candidate -> Date.t -> (Date.t -> Vocab_ef.rank Celebration.t) -> Date.t diff --git a/test/cli.t b/test/cli.t index 77968e6..5a646a4 100644 --- a/test/cli.t +++ b/test/cli.t @@ -101,6 +101,19 @@ Sunday: 2 Nov 2026 is a Monday (1 Jan 2026 is a Thursday, same day-of-year (week 23: Pentecost 2026 is 24 May (colitur easter 2026); 24 May - 2 Nov is 162 days, floor_div(162, 7) = 23 -- same formula, same independent check.) +RG 96's Annunciation exception (25 March) is CONDITIONAL, not unconditional +-- fix round 1, coordinator review, register corrected 2026-08-12. In 2057, +25 March is Lent III Sunday (I class, impedes it); 26 March is an ordinary +Lent feria (III class, well before Easter, 22 April 2057), so the GENERAL +RG 96 target -- not the Monday after Low Sunday -- is what governs, since +the general walk never crosses Easter. Before this fix the unconditional +reading sent it to 30 April (Easter + 8) instead: + + $ colitur day 2057 | grep '^2057-03-26 ' + 2057-03-26 monday lent 3 annunciation-of-the-blessed-virgin-mary class-1 white +ef-lent-3-monday + $ colitur day 2057 | grep -c 'annunciation-of-the-blessed-virgin-mary' + 1 + A year outside the supported domain is rejected (exit 2): $ colitur day 1000 diff --git a/test/test_precedence_ef.ml b/test/test_precedence_ef.ml index 0973a93..aa98686 100644 --- a/test/test_precedence_ef.ml +++ b/test/test_precedence_ef.ml @@ -844,36 +844,76 @@ let test_transfer_target_general_multi_step_search () = Alcotest.(check string) "lands on the first day past the blocked run" "2026-01-13" (D.to_iso8601 target) -(* RG 96's Annunciation exception: starts the search at the Monday after Low - Sunday, NOT [origin + 1] -- occupant is unconditionally free, so a - general-path implementation would return [origin + 1] (26 March), a date - this test explicitly rules out as well as pinning the real expected one, - so the assertion genuinely discriminates the two starting points rather - than merely checking "some date after origin". *) +(* Coordinator review (fix round 1): RG 96 Attamen (a) (register-transcribed, + primary-source-verified) makes the Annunciation exception CONDITIONAL on + the general RG 96 walk carrying the feast past Easter Sunday -- NOT + unconditional as the first transcription had it. The occupant here blocks + every day from [origin + 1] through the day after Easter (26 March - 6 + April 2026 inclusive), so the GENERAL target itself would land at 7 + April -- after Easter (5 April) -- which is exactly the trigger + condition, not merely "the Annunciation is impeded at all". *) let test_transfer_target_annunciation_starts_at_monday_after_low_sunday () = let origin = mk 2026 3 25 in - let occupant = occupant_blocking_on [] in + let easter_2026 = Comp.gregorian_easter 2026 in + let blocked_through_day_after_easter = + let rec range a b = if D.compare a b > 0 then [] else a :: range (D.add_days a 1) b in + range (D.add_days origin 1) (D.add_days easter_2026 1) + in + let occupant = occupant_blocking_on blocked_through_day_after_easter in let c = cand ~origin:P.Sanctoral ~layer:PE.universal_layer PE.annunciation_slug in let target = PE.transfer_target c origin occupant in - let monday_after_low_sunday = D.add_days (Comp.gregorian_easter 2026) 8 in - Alcotest.(check string) "lands on the Monday after Low Sunday (Easter + 8)" + let monday_after_low_sunday = D.add_days easter_2026 8 in + Alcotest.(check string) "lands on the Monday after Low Sunday (Easter + 8), the general \ + walk having crossed Easter itself" (D.to_iso8601 monday_after_low_sunday) (D.to_iso8601 target); - Alcotest.(check bool) "NOT the general path's origin + 1 (discriminates the branch)" true - (D.compare target (D.add_days origin 1) <> 0) + Alcotest.(check bool) "NOT the general target (2 days after Easter, discriminates the branch)" + true + (D.compare target (D.add_days easter_2026 2) <> 0) (* RG 96's own qualifier on the exception -- "searching onward from there only if that day is itself blocked" (rite.mli) -- is [search_from]'s - ORDINARY behaviour, not a second mechanism: block the Monday after Low - Sunday itself and confirm the search continues exactly one more day. *) + ORDINARY behaviour, not a second mechanism: same blocked run as above + (forcing the general target past Easter, so the exception fires), PLUS + the Monday after Low Sunday itself blocked, confirming the search + continues exactly one more day from there. *) let test_transfer_target_annunciation_searches_onward_if_blocked () = let origin = mk 2026 3 25 in - let monday_after_low_sunday = D.add_days (Comp.gregorian_easter 2026) 8 in - let occupant = occupant_blocking_on [ monday_after_low_sunday ] in + let easter_2026 = Comp.gregorian_easter 2026 in + let monday_after_low_sunday = D.add_days easter_2026 8 in + let blocked = + let rec range a b = if D.compare a b > 0 then [] else a :: range (D.add_days a 1) b in + range (D.add_days origin 1) (D.add_days easter_2026 1) @ [ monday_after_low_sunday ] + in + let occupant = occupant_blocking_on blocked in let c = cand ~origin:P.Sanctoral ~layer:PE.universal_layer PE.annunciation_slug in let target = PE.transfer_target c origin occupant in Alcotest.(check string) "searches onward one more day when that Monday is itself blocked" (D.to_iso8601 (D.add_days monday_after_low_sunday 1)) (D.to_iso8601 target) +(* THE REGRESSION PIN (coordinator review): the bug an unconditional + exception produced. 25 March 2057 is Lent III Sunday (I class, RG 91 + entry 6), impeding the Annunciation; 26 March 2057 is an ordinary Lent + feria (III class, well before Easter, 22 April 2057) -- the general RG + 96 target. The general target does NOT fall after Easter, so the + exception must NOT fire: the Annunciation lands on 26 March, not 13 + April (Easter + 8), which is what the unconditional reading produced + (verified by reverting the fix and re-running this exact test -- see the + task report's mutation record). Uses the REAL [Temporal_ef.temporal] as + [occupant] (not a synthetic stand-in), the same coupling-safety + convention [of_temporal]'s callers use elsewhere in this file, so this + is also effectively an end-to-end check of the real 2057 calendar + shape, not just the search's own logic in isolation. *) +let test_transfer_target_annunciation_not_overridden_when_general_target_precedes_easter () = + let origin = mk 2057 3 25 in + Alcotest.(check string) "25 March 2057 is a Sunday (Lent III)" "sunday" + (D.weekday_to_string (D.weekday origin)); + let occupant d = (T.temporal d).Colitur_kernel.Temporal.office in + let c = cand ~origin:P.Sanctoral ~layer:PE.universal_layer PE.annunciation_slug in + let target = PE.transfer_target c origin occupant in + Alcotest.(check string) "lands on 26 March 2057 (the general RG96 target), NOT the \ + Annunciation exception's Monday after Low Sunday" + "2057-03-26" (D.to_iso8601 target) + (* rite.mli's own obligations on [transfer_target] (Task 11 brief): the call must TERMINATE and its result must be STRICTLY AFTER [origin], even for a rite/data shape this function cannot have anticipated -- an occupant that @@ -974,6 +1014,10 @@ let suite = Alcotest.test_case "transfer_target: Annunciation exception searches onward if that Monday is blocked" `Quick test_transfer_target_annunciation_searches_onward_if_blocked; + Alcotest.test_case + "transfer_target: Annunciation NOT overridden when the general target precedes Easter \ + (2057 regression)" + `Quick test_transfer_target_annunciation_not_overridden_when_general_target_precedes_easter; Alcotest.test_case "transfer_target: terminates and stays forward under a pathological occupant" `Quick test_transfer_target_terminates_under_pathological_occupant; Alcotest.test_case "transfer_target: does not raise probing past the domain ceiling" `Quick -- cgit v1.3 From 633306c8a5ac1854f30749f498498104ebc84edc Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 12 Aug 2026 02:12:03 +0200 Subject: kernel(validate): resolution invariants Widen Validate.run to take the rite's sanctoral layer alongside the rite itself (Calendar.year needs both), and add five checks over the fully resolved liturgical year, on top of the existing temporal-only pass: - observed: a day's observed celebration never also appears among that same day's own commemorations/omissions. - lost: no sanctoral entry is silently dropped. Per slug, the number of times it is actually sighted (observed + commemorations + omitted, summed over the year) must never fall below the number of times its own Date_spec resolves within the year's span -- also fires if resolving the year raises at all, the most total form of loss. - duplicated: the same per-slug count must never exceed the number of Date_spec resolutions either. Deliberately NOT "no slug appears twice": a fixed date can legitimately resolve twice in the ~20% of liturgical years whose 371-day span reaches it on both ends (30 November/St Andrew is the worked example in validate.mli). - unconverged: no day's omitted reason indicates Calendar's placement pass hit its round guard before reaching a fixed point. - admission: the rite's own rules.admit is a fixed point on what it already admitted -- the rite-agnostic form of "the admission limit was not exceeded" available without embedding a rite's own numeric caps (RG 111's, for EF) into kernel code. Each check has a dedicated negative fixture in the synthetic rite (test_validate.ml), hand-traced against Calendar's actual resolution mechanics before writing the assertion, and verified to fail for the right reason against the code before this change. One pair (unconverged/duplicated) is not fully independent: hitting the round guard genuinely also trips duplicated, a real consequence of Calendar's own accounting once a candidate is simultaneously sighted at its permanent natural date and wherever the last placement round left it -- documented in guard_rules's own comment, not papered over. test_validate.ml's ef_rite/run now use the real Rite_ef.context and the real bootstrapped data/ef layer (Precedence_ef and the sanctoral bootstrap did not exist when this scaffolding was first written) rather than the earlier placeholder rules. Validate is clean across the whole 1583..9999 domain against real EF data except the one already-documented year-9999 truncation case (test_year_9999_does_not_raise). --- lib/kernel/validate.ml | 132 +++++++++++++++++++- lib/kernel/validate.mli | 46 ++++++- test/test_validate.ml | 311 ++++++++++++++++++++++++++++++++++++++++++++---- 3 files changed, 460 insertions(+), 29 deletions(-) (limited to 'lib') diff --git a/lib/kernel/validate.ml b/lib/kernel/validate.ml index c6501a9..d8de31b 100644 --- a/lib/kernel/validate.ml +++ b/lib/kernel/validate.ml @@ -20,7 +20,20 @@ let has_duplicate strings = let rec go = function a :: (b :: _ as rest) -> a = b || go rest | _ -> false in go sorted -let run (rite : ('s, 'r) Rite.t) ~year = +(* Task 12's "unconverged" check has no structural signal to key off -- + Calendar's placement pass records its round-guard reason as a plain + string in [Liturgical_day.omitted] (calendar.ml's own [unconverged_reason], + not exposed as a public constant), and [Liturgical_day.omitted]'s own doc + comment says exactly this check is meant to read it. A short, distinctive + substring rather than the full literal keeps the coupling to calendar.ml's + exact wording as loose as it can be while still being unambiguous: nothing + else this kernel emits into [omitted] talks about "converging". *) +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 run (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) ~year = let vocab = rite.Rite.vocab in let year_start = rite.Rite.year_start in let temporal = rite.Rite.temporal in @@ -164,4 +177,121 @@ let run (rite : ('s, 'r) Rite.t) ~year = if actual <> expected_slug then fail date "anchor" (Printf.sprintf "expected slug %S, got %S" expected_slug actual)) anchor_pairs; + (* Resolution invariants (Task 12): everything above only ever asked + [rite.temporal] for a date's office in isolation. From here on the + LITURGICAL YEAR IS ACTUALLY RESOLVED against [layer] -- occurrence, + transfer placement, commemorations, the works (spec §2.4) -- and the + result checked for five further properties a temporal-only pass cannot + see at all. [days] (the walk built above) is reused rather than + recomputed: it names exactly the same [start, stop] span + {!Calendar.year} resolves for this [year]. *) + (match Calendar.year rite layer year with + | exception exn -> + (* The kernel contract forbids [run] itself from ever raising on + in-range input, and an exception escaping resolution is the most + total form of "silently lost" there is: nothing about this year's + sanctoral entries could be verified as accounted for at all. *) + fail start "lost" + (Printf.sprintf "resolving the year raised (%s); nothing could be verified as accounted for" + (Printexc.to_string exn)) + | resolved -> + let idx = Layer.index_by_date layer in + let bump tbl slug = Hashtbl.replace tbl slug (1 + (try Hashtbl.find tbl slug with Not_found -> 0)) in + (* Expected: how many times each layer entry's own Date_spec resolves + within [start, stop]. Walking dates and querying [Layer.on_date] + (rather than resolving each entry's Date_spec against candidate + civil years directly) is what naturally counts a fixed late- + November date TWICE in the ~20% of liturgical years whose 371-day + span reaches it on both ends -- see validate.mli's own note on 30 + November / St Andrew. *) + let expected : (string, int) Hashtbl.t = Hashtbl.create 64 in + List.iter + (fun date -> + Layer.on_date idx ~month:(Date.month date) ~day:(Date.day date) + |> List.iter (fun (e : 'r Layer.entry) -> + bump expected (Slug.to_string e.Layer.cel.Celebration.slug))) + days; + (* Actual: how many times each slug is actually sighted across the + resolved year. Deliberately [observed] + [commemorations] + + [omitted] only, NOT [transferred_out]: a successfully transferred + celebration is already counted once, via [observed] (+ + [transferred_in]) on the day it lands; also counting + [transferred_out] at the day it left would double-book every clean + transfer, which is exactly what this check exists to catch, not + cause. *) + let actual : (string, int) Hashtbl.t = Hashtbl.create 64 in + let bump_cel tbl (c : 'r Celebration.t) = bump tbl (Slug.to_string c.Celebration.slug) in + Array.iter + (fun (d : ('s, 'r) Liturgical_day.t) -> + bump_cel actual d.Liturgical_day.observed; + List.iter (fun (c, _) -> bump_cel actual c) d.Liturgical_day.commemorations; + List.iter (fun (c, _) -> bump_cel actual c) d.Liturgical_day.omitted) + resolved; + Hashtbl.fold (fun slug exp acc -> (slug, exp) :: acc) expected [] + |> List.sort compare (* stable failure order: Hashtbl.iter's own order is hash-seed-dependent *) + |> List.iter (fun (slug, exp) -> + let act = try Hashtbl.find actual slug with Not_found -> 0 in + if act < exp then + fail start "lost" + (Printf.sprintf "%s: sighted %d time(s) this year, but its own Date_spec resolves %d" + slug act exp) + else if act > exp then + fail start "duplicated" + (Printf.sprintf "%s: sighted %d time(s) this year, but its own Date_spec resolves only %d" + slug act exp)); + Array.iter + (fun (d : ('s, 'r) Liturgical_day.t) -> + let date = d.Liturgical_day.date in + let observed_slug = Slug.to_string d.Liturgical_day.observed.Celebration.slug in + let has_slug (c, _) = Slug.to_string c.Celebration.slug = observed_slug in + (* "observed": the day's own winner must not ALSO be listed as one + of its own losers -- see validate.mli's own note on why this is + reachable (two distinct layer entries sharing a slug, one + transferred onto the other's natural date, the transferred one + winning) despite {!Precedence.resolve}'s fold never letting the + SAME candidate value appear as both winner and loser. *) + if List.exists has_slug d.Liturgical_day.commemorations + || List.exists has_slug d.Liturgical_day.omitted + then + fail date "observed" + (Printf.sprintf + "%s is this day's observed celebration and also appears among its own \ + commemorations/omissions" + observed_slug); + (* "unconverged": see [contains_substring]'s own comment above. *) + if + List.exists + (fun (_, reason) -> contains_substring reason ~needle:"did not converge") + d.Liturgical_day.omitted + then + fail date "unconverged" + "transfer placement did not reach a fixed point within the round guard (RG 96-98)"; + (* "admission": re-offer this day's own admitted commemorations + back to [rite.rules.admit] and require the exact same set back. + [origin] is reconstructed as [Sanctoral] uniformly: + {!Liturgical_day.t} does not retain a commemoration's original + origin, and the real EF [admit] (precedence_ef.ml) reads only + rank and slug from a candidate, never [origin], so this + reconstruction is exact for it; documented in validate.mli as + the one place a rite whose [admit] DOES consult [origin] could + see a false negative from this check. *) + let observed_candidate : 'r Precedence.candidate = + { Precedence.cel = d.Liturgical_day.observed; origin = Precedence.Sanctoral } + in + let as_candidates comms = + List.map (fun (c, p) -> ({ Precedence.cel = c; origin = Precedence.Sanctoral }, p)) comms + in + let offered = as_candidates d.Liturgical_day.commemorations in + let readmitted = rite.Rite.rules.Precedence.admit ~observed:observed_candidate offered in + let norm l = + 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 + fail date "admission" + (Printf.sprintf + "admit is not a fixed point on this day's own commemorations: re-offering %d \ + admitted %d back" + (List.length offered) (List.length readmitted))) + resolved); List.rev !failures diff --git a/lib/kernel/validate.mli b/lib/kernel/validate.mli index d281f9a..511c78f 100644 --- a/lib/kernel/validate.mli +++ b/lib/kernel/validate.mli @@ -5,8 +5,9 @@ type failure = { year : int; date : string; check : string; detail : string } val failure_to_string : failure -> string -(** [run rite ~year] returns every invariant violation in the liturgical year - opening in civil year [year]. An empty list means the year is clean. +(** [run rite layer ~year] returns every invariant violation in the + liturgical year opening in civil year [year]. An empty list means the + year is clean. [rite.Rite.anchors y] is the rite's own independent restatement of its fixed and Easter-derived named days for civil year [y], as (expected @@ -21,8 +22,47 @@ val failure_to_string : failure -> string have one season appear in two separate runs (the modern form's Ordinary Time does), so the two are not necessarily the same list. + [layer] is resolved against [rite] via {!Calendar.year} (spec §2.4's + occurrence/transfer/commemoration pass), and the resulting fully-resolved + liturgical year is checked for five further invariants a temporal-only + pass cannot see (Task 12), each its own ["check"] label: + - ["observed"]: a day's [observed] celebration is never ALSO listed among + that same day's [commemorations] or [omitted] -- a day reports one + winner, not a winner that also lost to itself. + - ["lost"]: no sanctoral entry is silently dropped. Per slug, the number + of times it is actually sighted ([observed] + [commemorations] + + [omitted], summed over the whole year -- NOT [transferred_out], which + would double-count a successfully placed transfer against its own + arrival) must never fall below the number of times its own + {!Date_spec} resolves within the year's span (an entry with two + occurrences, e.g. 30 November in the nine liturgical years where the + 371-day span reaches it twice, must be sighted twice, not once). Also + fires if resolving the year raises at all -- an escaping exception is + the most total form of silent loss, and the kernel contract forbids + [run] itself from propagating it. + - ["duplicated"]: the same per-slug count must never EXCEED the number of + {!Date_spec} resolutions either. Deliberately NOT "no slug appears + twice in the year" -- a fixed date can legitimately resolve twice, per + ["lost"] above -- it is "resolutions and sightings agree", the property + that actually distinguishes a transfer that moved from one that + duplicated. + - ["unconverged"]: no day's [omitted] carries the reason {!Calendar}'s + placement pass records when its round guard (calendar.ml's + [max_transfer_rounds]) is hit before every deferred candidate reaches a + fixed point. + - ["admission"]: the rite's own [rules.admit] is a fixed point on what it + already admitted -- re-offering a day's [commemorations] back to + [admit] (reconstructed with {!Precedence.Sanctoral} origin; the real EF + admit reads only rank and slug, never origin, so this reconstruction is + exact for it) must return exactly that same set. A cap-enforcing + selector that is not idempotent on its own output has, by definition, + admitted something its own rule would not admit if asked again -- the + rite-agnostic form of "the admission limit was not exceeded" available + without embedding a rite's specific numeric caps (RG 111's, for EF) + into kernel code. + Total over the whole 1583..9999 domain, including [year] = 9999: the liturgical year opening there continues into out-of-domain civil year 10000, so the walk is clamped to 31 December 9999 and the checks run against that truncated final year rather than raising. *) -val run : ('s, 'r) Rite.t -> year:int -> failure list +val run : ('s, 'r) Rite.t -> 'r Layer.t -> year:int -> failure list diff --git a/test/test_validate.ml b/test/test_validate.ml index df8c99c..b2d4f34 100644 --- a/test/test_validate.ml +++ b/test/test_validate.ml @@ -1,24 +1,40 @@ module Val = Colitur_kernel.Validate module Rite = Colitur_kernel.Rite module P = Colitur_kernel.Precedence +module Layer = Colitur_kernel.Layer +module Overlay = Colitur_kernel.Overlay module V = Rite_ef.Vocab_ef module T = Rite_ef.Temporal_ef -(* Plan 3's real EF precedence rules (Precedence_ef, Tasks 7-11) don't exist - yet -- Validate.run doesn't read [rules] or [transfer_target] at all - (nothing does before Task 5's Calendar and Task 6's placement pass), so a - placeholder is enough to assemble a well-typed Rite.t here. *) -let ef_rules : (V.season, V.rank) P.rules = - { P.band = (fun _ _ -> 0); - disposition = (fun ~winner:_ ~loser:_ -> P.Omit); - admit = (fun ~observed:_ _ -> []) } - -let ef_rite : (V.season, V.rank) Rite.t = - { Rite.id = T.id; vocab = V.vocab; year_start = T.year_start; temporal = T.temporal; - anchors = T.anchors; rules = ef_rules; season_runs = V.seasons; - transfer_target = (fun _ origin _ -> origin) } - -let run year = Val.run ef_rite ~year +(* Task 12 widens Validate.run to take a resolved layer -- Precedence_ef and + Calendar (Tasks 5-11) now exist, so the REAL EF rite (Rite_ef.context) and + its REAL bootstrapped data replace the earlier placeholder rules/layer-less + Rite.t this module used before Plan 3's resolution engine was built. + Relative to this test's own build directory (_build/default/test/), same + convention test_rite_ef.ml already uses -- test/dune declares both as deps + of the (test ...) stanza. *) +let sanctoral_path = "../data/ef/sanctoral.sexp" +let adjustments_path = "../data/ef/adjustments.sexp" + +(* Loaded once at module init, not per call: [run] below is called by every + test and by the 200-sample property, and Calendar.year's own resolution + cost already dominates -- there is no reason to also re-parse a 322-entry + sexp file on every one of those calls. *) +let real_ef_layer = + match Layer.load V.rank_of_sexp sanctoral_path with + | Error e -> failwith (Printf.sprintf "%s: failed to load: %s" sanctoral_path e) + | Ok layer -> ( + match Overlay.load V.rank_of_sexp adjustments_path with + | Error e -> failwith (Printf.sprintf "%s: failed to load: %s" adjustments_path e) + | Ok overlay -> + let layer, diagnostics = Overlay.apply layer overlay in + if diagnostics <> [] then + failwith + (Printf.sprintf "unexpected overlay diagnostics: %s" + (String.concat "; " (List.map Overlay.diagnostic_to_string diagnostics))); + layer) + +let run year = Val.run Rite_ef.context real_ef_layer ~year let check_year year = match run year with @@ -94,6 +110,8 @@ module Synthetic = struct module Temporal = Colitur_kernel.Temporal module P = Colitur_kernel.Precedence module Rite = Colitur_kernel.Rite + module Layer = Colitur_kernel.Layer + module Date_spec = Colitur_kernel.Date_spec type season = A | B type rank = R1 | R2 @@ -122,8 +140,12 @@ module Synthetic = struct let vocab_collapsed_ranks = { vocab with Vocab.rank_to_string = (fun _ -> "same") } let vocab_collapsed_seasons = { vocab with Vocab.season_to_string = (fun _ -> "same") } - (* Precedence_ef doesn't exist yet (Tasks 7-11); Validate.run never reads - [rules], so a placeholder is enough to assemble a well-typed Rite.t. *) + (* The placeholder ruleset every TEMPORAL-only fixture below still uses: + paired with the default empty [layer] (see [rite] below), there is never + a sanctoral candidate for these three functions to be called against, so + what they return is moot for those tests -- only the Task 12 resolution + fixtures further down override [rules] (and supply a non-empty + [layer]), each with its own small, deliberately-shaped ruleset. *) let rules : (season, rank) P.rules = { P.band = (fun _ _ -> 0); disposition = (fun ~winner:_ ~loser:_ -> P.Omit); @@ -173,14 +195,25 @@ module Synthetic = struct this synthetic rite too, not only in EF. *) let anchors _y = [ (Slug.to_string (good target).Temporal.office.Cel.slug, target) ] - let rite ?(vocab = vocab) ?(anchors = fun _ -> []) ?(season_runs = [ A; B ]) temporal - : (season, rank) Rite.t = + (* Task 12: [rite] now also takes [rules]/[transfer_target] (defaulting to + the placeholder above and to "stand still", respectively -- harmless + defaults against the default empty [layer], since nothing ever contests + the temporal office there) so the resolution fixtures further down can + override them without duplicating every other field. *) + let rite ?(vocab = vocab) ?(anchors = fun _ -> []) ?(season_runs = [ A; B ]) ?(rules = rules) + ?(transfer_target = fun _ origin _ -> origin) temporal : (season, rank) Rite.t = { Rite.id = "synthetic"; vocab; year_start; temporal; anchors; rules; season_runs; - (* Validate.run doesn't read this either (see [ef_rules] above). *) - transfer_target = (fun _ origin _ -> origin) } + transfer_target } - let run ?vocab ?anchors ?season_runs temporal = - Val.run (rite ?vocab ?anchors ?season_runs temporal) ~year:2026 + (* Empty by default: every check built before Task 12 exercises the + TEMPORAL-only pass, where an empty layer is exactly the fixture that + leaves it unable to affect anything ([Precedence.resolve] against no + sanctoral candidates always just observes the temporal office + unchallenged). Task 12's own resolution fixtures pass their own. *) + let empty_layer = Layer.empty ~id:"synthetic-empty" ~name:"empty" + + let run ?vocab ?anchors ?season_runs ?rules ?transfer_target ?(layer = empty_layer) temporal = + Val.run (rite ?vocab ?anchors ?season_runs ?rules ?transfer_target temporal) layer ~year:2026 let has_check check (fs : Val.failure list) = List.exists (fun f -> f.Val.check = check) fs @@ -210,6 +243,180 @@ module Synthetic = struct let rite_with_two_runs : (season, rank) Rite.t = rite ~season_runs:[ A; B; A; B ] two_run_temporal + + (* ---- Task 12: resolution-level fixtures ---- + + Everything above only ever drives the TEMPORAL-only pass: [run]'s + default [layer] is empty, so [Precedence.resolve] never has a sanctoral + candidate to contest against the temporal office, and [rules]/ + [transfer_target] are never meaningfully exercised. These five fixtures + instead give [Calendar.year] real work -- a non-empty [layer] plus a + small, deliberately-shaped [rules] (and, for two of them, + [transfer_target]) -- each built so its OWN check label fires. Four of + the five fire in clean isolation (the other four Task 12 labels stay + silent); the fifth (["unconverged"]) genuinely also fires + ["duplicated"] alongside it, a real consequence of Calendar's own round- + guard accounting, not a fixture design flaw -- see guard_rules's own + comment. Every fixture's isolation (or lack of it) was verified by + hand-tracing [Calendar]'s resolution mechanics BEFORE writing its + assertion (see the task report), not inferred from what the assertion + happens to require -- the tests below check that trace against the + actual engine output, one fixture at a time. [good] is reused, + unchanged, as every fixture's [temporal]: only [rules]/[layer]/ + [transfer_target] vary, so the temporal-only checks (already proven + clean against [good] by [test_synthetic_baseline_is_clean]) cannot be + what fires here. *) + + let mk_entry ~month ~day ~slug ~rank = + { Layer.date = (match Date_spec.fixed ~month ~day with Ok d -> d | Error e -> failwith e); + cel = Cel.make ~slug:(Slug.of_string_exn slug) ~rank ~colour:Colour.White + ~layer:"synthetic-sanctoral" () } + + let task12_checks = [ "observed"; "lost"; "duplicated"; "unconverged"; "admission" ] + + (* The Task-12-owned subset of a failure list's own check labels, as a + sorted, de-duplicated set -- what each isolation assertion below + compares against, so a fixture that (by mistake) also trips an + unrelated Task-12 check shows up as a wrong set, not a silently-passing + [has_check]. *) + let fired_task12_checks (fs : Val.failure list) = + List.filter_map (fun f -> if List.mem f.Val.check task12_checks then Some f.Val.check else None) fs + |> List.sort_uniq compare + + (* "duplicated": a single ordinary sanctoral entry, always losing to the + temporal office (band: Temporal 0 < Sanctoral 10, unconditionally) and + always Commemorate-disposed. [admit]'s bug is exactly the shape + precedence_ef.mli's own [admit] contract warns against ("a value taken + unchanged from comms, never rebuilt"): it REBUILDS every admitted pair + via a record update, allocating a fresh, structurally-identical-but- + physically-distinct candidate. Precedence.resolve's own [dropped] + computation tells an admitted candidate from a dropped one by PHYSICAL + equality, so the rebuild defeats it -- the one candidate ends up counted + as both admitted (in [commemorations]) and dropped (in [omitted], + "admission limit reached"): two sightings for one Date_spec + resolution. *) + let dup_entry = mk_entry ~month:5 ~day:5 ~slug:"dup-target" ~rank:R2 + let dup_layer = Layer.of_entries ~id:"dup" ~name:"dup" [ dup_entry ] + + 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:_ cs -> List.map (fun (c, p) -> ({ 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: + "guard-aaa" wins the day outright every time, "guard-zzz" is always the + loser there and always Transfer-disposed. Paired with a + [transfer_target] that always answers with the impeded day itself -- + never strictly forward -- this is the exact non-terminating shape + test_calendar.ml's own + [test_transfer_guard_records_failure_instead_of_looping] proves hits + Calendar's round guard: "guard-zzz", re-injected into 6 June every + round, can never win it (it always loses the tie to the natural + "guard-aaa" copy already sitting there), so [deferred] never empties. + + GENUINE FINDING (see the task report): this ALSO fires "duplicated", not + "unconverged" alone. Once the guard is hit, [build_day]'s final resolve + at 6 June sees "guard-zzz" TWICE -- once as the permanent natural entry + (which never stops losing there) and once as whatever the last round's + [injected] state still holds for it -- and [unresolved] is evaluated per + CANDIDATE OBJECT, not per slug, so BOTH copies land in [omitted] with + the unconverged reason. Nothing is lost (both copies carry a recorded + reason), but the slug is sighted twice against one Date_spec resolution, + which is exactly what "duplicated" is for. The same double-recording is + latent in test_calendar.ml's own guard fixture too (day_winner/eclipsed + at 20 Dec, structurally identical) -- untested there only because that + test uses [List.exists], not a count. Calendar's round guard is + documented as "nothing in the 1962 calendar is expected to trigger" + (calendar.ml), so this is a latent accounting quirk in an unreachable + path, not a live bug, and calendar.ml is out of this task's file list -- + reported, not fixed here. *) + let guard_winner_entry = mk_entry ~month:6 ~day:6 ~slug:"guard-aaa" ~rank:R1 + let guard_loser_entry = mk_entry ~month:6 ~day:6 ~slug:"guard-zzz" ~rank:R1 + let guard_layer = Layer.of_entries ~id:"guard" ~name:"guard" [ guard_winner_entry; guard_loser_entry ] + + let guard_rules : (season, rank) P.rules = + { P.band = (fun _ c -> match c.P.origin with P.Temporal -> 50 | P.Sanctoral -> 10); + disposition = + (fun ~winner:_ ~loser -> + match loser.P.cel.Cel.rank with R1 -> P.Transfer | R2 -> P.Commemorate P.Ordinary); + admit = (fun ~observed:_ cs -> cs) } + + let guard_transfer_target (_ : rank P.candidate) (origin : D.t) (_ : D.t -> rank Cel.t) = origin + + (* "admission": three entries collide on one date (9 September), all + losing to the temporal office (band: Temporal 0 < Sanctoral 10) and all + Commemorate-disposed -- a genuine 3-candidate offer to [admit]. The bug: + cap 2 when the offer's length is ODD, cap 1 when EVEN -- a length-keyed + rule with no liturgical meaning, chosen as the simplest function that is + NOT idempotent on its own output (offer 3, admit 2; re-offer those same + 2, admit only 1) while staying idempotent -- and so invisible -- on + every OTHER shape this suite exercises (never offered exactly 2 or 3 + candidates elsewhere), including its own clean 3-candidate day. *) + let adm_a_entry = mk_entry ~month:9 ~day:9 ~slug:"adm-a" ~rank:R2 + let adm_b_entry = mk_entry ~month:9 ~day:9 ~slug:"adm-b" ~rank:R2 + 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 rec adm_take n = function + | [] -> [] + | x :: xs -> if n <= 0 then [] else x :: adm_take (n - 1) xs + + let adm_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:_ 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) } + + (* "observed": two DIFFERENT layer entries sharing one slug -- a realistic + data mistake (a renamed or duplicated entry), not prevented by + [Layer.t]'s own type. [collide_a] (1 Feb, rank R1) always loses on its + OWN date: [band] makes the temporal office win there specifically (5, + beating R1's 10) and lose everywhere else (50), so [collide_a] is always + Transfer-disposed at 1 Feb. Its constant [transfer_target] sends it to + 10 Feb -- [collide_b]'s own home date -- where [collide_a]'s rank R1 + (band 10) now beats both the temporal office (50, since the date is no + longer 1 Feb) and [collide_b]'s own rank R2 (band 90): the ARRIVING + [collide_a] wins 10 Feb outright, and [collide_b] -- same slug as the + new winner -- is Commemorate-disposed (R2) right alongside it. One day + ends up reporting the same slug as both its observed celebration and one + of its own commemorations. *) + let collide_d1 = match D.make ~year:2026 ~month:2 ~day:1 with Ok d -> d | Error e -> failwith e + let collide_a_entry = mk_entry ~month:2 ~day:1 ~slug:"collide-x" ~rank:R1 + let collide_b_entry = mk_entry ~month:2 ~day:10 ~slug:"collide-x" ~rank:R2 + let collide_layer = Layer.of_entries ~id:"collide" ~name:"collide" [ collide_a_entry; collide_b_entry ] + + let collide_rules : (season, rank) P.rules = + { P.band = + (fun ctx c -> + match c.P.origin with + | P.Temporal -> if D.compare ctx.P.date collide_d1 = 0 then 5 else 50 + | P.Sanctoral -> ( match c.P.cel.Cel.rank with R1 -> 10 | R2 -> 90)); + disposition = + (fun ~winner:_ ~loser -> + match loser.P.cel.Cel.rank with R1 -> P.Transfer | R2 -> P.Commemorate P.Ordinary); + admit = (fun ~observed:_ cs -> 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 + + (* A genuinely resolved, well-behaved day (one ordinary sanctoral entry, + cleanly losing and commemorated, nothing transferred) -- proving the + five checks stay silent against REAL resolution machinery, not merely + against the default empty [layer] every fixture above this section + uses. Without this, "no check fires" would only ever have been shown + for a layer with nothing in it. *) + let clean_sanctoral_entry = mk_entry ~month:8 ~day:8 ~slug:"clean-saint" ~rank:R2 + let clean_sanctoral_layer = Layer.of_entries ~id:"clean" ~name:"clean" [ clean_sanctoral_entry ] + + 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:_ cs -> cs) } end open Synthetic @@ -227,7 +434,7 @@ let test_synthetic_baseline_is_clean () = let test_two_run_season_is_accepted () = let r = Synthetic.rite_with_two_runs in Alcotest.(check (list string)) "no failures" [] - (List.map Val.failure_to_string (Val.run r ~year:2026)) + (List.map Val.failure_to_string (Val.run r Synthetic.empty_layer ~year:2026)) let test_coverage_fires () = let temporal d = if D.compare d target = 0 then failwith "boom" else good d in @@ -332,6 +539,53 @@ let test_vocab_season_injectivity_fires () = Alcotest.(check bool) "vocab check fires when season_to_string collapses two seasons to one string" true (has_check "vocab" (run ~vocab:vocab_collapsed_seasons good)) +(* ---- Task 12: resolution invariants ---- + + Each test below asserts that exactly one of the five new check labels + fires for its own dedicated fixture (Synthetic's own comments carry the + hand-traced mechanics) -- not merely "at least this one", so a fixture + that turns out to also trip an unrelated Task 12 check would fail loudly + here rather than reading as accidental corroboration. *) + +let test_lost_fires_on_resolution_exception () = + (* Reuses [test_coverage_fires]'s own broken [temporal]: [Calendar.year] + calls [rite.temporal] with no exception guard of its own (unlike the + temporal-only pass above, which wraps every call), so the same raise + that trips "coverage" also makes resolution itself raise -- the most + total form of "silently lost" there is, per validate.mli. *) + let temporal d = if D.compare d target = 0 then failwith "boom" else good d in + Alcotest.(check (list string)) "only the lost check fires" [ "lost" ] (fired_task12_checks (run temporal)) + +let test_duplicated_fires () = + Alcotest.(check (list string)) "only the duplicated check fires" [ "duplicated" ] + (fired_task12_checks (run ~layer:dup_layer ~rules:dup_rules good)) + +let test_unconverged_fires () = + (* Also asserts "duplicated" fires alongside it -- see guard_rules's own + comment for why that is the genuine, hand-verified consequence of + hitting the round guard here, not an isolation failure. *) + Alcotest.(check (list string)) "unconverged fires, and duplicated alongside it" + [ "duplicated"; "unconverged" ] + (fired_task12_checks + (run ~layer:guard_layer ~rules:guard_rules ~transfer_target:guard_transfer_target good)) + +let test_admission_fires () = + Alcotest.(check (list string)) "only the admission check fires" [ "admission" ] + (fired_task12_checks (run ~layer:adm_layer ~rules:adm_rules good)) + +let test_observed_fires () = + Alcotest.(check (list string)) "only the observed check fires" [ "observed" ] + (fired_task12_checks + (run ~layer:collide_layer ~rules:collide_rules ~transfer_target:collide_transfer_target good)) + +(* The positive counterpart: a genuinely resolved, well-behaved day (real + sanctoral entry, real contest, real commemoration) must report none of the + five checks -- proven against actual resolution machinery, not only + against every OTHER fixture's default empty layer. *) +let test_resolution_checks_clean_on_a_well_behaved_layer () = + Alcotest.(check (list string)) "none of the five checks fire" [] + (fired_task12_checks (run ~layer:clean_sanctoral_layer ~rules:clean_sanctoral_rules good)) + let suite = ( "Validate", [ Alcotest.test_case "landmark years" `Quick test_landmark_years; @@ -349,5 +603,12 @@ let suite = Alcotest.test_case "anchor clean" `Quick test_anchor_clean; Alcotest.test_case "anchor fires" `Quick test_anchor_fires; Alcotest.test_case "vocab rank injectivity fires" `Quick test_vocab_rank_injectivity_fires; - Alcotest.test_case "vocab season injectivity fires" `Quick test_vocab_season_injectivity_fires ] + Alcotest.test_case "vocab season injectivity fires" `Quick test_vocab_season_injectivity_fires; + Alcotest.test_case "lost fires on resolution exception" `Quick test_lost_fires_on_resolution_exception; + Alcotest.test_case "duplicated fires" `Quick test_duplicated_fires; + Alcotest.test_case "unconverged fires" `Quick test_unconverged_fires; + Alcotest.test_case "admission fires" `Quick test_admission_fires; + Alcotest.test_case "observed fires" `Quick test_observed_fires; + Alcotest.test_case "resolution checks clean on a well-behaved layer" `Quick + test_resolution_checks_clean_on_a_well_behaved_layer ] @ List.map QCheck_alcotest.to_alcotest [ prop_invariants ] ) -- cgit v1.3 From 4235a6aa18b815c5457a7eb97fd97eb4919dfd4b Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 12 Aug 2026 02:37:03 +0200 Subject: kernel(validate): fold in Plan 2's carried guards Three carried items from Plan 2's parked rulings, closed: 1. Slug uniqueness moves from a 200-sample QCheck property scoped to one rite (test_temporal_ef.ml) into Validate's own "slugs" check, so every consumer gets it. The resumed-Sunday exemption that property carried is dropped, not weakened elsewhere: Plan 2 verified zero duplicate slugs domain-wide (all 8 416 years), and by construction a resumed Sunday only ever backfills a week number Septuagesima cut short that same liturgical year, so it can never repeat a number that year's own January Sundays already used. The now-redundant property and its is_resumable_sunday_slug helper are removed from test_temporal_ef.ml; test_validate.ml's own domain-wide property covers the same ground for every consumer. 2. The anchors-erosion guard (Plan 2: deleting entries from a rite's anchors list left the whole suite green) is implemented, but not in Validate. Which of a rite's named days are Easter-derived is knowledge only the rite's own `named` function has; Rite.t deliberately exposes only `temporal` and `anchors`, never `named`, so a rite-agnostic Validate has no ground truth to check anchors' completeness against. Hardcoding an Easter offset, or even Easter itself, would smuggle Western/Gregorian-specific knowledge into code meant to also serve a future Julian-reckoning rite; rediscovering "named-ness" structurally from `temporal` alone is unsound for EF, since most ordinary Sunday/feria slugs from Septuagesima onward are also constant-offset-from-Easter by construction. The guard is therefore EF-specific and lives in test_temporal_ef.ml, discovering the Easter-derived slug set mechanically (scanning a window around Easter and keeping whatever `named` answers Some for) rather than hand-copying either named's or anchors' own offset list, then asserting completeness against the real anchors for the domain's Easter extremes (1598, 1666) plus an ordinary year. A negative fixture proves the guard has teeth, matching Plan 2's exact regression (anchors missing "ef-ascension" reports it, and only it, as missing). 3. test_validate.ml's extreme_years comment claimed 1818/2038; verified against Computus.gregorian_easter directly, the domain's actual Easter extremes (1583..2500) are 1598/1666. Corrected. Verification: the full 1583..9999 domain sweep (233 tests via dune test's 200-sample default, plus a manual full sweep) reports exactly one failure -- the known, already-pinned year-9999 season-truncation case -- and zero occurrences of the new "slugs" check anywhere in the domain. Deleting "ef-ascension" from the real anchors list (reproducing Plan 2's regression directly) is caught immediately by the new EF test and, confirmed empirically, invisible to Validate's own full property sweep -- direct evidence for why item 2 cannot live in Validate. --- lib/kernel/validate.ml | 49 +++++++++++++---- lib/kernel/validate.mli | 7 +++ test/test_temporal_ef.ml | 140 ++++++++++++++++++++++++++++++++++++----------- test/test_validate.ml | 24 +++++++- 4 files changed, 174 insertions(+), 46 deletions(-) (limited to 'lib') diff --git a/lib/kernel/validate.ml b/lib/kernel/validate.ml index d8de31b..cc8bdce 100644 --- a/lib/kernel/validate.ml +++ b/lib/kernel/validate.ml @@ -20,6 +20,17 @@ let has_duplicate strings = let rec go = function a :: (b :: _ as rest) -> a = b || go rest | _ -> false in go sorted +(* Like [has_duplicate], but names the offender(s) instead of only reporting + that one exists -- the ["slugs"] check below wants a useful failure + detail, not just a bool. *) +let duplicates strings = + let sorted = List.sort String.compare strings in + let rec go acc = function + | a :: (b :: _ as rest) -> go (if a = b then a :: acc else acc) rest + | _ -> acc + in + List.sort_uniq String.compare (go [] sorted) + (* Task 12's "unconverged" check has no structural signal to key off -- Calendar's placement pass records its round-guard reason as a plain string in [Liturgical_day.omitted] (calendar.ml's own [unconverged_reason], @@ -85,18 +96,16 @@ let run (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) ~year = (* Weekday agreement. *) if t.Temporal.weekday <> Date.weekday date then fail date "weekday" "temporal weekday disagrees with Date.weekday"; - (* Slug: three properties, none checked here, all delivered - elsewhere. Well-formedness needs no check: [Slug.t] is a private - string validated on every construction path ([of_string], - [of_string_exn], [t_of_sexp]), and [to_string] is the identity, - so round-tripping an existing [Slug.t] can never fail -- a check - here would be structurally incapable of firing, which is worse - than no check, since it would look like coverage that isn't - there. Uniqueness *per date* needs no check either: [temporal] - returns exactly one office by construction. Uniqueness *across - the year* is deliberately NOT asserted -- a resumed Sunday - reuses an earlier Epiphany key on purpose, so the check would be - false. *) + (* Slug: three properties. Well-formedness needs no check: [Slug.t] + is a private string validated on every construction path + ([of_string], [of_string_exn], [t_of_sexp]), and [to_string] is + the identity, so round-tripping an existing [Slug.t] can never + fail -- a check here would be structurally incapable of firing, + which is worse than no check, since it would look like coverage + that isn't there. Uniqueness *per date* needs no check either: + [temporal] returns exactly one office by construction. + Uniqueness *across the year* IS asserted, below, once the whole + walk is in hand -- see the ["slugs"] check after this loop. *) (* Vocabulary closure. *) if not (List.exists (fun r -> vocab.Vocab.rank_to_string r = vocab.Vocab.rank_to_string cel.Celebration.rank) @@ -114,6 +123,22 @@ let run (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) ~year = | None -> fail date "determinism" "a second call to temporal raised where the first succeeded")) days; let observed = List.rev !observed in + (* Slug uniqueness across the year (Plan 2 carried item 4): moved into + [Validate] itself so every consumer gets it, not only a 200-sample + QCheck property scoped to one rite. Asserted OUTRIGHT, no exemption: + Plan 2 verified zero duplicate slugs domain-wide, across all 8 416 + years, for the EF rite's own resumed-Sunday mechanism -- the exemption + the test property used to carry protected nothing real, because a + resumed Sunday only ever backfills a week number Septuagesima cut short + that same liturgical year (so it was never actually used that year to + begin with), never repeats one the year's own January Sundays already + used. If a future rite genuinely needs an exemption, it can supply one + then -- not speculatively here. *) + (match duplicates (List.map (fun (_, t) -> Slug.to_string t.Temporal.office.Celebration.slug) observed) with + | [] -> () + | dups -> + fail start "slugs" + (Printf.sprintf "slug(s) sighted on more than one date this year: %s" (String.concat ", " dups))); (* Season contiguity and completeness: the run-length-compressed sequence must equal the rite's own [season_runs] exactly, in canonical order. This is NOT necessarily [vocab.seasons] -- most rites have each season in one diff --git a/lib/kernel/validate.mli b/lib/kernel/validate.mli index 511c78f..5e55fc5 100644 --- a/lib/kernel/validate.mli +++ b/lib/kernel/validate.mli @@ -17,6 +17,13 @@ val failure_to_string : failure -> string straddles two civil years, and checks only the pairs whose date actually falls within the year walked. + ["slugs"]: no two dates within the walked liturgical year may carry the + same office slug (Plan 2 carried item 4). Asserted outright, with no + exemption for the resumed-Sunday reuse a slug's own name might suggest: + a resumed Sunday only ever backfills a week number Septuagesima cut + short that same year, so by construction it never repeats a number that + year's own January Sundays actually used. + The season check compares the run-length-compressed season sequence against [rite.Rite.season_runs], not [rite.Rite.vocab.seasons]: a rite may have one season appear in two separate runs (the modern form's Ordinary diff --git a/test/test_temporal_ef.ml b/test/test_temporal_ef.ml index 2ad93e8..477651c 100644 --- a/test/test_temporal_ef.ml +++ b/test/test_temporal_ef.ml @@ -306,36 +306,112 @@ let test_christmastide_feria_slugs () = Alcotest.(check string) "13 Jan (Tue, on/after the origin)" "ef-time-after-epiphany-1-tuesday" (slug_of (d 2026 1 13)) -(* The general property behind the fix above: no two dates in one liturgical - year may share a slug, except the deliberate resumed-Sunday reuse (see - test_resumed_sundays). Random years across the whole domain, not just - 2026 -- the original bug (controller finding A) was found by grepping one - year's CLI output for duplicates, and other years could hide others. *) -let is_resumable_sunday_slug s = - let prefix = "ef-time-after-epiphany-sunday-" in - String.length s > String.length prefix && String.sub s 0 (String.length prefix) = prefix - -let prop_slugs_unique_within_liturgical_year = - QCheck.Test.make ~count:200 - ~name:"no two dates in one liturgical year share a slug, apart from the resumed-Sunday reuse" - (QCheck.int_range 1583 9998) +(* The general property behind the fix above -- no two dates in one + liturgical year may share a slug -- moved to + [Colitur_kernel.Validate]'s own ["slugs"] check (Plan 2 carried item 4), + asserted outright with no resumed-Sunday exemption: Plan 2 verified zero + duplicate slugs domain-wide, so the exemption this property used to carry + protected nothing real. [Validate]'s own 200-sample property + (test_validate.ml's [prop_invariants]) now covers every consumer, + including this rite, over the same 1583..9998 domain this property used + to sweep alone. *) + +(* ---- Plan 2 carried item 5: the anchors list has no guard against its own + erosion ---- + + [Colitur_kernel.Validate] cannot own this completeness check: which of + [named]'s entries are Easter-derived is knowledge only [named] itself + has. [Rite.t] deliberately exposes just [temporal] (the merged result) + and [anchors] (the independent restatement), never [named] -- so a + rite-agnostic [Validate] has no ground truth to compare [anchors] + against, short of inventing one. Two ways of inventing one were + considered and rejected: + + - Hardcoding a specific Easter offset (Ash Wednesday = Easter-46, say) + inside [Validate] would smuggle Western/Gregorian-Paschal-cycle + knowledge into code the design intends to also serve a future + Julian-reckoning rite (Byzantine, named explicitly as a future module + in this project's own architecture note) -- for which neither that + offset, nor even Gregorian Easter itself as the reference point + ([Computus.gregorian_easter], not [julian_easter]), is the right one. + Even [Computus]'s own [ash_wednesday]/[palm_sunday]/[ascension]/ + [pentecost] helpers are documented "(OF + EF)" -- i.e. already scoped + to the two WESTERN forms, not to "any rite" the way [Validate] must + stay. + - Rediscovering "Easter-derived" structurally from [temporal] alone (scan + near Easter, keep whatever recurs at the same offset across years with + different Easters) is unsound for EF specifically: [Time_after_epiphany] + onward, week numbering itself is computed from Easter-relative origins + ([week_origin]), so almost every ORDINARY Sunday/feria slug in + Septuagesima/Lent/Passiontide/Paschaltide/Time_after_pentecost is ALSO + constant-offset-from-Easter across years -- structurally + indistinguishable from a genuinely named day by that test alone. Rank + does not separate them either: RG 91 entry 10 makes the privileged + Easter/Pentecost octave FERIAS class 1 too, same as many named days. + + This guard is therefore entirely EF-specific and lives here, against + [T.named] and [T.anchors] directly -- both accessible in this file, not + through the [Rite.t] boundary. *) + +(* "Easter-derived" is discovered mechanically from [named] itself, not + hand-copied from either [named]'s or [anchors]'s own source: scan a + window of dates around a year's Easter and keep whatever [named] answers + [Some] for. [named] returns [Some] only for its ~20 genuinely proper/named + days -- ordinary Sundays and ferias are produced by other functions + entirely, in [temporal]'s [None] branch -- so this cannot pick up an + ordinary week's slug by accident regardless of window width. [-60, +75] + safely isolates the Easter-relative half of [named] from its + fixed-calendar half: exhaustively checked over 1583..2500, the nearest + fixed named date to Easter (6 January, Epiphany) is never less than 75 + days before the EARLIEST possible Easter (22 March), so a 60-day backward + reach cannot cross into it even in the closest year, while the window + still comfortably covers [named]'s actual Easter-relative range (Ash + Wednesday at Easter-46 the earliest, Sacred Heart at Easter+68 the + latest). *) +let easter_relative_named_slugs y = + let easter = Colitur_kernel.Computus.gregorian_easter y in + List.filter_map + (fun n -> match T.named (D.add_days easter n) with Some (_, slug, _, _) -> Some slug | None -> None) + (List.init 136 (fun i -> i - 60)) + |> List.sort_uniq compare + +let anchor_slugs y = List.map fst (T.anchors y) |> List.sort_uniq compare + +(* The mechanism both tests below share: which of [named]'s Easter-derived + slugs [anchors] fails to restate. [] means complete. *) +let missing_from_anchors ~named_easter_slugs ~anchors = + List.filter (fun slug -> not (List.mem slug anchors)) named_easter_slugs + +(* The real guard: for the domain's own Easter extremes (1598 earliest, 1666 + latest -- see test_validate.ml's own [extreme_years], corrected by this + same task) plus an ordinary year, nothing [named] produces at an + Easter-relative offset is missing from [anchors]. *) +let test_anchors_cover_easter_derived_named_days () = + List.iter (fun y -> - let start = T.year_start y in - let stop = D.add_days (T.year_start (y + 1)) (-1) in - let n = D.to_rata stop - D.to_rata start + 1 in - let seen = Hashtbl.create 512 in - let rec check i = - i >= n - || - let s = slug_of (D.add_days start i) in - (is_resumable_sunday_slug s - || (not (Hashtbl.mem seen s)) - && ( - Hashtbl.replace seen s (); - true)) - && check (i + 1) + let missing = + missing_from_anchors ~named_easter_slugs:(easter_relative_named_slugs y) ~anchors:(anchor_slugs y) in - check 0) + Alcotest.(check (list string)) + (Printf.sprintf "%d: every Easter-derived named slug is restated in anchors" y) + [] missing) + [ 1598; 1666; 2026 ] + +(* Proves the guard above actually has teeth, per this task's negative-fixture + requirement: [T.anchors]'s real slug set with one genuinely Easter-derived + entry ("ef-ascension") struck out must fail [missing_from_anchors] the same + way the real list passes it -- reproducing, in miniature, exactly what + "deleting four entries leaves the whole suite green" (Plan 2, carried item + 5) looked like before this test existed. *) +let test_anchors_erosion_is_caught () = + let y = 2026 in + let named_easter_slugs = easter_relative_named_slugs y in + Alcotest.(check bool) "sanity: ef-ascension is genuinely in the Easter-derived set" true + (List.mem "ef-ascension" named_easter_slugs); + let eroded_anchors = List.filter (fun s -> s <> "ef-ascension") (anchor_slugs y) in + Alcotest.(check (list string)) "the erosion is caught: the missing entry is reported, and only it" + [ "ef-ascension" ] + (missing_from_anchors ~named_easter_slugs ~anchors:eroded_anchors) let test_totality () = (* Every day of 2026 yields an office without raising. Not a slug @@ -367,12 +443,14 @@ let suite_extra = Alcotest.test_case "colours" `Quick test_colours; Alcotest.test_case "christmastide feria slugs" `Quick test_christmastide_feria_slugs; Alcotest.test_case "named days carry their week" `Quick test_named_days_carry_their_week; - Alcotest.test_case "totality" `Quick test_totality ] + Alcotest.test_case "totality" `Quick test_totality; + Alcotest.test_case "anchors cover easter-derived named days" `Quick + test_anchors_cover_easter_derived_named_days; + Alcotest.test_case "anchors erosion is caught" `Quick test_anchors_erosion_is_caught ] let suite = ( "Rite_ef", [ Alcotest.test_case "vocab roundtrips" `Quick test_vocab_roundtrips; Alcotest.test_case "slug words" `Quick test_slug_words ] @ suite_extra - @ List.map QCheck_alcotest.to_alcotest - [ prop_temporal_week_matches_week; prop_slugs_unique_within_liturgical_year ] ) + @ List.map QCheck_alcotest.to_alcotest [ prop_temporal_week_matches_week ] ) diff --git a/test/test_validate.ml b/test/test_validate.ml index b2d4f34..4b9c3c0 100644 --- a/test/test_validate.ml +++ b/test/test_validate.ml @@ -77,9 +77,10 @@ let extreme_years () = let test_easter_extremes () = let ys = extreme_years () in - (* Both extremes genuinely occur in 1583..2500 (earliest 1818, latest - 2038); requiring just "non-empty" would have passed even if the search - silently found only one of them (register finding 15). *) + (* Both extremes genuinely occur in 1583..2500 (earliest 1598, latest + 1666 -- verified against Computus.gregorian_easter directly, not + transcribed); requiring just "non-empty" would have passed even if the + search silently found only one of them (register finding 15). *) Alcotest.(check int) "found both extreme years (earliest 22 Mar and latest 25 Apr)" 2 (List.length ys); List.iter check_year ys @@ -539,6 +540,22 @@ let test_vocab_season_injectivity_fires () = Alcotest.(check bool) "vocab check fires when season_to_string collapses two seasons to one string" true (has_check "vocab" (run ~vocab:vocab_collapsed_seasons good)) +(* Plan 2 carried item 4: slug uniqueness moves into [Validate] itself, no + exemption. [target] (17 March, mid-run) is given the NEXT day's real slug + verbatim -- a genuine collision between two distinct dates in the same + walked year, touching only the [slug] field so every other check (season, + week, weekday, rank, colour, determinism, anchor) stays silent against it. *) +let test_slugs_fires () = + let colliding_slug = (good (D.add_days target 1)).Temporal.office.Cel.slug in + let temporal d = + let t = good d in + if D.compare d target = 0 then + { t with Temporal.office = { t.Temporal.office with Cel.slug = colliding_slug } } + else t + in + Alcotest.(check bool) "slugs check fires when two dates in the year share a slug" true + (has_check "slugs" (run temporal)) + (* ---- Task 12: resolution invariants ---- Each test below asserts that exactly one of the five new check labels @@ -604,6 +621,7 @@ let suite = Alcotest.test_case "anchor fires" `Quick test_anchor_fires; Alcotest.test_case "vocab rank injectivity fires" `Quick test_vocab_rank_injectivity_fires; Alcotest.test_case "vocab season injectivity fires" `Quick test_vocab_season_injectivity_fires; + Alcotest.test_case "slugs fires" `Quick test_slugs_fires; Alcotest.test_case "lost fires on resolution exception" `Quick test_lost_fires_on_resolution_exception; Alcotest.test_case "duplicated fires" `Quick test_duplicated_fires; Alcotest.test_case "unconverged fires" `Quick test_unconverged_fires; -- cgit v1.3 From 079e332e0a797105588787f7e5fdabd95ba1fa12 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 12 Aug 2026 04:12:41 +0200 Subject: kernel(precedence): three RG-verified EF precedence bugs, found via oracle Task 16's missalemeum oracle comparison (2026-2027) surfaced three distinct precedence-engine bugs, each confirmed against the primary 1962 Missale Romanum text and cross-checked against the oracle: 1. RG 33 (vigil omission) was transcribed backwards. The primary text reads "Vigilia II AUT III classis penitus omittitur" (a II OR III class vigil is entirely omitted on any Sunday or I-class feast) -- not "I aut II" as the register and this module's own rank check (Class1 || Class2) previously had it. I-class vigils (Nativity, Pentecost) can never actually lose in this engine (band always ranks them above anything that could coincide with their dates), so the Class1 half was dead code; the real bug was that Class3 (St Lawrence's vigil, the sole III-class vigil) was MISSING, so it fell through to an ordinary commemoration instead of RG 33's mandatory omission whenever 9 August landed on a Sunday. 2. RG 93/95/109/113 read together: an ordinary, non-privileged TEMPORAL-cycle office (a bog-standard green-season feria, a plain Advent/Lent Ember day, a Minor Rogation day) has no standing to be commemorated at all when impeded -- RG 109's six-item list is a CLOSED set of the only temporal circumstances that generate a commemoration, not a floor under which anything ordinary still gets one. The engine previously commemorated the losing feria itself in this situation; confirmed wrong against ~190 independent missalemeum days (2026-2027) showing zero commemorations for the exact shape. Vigils are explicitly excluded from this new rule -- RG 31/32 give them their own "if impeded, commemorated" mandate, independent of RG 109's list. 3. RG 111(b)'s Sunday admission slot is restricted to "de festo II classis" -- a rank restriction, not merely the best available ordinary candidate. A III/IV-class ordinary saint competing for a II-class Sunday's single commemoration slot had no such restriction applied before; confirmed wrong via St Hyginus (11 Jan, Class3) losing to Holy Family, which missalemeum shows entirely displaced, never commemorated. All three fixes are pure disposition/admission changes -- they never touch band, so the observed day (season/slug/rank/colour) is unaffected in every case; the lectio differential (which never compares commemorations) stays green untouched. test_precedence_ef.ml updated throughout: two previously-wrong test expectations corrected (the RG33 III-class-vigil boundary row, the IV-class-feria totality row), three privilege boundary rows sharpened from "commemorated but unprivileged" to "omitted entirely" now that temporal+ordinary means omission, and a new contrast row added to keep the SANCTORAL side of rule 2 covered separately from the TEMPORAL side. --- lib/rites/rite_ef/precedence_ef.ml | 215 +++++++++++++++++++++++++++++++------ test/test_precedence_ef.ml | 93 +++++++++++++--- 2 files changed, 256 insertions(+), 52 deletions(-) (limited to 'lib') diff --git a/lib/rites/rite_ef/precedence_ef.ml b/lib/rites/rite_ef/precedence_ef.ml index 0feb3e0..fd83383 100644 --- a/lib/rites/rite_ef/precedence_ef.ml +++ b/lib/rites/rite_ef/precedence_ef.ml @@ -244,15 +244,60 @@ let band (ctx : Vocab_ef.season Precedence.context) (c : Vocab_ef.rank Precedenc 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--sunday-" 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. *) +(* RG 33 -- CORRECTED 2026-08-12 (Task 16, primary-source-verified against + docs/research/1962-06-23,_SS_Ioannes_XXIII,_Missale_Romanum,_LT.pdf, the + General Rubrics' own Chapter XI "De Vigiliis"). The register previously + transcribed this as "a I/II-class vigil is entirely omitted"; the + PRIMARY TEXT reads the other way round: + + "33. Vigilia II aut III classis penitus omittitur, si occurrat in + dominica quavis, aut in festo I classis, vel si festum cui + præmittitur in alium diem transferri aut ad commemorationem reduci + contingat." + + -- "A vigil of the II OR III class is entirely omitted, if it occurs on + ANY Sunday whatsoever, or on a feast of the I class, or if the feast it + precedes happens to be transferred to another day or reduced to a + commemoration." I-class vigils (Nativity, Pentecost, RG 30) are outside + this rule entirely -- RG 30's own text says they "festis quibuslibet + præferunt, et nullam admittunt commemorationem" (are preferred to ANY + feast whatsoever, and admit no commemoration at all), i.e. they can never + lose in the first place: {!band} entries 1/5/9 already rank Nativity Eve + and the Pentecost Vigil above every Sunday and every other I-class row + that could coincide with their fixed/Easter-relative dates (verified: no + date collision is even representable), so no I-class vigil can ever reach + this function as a [loser] -- the branch below never needs to test for + [Class1] and, before this fix, its stray inclusion of [Class1] here was + simply dead code, not a second bug (see the task report for the + argument). The bug was the OTHER half: [Class3] (the sole III-class + vigil, St Lawrence, RG 32) was MISSING from this branch, so it fell + through to the generic "commemorated or omitted" branch below instead of + RG 33's mandatory omission -- confirmed wrong for real data: 9 August + 2026 is a Sunday, and before this fix "vigil-of-st-lawrence" competed for + (and could in principle win) that Sunday's single commemoration slot, + when RG 33 says it must not even be a candidate. The oracle comparison + (missalemeum, Task 16) independently confirms: 9 Aug 2026 shows no trace + of the vigil surviving as a commemoration. + + The third omission trigger in RG 33's own text -- "or if the feast it + precedes is transferred to another day or reduced to a commemoration" -- + is NOT implemented: no II/III-class vigil's own feast (Ascension, + Assumption, John Baptist, Sts Peter & Paul, Lawrence) is ever + transferred or reduced to a commemoration anywhere in this codebase's + current data (all fixed I-class, none coincide with anything of equal or + higher rank within any year this project has sampled), so no witness + exists to build or test this clause against; flagged in the register + (§6) rather than guessed. *) +let is_omissible_vigil (rank : Vocab_ef.rank) = rank = Vocab_ef.Class2 || rank = Vocab_ef.Class3 + +(* Every Sunday slug this rite's temporal cycle produces -- named + (temporal_ef.ml's [named], e.g. "ef-easter-sunday") or the generic + "ef--sunday-" 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 = @@ -372,6 +417,7 @@ 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 + let is_temporal = loser.Precedence.origin = Precedence.Temporal 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 @@ -384,13 +430,17 @@ let disposition ~(winner : Vocab_ef.rank Precedence.candidate) it would to any other candidate. *) Precedence.Commemorate (privilege_of loser) else if - (cel.Celebration.rank = Class1 || cel.Celebration.rank = Class2) + is_omissible_vigil cel.Celebration.rank && 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. *) + (* RG 33, corrected (see {!is_omissible_vigil}'s own comment): II- or + III-class vigils only -- a real I-class vigil can never reach this + function as a loser at all (see that comment), so this branch would + never have fired for [Class1] even before the fix; what changed is + that [Class3] (St Lawrence) now correctly reaches RG 33's omission + instead of falling through to the generic "commemorated or omitted" + branch below. *) Precedence.Omit else if cel.Celebration.rank = Class1 @@ -416,19 +466,93 @@ let disposition ~(winner : Vocab_ef.rank Precedence.candidate) Rite.transfer_target's job, not this function's -- disposition only says THAT it moves. *) Precedence.Transfer + else if + is_temporal + && (not (is_vigil (Slug.to_string cel.Celebration.slug))) + && (match privilege_of loser with Precedence.Ordinary -> true | Precedence.Privileged -> false) + then + (* Task 16, primary-source-verified (RG 93, 95, 109, 113): an ordinary, + NON-privileged TEMPORAL-cycle office has no standing to be + commemorated at all when impeded -- it is simply omitted, not the + "commemorated or omitted, per rubric" residual RG 95 leaves open for + everything else. Three primary texts read together settle this: + + - RG 95: "Alia festa, ab Officio gradus superioris accidentaliter + impedita, AUT COMMEMORANTUR AUT, eo anno, PENITUS OMITTUNTUR, IUXTA + RUBRICAS" -- impeded offices are "either commemorated or, that + year, entirely omitted, ACCORDING TO THE RUBRICS" -- i.e. some + OTHER rule decides which fate applies; RG 95 itself does not grant + a commemoration to everything impeded. + - RG 109 gives that other rule for the temporal cycle: an EXHAUSTIVE, + closed six-item list of the only temporal-origin circumstances that + ever generate a commemoration -- (a) of a Sunday; (b) of a I-class + day; (c) of days within the Nativity Octave; (d) of the September + Ember days; (e) of Advent/Lent/Passiontide ferias; (f) of the Major + Rogations. [privilege_of] above already implements exactly this + list (its own six branches, each cited to its own RG 109 letter); + its terminal "[else Precedence.Ordinary]" is what a TEMPORAL-origin + candidate falls through to when it matches NONE of (a)-(f) -- an + ordinary green-season feria of Time after Epiphany/Pentecost/ + Easter, a plain (non-Ember) Advent/Lent weekday already caught by + (e), or a Minor Rogation day (RG 87 -- deliberately NOT named by + RG 109(f), see [privilege_of]'s own comment on that letter). + - RG 113: "Commemoratio de Tempore fit primo loco" -- the + commemoration OF THE TEMPORAL DAY is made FIRST [in the list, when + one is due] -- presupposes RG 109 already answered whether one is + due; it does not itself create a right for every impeded feria. + + So testing [privilege_of loser = Ordinary] here, for a TEMPORAL-origin + loser specifically, is not a second, parallel "is this commemorable" + predicate that could drift from RG 109's own list -- it IS RG 109's + list, already computed by [privilege_of] for the commemoration this + branch is about to deny. SANCTORAL losers are entirely unaffected + (the [is_temporal] guard): RG 111(c)/(d) admit an "ordinary" + commemoration of a losing SAINT freely, with no such closed-list + gate -- this omission is specific to the temporal cycle's own + ferial/Sunday-tail offices, never to a saint. + + Empirically confirmed against the missalemeum oracle (Task 16, + 2026-2027, both years): every one of ~190 days where a saint's feast + impedes an ordinary (non-privileged) temporal feria shows ZERO + commemorations in the oracle, including the exact shape this fixes + (e.g. "St. Marcellus I" impeding the plain "Friday after Epiphany", + 6/730 identical instances of the pattern per week of ordinary time) + -- and the SAME fix, for the same reason, independently corrects the + Minor Rogation days (RG 87) losing to a saint (9/730 days), which + [privilege_of]'s own (f) comment already flags as NOT RG 109(f). + + [is_vigil] is EXCLUDED from this branch deliberately: a II/III-class + vigil is temporal-origin too (when it is the Ascension/Pentecost- + adjacent case {!of_temporal} produces) and [privilege_of] rightly + calls it [Ordinary] (a vigil is none of RG 109(a)-(f)), but vigils + are NOT governed by RG 109 at all -- they carry their OWN, separate, + explicit commemoration mandate: RG 31 (II class) "Hae vigiliae + praeferuntur diebus liturgicis III et IV classis; ET, SI + IMPEDIUNTUR, COMMEMORANTUR, iuxta rubricas" and RG 32 (III class, St + Lawrence) "si impeditur, COMMEMORATUR, iuxta rubricas" -- "if + impeded, ARE/IS commemorated". So a vigil impeded WITHOUT triggering + RG 33's full omission (the [is_omissible_vigil] branch above, e.g. + impeded by an ordinary sanctoral feast that is neither a Sunday nor + I class) must still fall through to the final [Commemorate] branch + below, exactly like a sanctoral loser -- RG 31/32's own text, not + RG 109's closed list, is what governs it. *) + Precedence.Omit 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]. + commemorated or wholly omitted. Reached by every SANCTORAL loser + below I class (RG 111(c)/(d)'s "ordinary" commemoration, no closed + list the way the temporal branch above has), AND by an impeded + I-class Sunday (excluded from the [Transfer] branch above, and from + the temporal-Ordinary [Omit] branch above because [privilege_of]'s + (a) makes a Sunday loser [Privileged], never [Ordinary]): 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 @@ -512,19 +636,40 @@ let admit ~(observed : Vocab_ef.rank Precedence.candidate) 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). *) + (* RG 111(b), primary text: "in dominicis II classis, una tantum + admittitur commemoratio, SCILICET DE FESTO II CLASSIS, quæ tamen + omittitur si commemoratio privilegiata facienda sit" -- "on Sundays + of the II class, only ONE commemoration is admitted, NAMELY OF A + FEAST OF THE II CLASS, which however is 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, + 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. + + Fix, Task 16 (primary-source-verified + missalemeum-confirmed): + previously this fell back to "the best of [sorted], whatever its + rank" once no privileged candidate was due, silently admitting a + III/IV-class ordinary saint that RG 111(b)'s own wording excludes. + Confirmed wrong for real data by the oracle comparison: e.g. 11 Jan + 2026 (Holy Family, a II-class Sunday) has St Hyginus (Class3, + commemoration-only) as its only competing candidate -- missalemeum + shows him "displaced" (omitted), never commemorated; the + pre-fix code admitted him regardless. *) (match List.filter is_privileged sorted with | best :: _ -> [ best ] - | [] -> ( match sorted with [] -> [] | best :: _ -> [ best ] )) + | [] -> ( + match List.filter (fun (c, _) -> c.Precedence.cel.Celebration.rank = Class2) 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 diff --git a/test/test_precedence_ef.ml b/test/test_precedence_ef.ml index aa98686..2f08864 100644 --- a/test/test_precedence_ef.ml +++ b/test/test_precedence_ef.ml @@ -375,17 +375,34 @@ let disposition_cases = of_temporal (off 38), "Omit" ); (* RG 33's own boundary, proved from both sides so the rule is shown to - gate on the WINNER too, not "any vigil is always omitted": *) + gate on the WINNER too, not "any vigil is always omitted": winner is + neither a Sunday nor I class, so RG 33's omission does not fire; the + vigil is temporal-origin ({!of_temporal}, the real Ascension Vigil) + and would otherwise land in Task 16's new "ordinary temporal loser -> + Omit" branch too (see the IV-class-feria row further down) -- this + row is what proves that branch's own [not (is_vigil ...)] guard: a + vigil, per RG 31's own text ("si impediuntur, commemorantur"), is + ALWAYS commemorated once RG 33 does not omit it outright, regardless + of RG 109's closed list. *) ( "RG33 boundary: vigil loses to an ordinary (non-Sunday, non-I-class) \ - II-class day -> Commemorate, NOT Omit", + II-class day -> Commemorate, NOT Omit (RG31's own vigil mandate)", cand ~origin:P.Sanctoral ~rank:V.Class2 ~layer:PE.universal_layer "ef-some-other-feast", of_temporal (off 38), "Commemorate(Ordinary)" ); - ( "RG33 boundary: a III-class vigil (outside RG33's I/II-class scope) \ - loses to a Sunday -> Commemorate, NOT Omit", + (* CORRECTED 2026-08-12 (Task 16, primary-source-verified): the register + previously (mis-)transcribed RG 33 as covering only I/II-class + vigils, so this row's own title used to read "outside RG33's + I/II-class scope" and expect Commemorate. The primary text ("Vigilia + II AUT III classis penitus omittitur...") covers II OR III class -- + St Lawrence's vigil (III class, RG 32) falling on ANY Sunday ("in + dominica quavis") is entirely omitted, exactly like a II-class vigil. + See {!PE.is_omissible_vigil}'s own comment for the full primary text + and the register correction. *) + ( "RG33 (corrected): a III-class vigil loses to a Sunday -> Omit, not \ + Commemorate", an_ordinary_sunday, cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "ef-lawrence-vigil", - "Commemorate(Ordinary)" ); + "Omit" ); (* Task 11, issue (a): [disposition]'s own [is_vigil] check (the RG 33 omission test) is a SEPARATE call site from [band]'s -- both read the same private [is_vigil], but each needed its own witness, since a fix @@ -424,16 +441,45 @@ let disposition_cases = cand ~origin:P.Sanctoral ~status:Cel.Commemoration_only ~layer:PE.universal_layer "ef-suppressed-vigil", "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. *) + (* Totality (SANCTORAL side): the lower ranks the RG 33/RG 95/Task-16 + branches never touch still reach the RG 95 "commemorated or omitted" + branch's [Commemorate] side, not an unhandled/exceptional case -- RG + 111(c)/(d) admit an "ordinary" SAINT commemoration freely, with none + of RG 109's closed-list restriction the temporal branch below has. *) ( "III-class feast loses to a I-class day -> Commemorate", cand "ef-nativity", cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "ef-some-saint-3", "Commemorate(Ordinary)" ); - ( "IV-class feria loses to a II-class Sunday -> Commemorate", + (* Task 16 (primary-source-verified: RG 95 + RG 109's closed list + RG + 113 -- see this branch's own comment in precedence_ef.ml for the full + three-text argument): an ORDINARY, non-privileged TEMPORAL-cycle + loser -- a bog-standard green-season feria of Time after Pentecost, + none of RG 109(a)-(f) -- has NO standing to be commemorated at all + when impeded; it is entirely omitted, not the "ordinary" + commemoration a losing SAINT would get (contrast the SANCTORAL row + immediately above, same rank, same kind of winner, opposite + [Commemorate]/[Omit] outcome -- the discriminating factor is + [origin], nothing else). Before this fix the engine wrongly + commemorated the losing feria itself here; confirmed wrong against + the missalemeum oracle (Task 16 report): every one of ~190 + structurally identical days (an ordinary sanctoral feast impeding an + ordinary temporal feria, 2026-2027) shows zero commemorations in an + independent published EF calendar. *) + ( "TASK16: an ORDINARY temporal feria loses to a II-class Sunday -> \ + Omit, not Commemorate (RG109's closed list; contrast the sanctoral \ + row above)", an_ordinary_sunday, cand ~rank:V.Class4 "ef-time-after-pentecost-1-sat", + "Omit" ); + (* Totality's other half: a SANCTORAL loser of the exact same rank as + the row above still reaches [Commemorate], proving the branch above + is gated on [origin] and not merely on rank -- without this row nothing + here would distinguish "temporal losers are omitted" from "IV-class + losers are omitted", which would be a much bigger (and wrong) claim. *) + ( "TASK16 contrast: a SANCTORAL IV-class loser still reaches \ + Commemorate(Ordinary)", + an_ordinary_sunday, + cand ~origin:P.Sanctoral ~rank:V.Class4 ~layer:PE.universal_layer "ef-some-minor-saint", "Commemorate(Ordinary)" ) ] @@ -506,29 +552,42 @@ let privilege_cases = 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. *) + [Privileged] -- the exact trap this pair of rows guards against. + + CHANGED, Task 16: these used to expect [Commemorate(Ordinary)] -- + "not privileged" originally meant "commemorated, but without RG 109's + higher liturgical honours". Now that a TEMPORAL-origin [Ordinary] + loser is Task 16's own [Omit] branch (see precedence_ef.ml), "not + privileged" for a temporal candidate means "not commemorable at all" + -- a sharper, more direct assertion of the same underlying + [privilege_of] classification, via the one vantage point available + on that private function. *) ( "boundary: an Advent Ember day is NOT privileged (only September is, \ - RG109(d))", + RG109(d)) -- and being temporal+ordinary, TASK16 omits it entirely", cand "ef-nativity", of_temporal (mk 2026 12 16), - "Commemorate(Ordinary)" ); + "Omit" ); ( "boundary: a Lent Ember day is NOT privileged (only September is, \ - RG109(d))", + RG109(d)) -- and being temporal+ordinary, TASK16 omits it entirely", cand "ef-nativity", of_temporal (off (-39)), - "Commemorate(Ordinary)" ); + "Omit" ); (* 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. *) + privileged either -- and (Task 16) being temporal+ordinary, a Minor + Rogation day impeded by a saint is now omitted outright, matching the + missalemeum oracle exactly (Task 16 report: 11 May 2026 and 12 May + 2026, both Minor Rogation days impeded by a saint, show zero + commemoration of the Rogation in the independent oracle). *) ( "boundary: a Minor Rogation day is NOT privileged (RG109(f) names \ - the Major Litanies, not these)", + the Major Litanies, not these) -- TASK16 omits it entirely", cand "ef-nativity", of_temporal (off 36), - "Commemorate(Ordinary)" ) + "Omit" ) ] (* Task 9: [PE.admit] -- RG 111's admission counts (register line 378), -- cgit v1.3 From c464c0435c650cf019eb6c6ae1906217d557a15f Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 12 Aug 2026 04:12:53 +0200 Subject: kernel(temporal): Holy Thursday is white, per RG128(b)'s named exception MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit RG 128(b) excepts "Missa sive Chrismatis sive in Cena Domini feria V Hebdomadae sanctae" from the Septuagesima-to-Easter-Vigil violet span as a whole-Mass exception (unlike Palm Sunday's blessing/procession, which the same sentence carves out as only part of that day) -- so Holy Thursday's Mass is white, not violet. temporal_ef.ml fell through to the generic Passiontide ferial path (season_colour Passiontide = violet) for this date, since [named] has no entry for the Triduum at all (rank was already correct via [privileged_feria]; only colour was wrong). Found via Task 16's missalemeum oracle comparison: every other Triduum day's oracle colour set includes violet as an option (Good Friday "bv", Holy Saturday "vw" -- already-flagged, deliberately deferred per-action gaps, register §3b), but Holy Thursday's is white alone. This is a genuine NEW divergence from lectio too (lectio has no such exception and still prints violet for Holy Thursday) -- added as Layer C11 to the differential harness and data/ef/expected-divergences .sexp, 46 rows (2005-2050), rather than silently changing what that harness accepts. Also corrected a stale comment on season_colour claiming white's RG paragraph was never pinned -- RG 119 was found and cited in the register on 2026-08-11 but the correction was never copied into this file's own comment. --- data/ef/expected-divergences.sexp | 5 +++++ lib/rites/rite_ef/temporal_ef.ml | 33 ++++++++++++++++++++++++++++----- test/test_differential.ml | 16 +++++++++------- 3 files changed, 42 insertions(+), 12 deletions(-) (limited to 'lib') diff --git a/data/ef/expected-divergences.sexp b/data/ef/expected-divergences.sexp index 17bafc1..6b7bbdd 100644 --- a/data/ef/expected-divergences.sexp +++ b/data/ef/expected-divergences.sexp @@ -67,3 +67,8 @@ (verdict colitur) (note "2011: Sacred Heart (Friday after the Corpus Christi octave) falls on 1 July and impedes the Precious Blood (also 1 July, I class but a lower RG 91 entry). RG 96's walk must skip 2 July (Visitation, II class) and 3 July (Sunday), landing on 4 July (Monday, a free class-4 feria). lectio instead lands Precious Blood on 2 July, illegitimately displacing the Visitation -- exactly what RG 96's \"not I or II class\" clause forbids.") (expected_rows 2)) + ((id C11) + (citation "RG 128(b), primary-source-verified 2026-08-12 (Task 16): \"...a dominica in Septuagesima usque ad Vigiliam paschalem, exceptis: ... Missa sive Chrismatis sive in Cena Domini feria V Hebdomadae sanctae; ...\" -- violet runs Septuagesima to the Easter Vigil EXCEPT (among other things) the Mass of Holy Thursday, named as a whole-Mass exception") + (verdict colitur) + (note "Holy Thursday (\"ef-passiontide-2-thursday\") is white in colitur, per RG 128(b)'s explicit exception -- independently confirmed by the missalemeum oracle (Task 16 report), whose colour set for that day is white alone, unlike the surrounding Triduum days which include violet as an option. lectio has no such exception and prints Passiontide's base violet straight through Holy Thursday. Found via Task 16's oracle comparison, not the original lectio differential (lectio's own colour did not previously disagree, because colitur's own bug matched it) -- fixed in colitur, so this row records a NEW divergence from lectio's still-uncorrected violet, not a pre-existing one.") + (expected_rows 46)) diff --git a/lib/rites/rite_ef/temporal_ef.ml b/lib/rites/rite_ef/temporal_ef.ml index 52a9adb..b39da79 100644 --- a/lib/rites/rite_ef/temporal_ef.ml +++ b/lib/rites/rite_ef/temporal_ef.ml @@ -314,13 +314,15 @@ let privileged_feria d = (n >= -6 && n <= -1) || (n >= 1 && n <= 6) || (n >= 50 && n <= 55) (* RG 117 enumerates the five colours (white, red, green, violet, black); - RG 127 assigns green and RG 128 violet to the seasons de Tempore below. - White's own specific paragraph (the "B) De colore albo" section, between - 117 and 123) was not pinned by the primary-source search available here -- - left uncited rather than guessed; see register §3 "Colours". *) + RG 127 assigns green and RG 128 violet to the seasons de Tempore below. RG + 119 (register §3b, primary-source-verified 2026-08-11 -- this comment was + stale until Task 16 noticed the correction had not been copied down here): + white "a festo Nativitatis Domini usque ad expletum tempus Epiphaniae" + and "a Missa Vigiliae paschalis usque ad Missam vigiliae Pentecostis + exclusive" -- exactly Christmastide and Paschaltide below. *) let season_colour = function | Advent | Septuagesima | Lent | Passiontide -> Colour.Violet (* RG 128 *) - | Christmastide | Paschaltide -> Colour.White + | Christmastide | Paschaltide -> Colour.White (* RG 119 *) | Time_after_epiphany | Time_after_pentecost -> Colour.Green (* RG 127 *) (* Gaudete (Advent III) and Laetare (Lent IV) are rose: RG 131, "may be used... @@ -411,6 +413,27 @@ let temporal d = let colour = (* The Pentecost octave weekdays are red, not Paschaltide's white. *) if days_between easter d >= 50 && days_between easter d <= 55 then Colour.Red + (* RG 128(b) (docs/research/rules-register.md §3b), primary + text: "...a dominica in Septuagesima usque ad Vigiliam + paschalem, EXCEPTIS: ... MISSA SIVE CHRISMATIS SIVE IN + CENA DOMINI FERIA V HEBDOMADAE SANCTAE; ..." -- violet + runs Septuagesima to the Easter Vigil EXCEPT (among + others) "the Mass, whether of the Chrism or in Cena + Domini [Holy Thursday], on Thursday of Holy Week" -- + named as a WHOLE-MASS exception (unlike Palm Sunday's + "blessing and procession of palms", which the SAME + sentence carves out as only PART of that day, register + §3b's own RG126 note on the not-yet-modelled per-action + nuance), so this is a clean whole-day colour fact, not + a per-action one the day/colour model cannot express. + Task 16, found via the missalemeum oracle comparison: + every other Triduum day's oracle colour SET includes + violet as one option (Good Friday "bv", Holy Saturday + "vw" -- RG 132's black is a separate, ALREADY-flagged + gap, register §3b, not touched here), but Holy + Thursday's is white ALONE -- confirming this specific + day, and only this one, needs the exception coded. *) + else if days_between easter d = -3 then Colour.White else season_colour s in let week_n = week d in diff --git a/test/test_differential.ml b/test/test_differential.ml index dd601a1..a9bdb91 100644 --- a/test/test_differential.ml +++ b/test/test_differential.ml @@ -76,13 +76,14 @@ family would still be caught by everything except the digit itself. - Layer C (data/ef/expected-divergences.sexp, matched by - [layer_c_reason] below): the CITED allow-list. Ten genuine liturgical - disagreements, each citing its RG paragraph and stating which engine is - right (always colitur, verified against the Missal/register, never - against lectio's own behaviour -- "lectio does it differently" is not - itself a justification anywhere in this file). This is the ONLY layer - that may cover a difference in rank, colour, or which celebration is - observed; A and B never do (enforced structurally below: A/B only ever + [layer_c_reason] below): the CITED allow-list. Eleven genuine liturgical + disagreements (C11 added by Task 16's oracle work, below), each citing + its RG paragraph and stating which engine is right (always colitur, + verified against the Missal/register, never against lectio's own + behaviour -- "lectio does it differently" is not itself a justification + anywhere in this file). This is the ONLY layer that may cover a + difference in rank, colour, or which celebration is observed; A and B + never do (enforced structurally below: A/B only ever touch the season/slug fields, and Layer C's predicates each require an exact, narrow field-diff SET, not "anything goes"). @@ -448,6 +449,7 @@ let layer_c_reason (l : row) (c : row) diffs = (String.equal l.date "2011-07-02" || String.equal l.date "2011-07-04") && subset diffs [ Slug_f; Rank; Colour_f ] then Some "C10" + else if String.equal c.slug "ef-passiontide-2-thursday" && diffs = [ Colour_f ] then Some "C11" else None (* ---------------------------------------------------------------------- *) -- cgit v1.3 From 0121abf66700879b31ef0b9a13e936b95e123c8f Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 12 Aug 2026 05:25:58 +0200 Subject: kernel(precedence): fix round 1 -- RG23-26 govern ferial commemoration, not RG109 Review round 1 (F1, Critical): the commemoration-eligibility fix from the previous commit silently dropped II-class Advent and Lent Ember ferias when impeded, while ordinary (lower-solemnity) ferias of the same seasons kept their commemoration -- backwards on any reading. Reproduced: 1900-12-21 (an Advent Ember Friday) lost its commemoration entirely; 2026-12-21 (an ordinary Advent feria the same week) kept its. F2 (Important, the direct cause of F1): the branch's own justification mis-stated RG 109 as an exhaustive list of the only temporal circumstances that generate a commemoration. RG 109 is headed "Commemorationes privilegiatae sunt commemorationes" and closes "Omnes aliae commemorationes sunt commemorationes ordinariae" -- it sorts commemorations that already exist into two HONOUR classes (RG 108's differing liturgical hours), and says nothing about which offices have the right to be commemorated at all. That right belongs to Caput IV, "De feriis" (RG 21-27), never opened by the original pass: RG 24 (II-class ferias): "si vero impediuntur, commemorari debent" -- if impeded, MUST be commemorated. Not optional. RG 25 (III-class ferias): same mandate. RG 26: every feria not named in 23-25 is IV class, and IV-class ferias are NEVER commemorated -- the one exclusion RG 21-27 actually states. The omission branch is now gated on `rank = Class4` (RG 26) directly, not on `privilege_of = Ordinary` -- the old gate happened to reach the right answer for IV-class ferias (RG 26 also excludes them, for a reason the old citation did not give) and the wrong one for II/III- class Ember ferias RG 109(e) did not name by letter. RG 109(e) itself is also corrected: its bare "feriis Adventus, Quadragesimae et Passionis" previously excluded the Advent and Lent Ember sub-days by analogy with (d)'s separate September carve-out. RG 91's own TABLE needs an explicit "exceptis feriis Quatuor Temporum" at entries 22 and 25 to keep Ember days from being double- listed against their own entry 18 -- an exception that would be unnecessary drafting if "feriae Adventus"/"feriae Quadragesimae" did not already include their Ember sub-days by default. RG 109(e) carries no such exception, so it is read at that same default, inclusive scope: the Advent and Lent Ember ferias are privileged under (e), not merely ordinary-but-commemorable. (d)'s own existence is unaffected -- September Ember days sit outside Advent/Lent/Passiontide under any reading, so (d) remains necessary regardless. Verified: 1900-12-21 and 1902-02-22 now correctly commemorate their Ember ferias; 2026-12-21 and 1902-02-24 (ordinary ferias) unchanged. Blast radius re-measured against the prior commit, 1900-2100: 102 civil days changed, every one an Advent/Lent Ember (or Ember-vs- Joseph-collision) day regaining its commemoration, nothing else. Validate re-swept exhaustively, 1583-9998: 0 failures. F6: two privilege-boundary test rows that had been bent to expect the bug's own output (Commemorate -> Omit) are restored to what RG 24/25 actually require, now Commemorate(Privileged) given the RG 109(e) correction above -- these are the rows that should have caught F1. F7: admit_cases had no witness for RG 111(b)'s rank floor that wasn't already Class2, so reverting that filter only reddened the oracle suite, never this file. Added a row (II-class Sunday, sole candidate an ordinary Class3) that fails without the filter and passes with it. F9: RG 122 cited alongside RG 128(b) for Holy Thursday's white -- states the same fact affirmatively ("Demum adhibetur color albus, feria V Hebdomadae sanctae...") rather than as an exception to violet. --- lib/rites/rite_ef/precedence_ef.ml | 210 +++++++++++++++++++++++-------------- lib/rites/rite_ef/temporal_ef.ml | 7 ++ test/test_precedence_ef.ml | 96 ++++++++++++----- 3 files changed, 207 insertions(+), 106 deletions(-) (limited to 'lib') diff --git a/lib/rites/rite_ef/precedence_ef.ml b/lib/rites/rite_ef/precedence_ef.ml index fd83383..88f1a54 100644 --- a/lib/rites/rite_ef/precedence_ef.ml +++ b/lib/rites/rite_ef/precedence_ef.ml @@ -380,22 +380,46 @@ let privilege_of (c : Vocab_ef.rank Precedence.candidate) : Precedence.privilege (* (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. *) + (* (d) register line 375-376: "of September Ember days" -- named on its + own because September falls entirely outside (e)'s three seasons + (Advent/Lent/Passiontide) under ANY reading, not because it needs + excluding FROM (e) the way review round 1's F1/F2 finding corrected + the Advent/Lent Ember sets below to no longer need. *) 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 + CORRECTED, fix round 1 (F1/F2): this branch previously excluded the + Advent and Lent Ember sets via [not (is_ember_18 slug)], reading RG + 109(e)'s bare "feriis Adventus, Quadragesimae" as tacitly narrower than + the ordinary ferias of those seasons, on the theory that (d)'s separate + September carve-out implied Ember days needed excluding from (e) too. + That reading does not survive comparing (e)'s text against RG 91's own + TABLE entries for the same seasons (register §4, "Ferias of Lent and + Passiontide... EXCEPTIS feriis Quatuor Temporum" at entry 22; "Ferias + of Advent... EXCEPTIS feriis Quatuor Temporum" at entry 25): the table + needs an explicit "exceptis" to keep Ember days from being double- + listed at both their own entry 18 AND entries 22/25 -- and an explicit + exception is only necessary because, ABSENT one, "feriae Adventus"/ + "feriae Quadragesimae" already DO include their Ember sub-days by + default (an unnecessary exception is not how a rubrical text is + drafted). RG 109(e) carries no such "exceptis" clause, so its bare + "feriis Adventus, Quadragesimae" is read at that same default, + INCLUSIVE scope: the Advent and Lent Ember ferias ARE "ferias of + Advent"/"of Lent" in RG 109(e)'s sense, hence privileged, not merely + ordinary. (d)'s own separate existence is unaffected by this reading + either way -- September Ember days sit in "time after Pentecost", + never within Advent/Lent/Passiontide under any reading, so (d) remains + necessary regardless; it is not evidence for excluding Advent/Lent + Ember from (e), only for including September at all.) Consequently + [is_ember_18] is no longer tested here -- an Advent/Lent Ember slug + matches this branch exactly like an ordinary Advent/Lent feria slug + does, via the same [alp_feria_prefixes] prefix test; only a September + Ember slug is structurally excluded, because "ef-september-ember-*" + never starts with any of [alp_feria_prefixes] ("ef-advent-"/"ef-lent-"/ + "ef-passiontide-") in the first place -- (d) above already privileges + it under its own name. *) + else if is_temporal && 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: @@ -469,73 +493,102 @@ let disposition ~(winner : Vocab_ef.rank Precedence.candidate) else if is_temporal && (not (is_vigil (Slug.to_string cel.Celebration.slug))) - && (match privilege_of loser with Precedence.Ordinary -> true | Precedence.Privileged -> false) + && cel.Celebration.rank = Class4 then - (* Task 16, primary-source-verified (RG 93, 95, 109, 113): an ordinary, - NON-privileged TEMPORAL-cycle office has no standing to be - commemorated at all when impeded -- it is simply omitted, not the - "commemorated or omitted, per rubric" residual RG 95 leaves open for - everything else. Three primary texts read together settle this: - - - RG 95: "Alia festa, ab Officio gradus superioris accidentaliter - impedita, AUT COMMEMORANTUR AUT, eo anno, PENITUS OMITTUNTUR, IUXTA - RUBRICAS" -- impeded offices are "either commemorated or, that - year, entirely omitted, ACCORDING TO THE RUBRICS" -- i.e. some - OTHER rule decides which fate applies; RG 95 itself does not grant - a commemoration to everything impeded. - - RG 109 gives that other rule for the temporal cycle: an EXHAUSTIVE, - closed six-item list of the only temporal-origin circumstances that - ever generate a commemoration -- (a) of a Sunday; (b) of a I-class - day; (c) of days within the Nativity Octave; (d) of the September - Ember days; (e) of Advent/Lent/Passiontide ferias; (f) of the Major - Rogations. [privilege_of] above already implements exactly this - list (its own six branches, each cited to its own RG 109 letter); - its terminal "[else Precedence.Ordinary]" is what a TEMPORAL-origin - candidate falls through to when it matches NONE of (a)-(f) -- an - ordinary green-season feria of Time after Epiphany/Pentecost/ - Easter, a plain (non-Ember) Advent/Lent weekday already caught by - (e), or a Minor Rogation day (RG 87 -- deliberately NOT named by - RG 109(f), see [privilege_of]'s own comment on that letter). - - RG 113: "Commemoratio de Tempore fit primo loco" -- the - commemoration OF THE TEMPORAL DAY is made FIRST [in the list, when - one is due] -- presupposes RG 109 already answered whether one is - due; it does not itself create a right for every impeded feria. - - So testing [privilege_of loser = Ordinary] here, for a TEMPORAL-origin - loser specifically, is not a second, parallel "is this commemorable" - predicate that could drift from RG 109's own list -- it IS RG 109's - list, already computed by [privilege_of] for the commemoration this - branch is about to deny. SANCTORAL losers are entirely unaffected - (the [is_temporal] guard): RG 111(c)/(d) admit an "ordinary" - commemoration of a losing SAINT freely, with no such closed-list - gate -- this omission is specific to the temporal cycle's own - ferial/Sunday-tail offices, never to a saint. + (* CORRECTED, fix round 1 (F1/F2 -- both real, the second the direct + cause of the first): the branch this replaces gated on + [privilege_of loser = Ordinary], justified by treating RG 109 as an + "exhaustive, closed list of the only temporal-origin circumstances + that ever generate a commemoration". That justification does not + survive reading RG 109 itself: it is headed "Commemorationes + PRIVILEGIATAE sunt commemorationes" and closes "Omnes aliae + commemorationes sunt commemorationes ORDINARIAE" -- it sorts + commemorations that ALREADY exist into two HONOUR classes + (privileged vs ordinary, RG 108's differing liturgical hours), and + says nothing about which offices have the RIGHT to be commemorated + in the first place. Testing [privilege_of = Ordinary] as an + ELIGIBILITY gate therefore happened to reach the right answer for + IV-class ferias (they are never commemorated, but for a reason + RG 109 does not state) and the WRONG answer for II- and III-class + ferias impeded during a season RG 109(e) does not privilege by name + (Advent 17-23 Dec's own ordinary-non-Ember ferias were fine, already + matching (e)'s slug prefix; the Advent and Lent EMBER ferias were + not, since the pre-fix (e) excluded them -- see [privilege_of]'s own + fix-round-1 comment above, which independently corrects THAT half + too). Confirmed wrong by direct reproduction (fix-round-1 review): + 1900-12-21 (an Advent Ember Friday, RG 91 entry 18, II class) lost + its own commemoration entirely under the pre-fix code, while an + ORDINARY (non-Ember, lower-solemnity) Advent feria the same week + kept its commemoration -- backwards on any reading. + + The actual rule is Caput IV, "De feriis" (RG 21-27), which the + original Task 16 pass never opened -- a FERIAL-CLASS-keyed rule, + entirely separate from RG 109's HONOUR-class one: + - RG 23 (I-class ferias -- Ash Wednesday, Holy Week): "nullam + admittunt commemorationem, nisi unam privilegiatam" -- admit no + commemoration except one privileged one. Never actually reaches + this function as a loser (these ferias structurally always + outrank anything that could coincide with their dates -- {!band} + entries 2/7, see that function's own file comment and the Task 11 + Easter-window invariant), so this clause has no live witness, the + same as before. + - RG 24 (II-class ferias -- Advent 17-23 Dec, the Advent/Lent/ + September Ember ferias, RG 91 entry 18): "si vero impediuntur, + COMMEMORARI DEBENT" -- if indeed impeded, they MUST be + commemorated. Not optional, not conditioned on RG 109's list. + - RG 25 (III-class ferias -- ordinary Lent/Passiontide ferias, RG 91 + entry 22; ordinary Advent ferias to 16 Dec, entry 25): "Hae + feriae, si impediuntur, commemorari debent" -- same mandate. + - RG 26: "Omnes feriae, numeris 23-25 non nominatae, sunt feriae IV + classis; quae NUNQUAM COMMEMORANTUR" -- every feria not named in + 23-25 is IV class, and IV-class ferias are NEVER commemorated. + This is [ferial_rank]'s own unqualified IV-class catch-all + (temporal_ef.ml), covering the ordinary green-season ferias of + Time after Epiphany/Pentecost, Septuagesima, Paschaltide outside + its privileged octave, and the Minor Rogation days (RG 87/88 -- + they change nothing in the Office, so they take their season's + plain ferial class, which for Paschaltide-adjacent dates is + IV, not a special one). + + So this branch is now gated directly on RG 26's own condition + ([rank = Class4]), which is the ONLY ferial class RG 21-27 excludes + from commemoration -- Class1 is structurally unreachable here (RG + 23, above); Class2 and Class3 both fall through to the final + [Commemorate] branch below (RG 24/25's mandate), tagged with + whatever HONOUR class [privilege_of] separately computes for them + under RG 109 -- a question this branch no longer conflates with + eligibility. SANCTORAL losers are entirely unaffected (the + [is_temporal] guard): Caput IV governs FERIAE, RG 21's own opening + definition ("Nomine feriae intelleguntur singuli dies hebdomadae, + praeter dominicam"), never a saint's day; RG 111(c)/(d) admit an + "ordinary" commemoration of a losing SAINT freely, with no such + class-keyed gate. Empirically confirmed against the missalemeum oracle (Task 16, 2026-2027, both years): every one of ~190 days where a saint's feast - impedes an ordinary (non-privileged) temporal feria shows ZERO - commemorations in the oracle, including the exact shape this fixes - (e.g. "St. Marcellus I" impeding the plain "Friday after Epiphany", - 6/730 identical instances of the pattern per week of ordinary time) - -- and the SAME fix, for the same reason, independently corrects the - Minor Rogation days (RG 87) losing to a saint (9/730 days), which - [privilege_of]'s own (f) comment already flags as NOT RG 109(f). - - [is_vigil] is EXCLUDED from this branch deliberately: a II/III-class - vigil is temporal-origin too (when it is the Ascension/Pentecost- - adjacent case {!of_temporal} produces) and [privilege_of] rightly - calls it [Ordinary] (a vigil is none of RG 109(a)-(f)), but vigils - are NOT governed by RG 109 at all -- they carry their OWN, separate, - explicit commemoration mandate: RG 31 (II class) "Hae vigiliae - praeferuntur diebus liturgicis III et IV classis; ET, SI - IMPEDIUNTUR, COMMEMORANTUR, iuxta rubricas" and RG 32 (III class, St - Lawrence) "si impeditur, COMMEMORATUR, iuxta rubricas" -- "if - impeded, ARE/IS commemorated". So a vigil impeded WITHOUT triggering - RG 33's full omission (the [is_omissible_vigil] branch above, e.g. - impeded by an ordinary sanctoral feast that is neither a Sunday nor - I class) must still fall through to the final [Commemorate] branch - below, exactly like a sanctoral loser -- RG 31/32's own text, not - RG 109's closed list, is what governs it. *) + impedes an ordinary (IV-class, non-privileged) temporal feria shows + ZERO commemorations in the oracle (e.g. "St. Marcellus I" impeding + the plain "Friday after Epiphany"), and the SAME rank-4 gate, + independently, correctly still omits the Minor Rogation days (RG 87) + losing to a saint -- both consequences of RG 26 alone now, not of a + reading of RG 109 that RG 109's own text does not support. + + [is_vigil] is EXCLUDED from this branch for the same reason as + before, restated under the corrected citation: a II/III-class vigil + is temporal-origin too (the Ascension/Pentecost-adjacent case + {!of_temporal} produces) and typically Class2, so it would already + fall through this branch's [rank = Class4] test harmlessly on its + own -- RG 91 has no IV-class vigil at all (this file's own entry-27/ + 28 comments), so [is_vigil && rank = Class4] should never occur on + real data. Kept as an explicit, defensive guard (not load-bearing + for real data, but total over every candidate {!Precedence.resolve} + or {!Calendar} can construct, including shapes RG 91's table itself + does not describe) rather than relying on that absence silently: a + vigil, per RG 31 (II class, "si impediuntur, commemorantur") / RG 32 + (III class, "si impeditur, commemoratur"), is ALWAYS commemorated + once RG 33 does not omit it outright, regardless of ferial class -- + a rule Caput IV does not speak to at all (vigils are Caput V, RG + 28-34, not "feriae"). *) Precedence.Omit else (* RG 95's other branch: "aut commemorantur aut penitus omittuntur" -- @@ -543,8 +596,9 @@ let disposition ~(winner : Vocab_ef.rank Precedence.candidate) below I class (RG 111(c)/(d)'s "ordinary" commemoration, no closed list the way the temporal branch above has), AND by an impeded I-class Sunday (excluded from the [Transfer] branch above, and from - the temporal-Ordinary [Omit] branch above because [privilege_of]'s - (a) makes a Sunday loser [Privileged], never [Ordinary]): RG 109(a) + the temporal Class4 [Omit] branch above because a Sunday is never + IV class -- RG 11-12/91 entry 6/15 make every Sunday I or II class, + never a "feria" at all in Caput IV's own sense, RG 21): 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 diff --git a/lib/rites/rite_ef/temporal_ef.ml b/lib/rites/rite_ef/temporal_ef.ml index b39da79..1b3d219 100644 --- a/lib/rites/rite_ef/temporal_ef.ml +++ b/lib/rites/rite_ef/temporal_ef.ml @@ -426,6 +426,13 @@ let temporal d = §3b's own RG126 note on the not-yet-modelled per-action nuance), so this is a clean whole-day colour fact, not a per-action one the day/colour model cannot express. + RG 122, fix round 1 (F9), states the same fact + affirmatively rather than as an exception to RG 128's + violet: "Demum adhibetur color albus, feria V + Hebdomadae sanctae, in Missa Chrismatis et in Missa in + Cena Domini" -- white is used, finally [among the + White section's own list], on Thursday of Holy Week, + in the Mass of Chrism and in the Mass in Cena Domini. Task 16, found via the missalemeum oracle comparison: every other Triduum day's oracle colour SET includes violet as one option (Good Friday "bv", Holy Saturday diff --git a/test/test_precedence_ef.ml b/test/test_precedence_ef.ml index 2f08864..9bd9b7f 100644 --- a/test/test_precedence_ef.ml +++ b/test/test_precedence_ef.ml @@ -523,9 +523,13 @@ let privilege_cases = [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. *) + within the Nativity octave, not a plain Advent/Lent/Passiontide feria + slug either -- and, unlike the Advent/Lent Ember rows below, its own + slug ("ef-september-ember-wed") never starts with any of (e)'s own + [alp_feria_prefixes] ("ef-advent-"/"ef-lent-"/"ef-passiontide-"), so + (d) is this candidate's ONLY route to [Privileged] -- a genuine, + still-necessary distinction from (e), unlike the Advent/Lent Ember + case below (fix round 1). *) ( "(d) a September Ember day is privileged", cand "ef-nativity", of_temporal (mk 2026 9 23), @@ -542,36 +546,49 @@ let privilege_cases = 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. + (* CHANGED, fix round 1 (F1/F2/F6): these two rows used to be titled + "boundary: ... is NOT privileged (only September is, RG109(d))" and + expected [Omit] (a Task-16-pass reading that treated RG 109(e)'s bare + "feriis Adventus, Quadragesimae" as tacitly excluding the Advent and + Lent Ember sub-days, by analogy with (d)'s own separate, explicit + September carve-out). Review round 1 (F1) reproduced the real + consequence directly -- 1900-12-21, an Advent Ember Friday, lost its + own commemoration entirely, while an ordinary (lower-solemnity, + non-Ember) Advent feria the same week kept its commemoration -- + backwards on any reading, and traced it to this exact + misclassification (F2). - CHANGED, Task 16: these used to expect [Commemorate(Ordinary)] -- - "not privileged" originally meant "commemorated, but without RG 109's - higher liturgical honours". Now that a TEMPORAL-origin [Ordinary] - loser is Task 16's own [Omit] branch (see precedence_ef.ml), "not - privileged" for a temporal candidate means "not commemorable at all" - -- a sharper, more direct assertion of the same underlying - [privilege_of] classification, via the one vantage point available - on that private function. *) - ( "boundary: an Advent Ember day is NOT privileged (only September is, \ - RG109(d)) -- and being temporal+ordinary, TASK16 omits it entirely", + Corrected reading (precedence_ef.ml's own [privilege_of], (e) + branch, carries the full argument): RG 91's TABLE needs an explicit + "exceptis feriis Quatuor Temporum" at its own entries 22 and 25 to + keep Ember days from being double-listed against their own entry 18 + -- an exception that would be unnecessary drafting if "feriae + Adventus"/"feriae Quadragesimae" did not ALREADY include their Ember + sub-days by default. RG 109(e) carries no such "exceptis" clause, so + its bare text is read at that same default, INCLUSIVE scope: the + Advent and Lent Ember ferias ARE privileged under (e), not merely + commemorable-but-ordinary. (d)'s own separate existence survives + this reading intact -- September Ember days sit outside Advent/Lent/ + Passiontide under ANY reading, so (d) remains the ONLY way they + reach [Privileged], the point the row immediately above this one + makes explicit. + + 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], + not hand-typed, for the same coupling-safety reason every + [of_temporal] row in this file uses it. *) + ( "(e), corrected fix round 1: an Advent Ember day is ALSO privileged, \ + not excluded from (e)", cand "ef-nativity", of_temporal (mk 2026 12 16), - "Omit" ); - ( "boundary: a Lent Ember day is NOT privileged (only September is, \ - RG109(d)) -- and being temporal+ordinary, TASK16 omits it entirely", + "Commemorate(Privileged)" ); + ( "(e), corrected fix round 1: a Lent Ember day is ALSO privileged, \ + not excluded from (e)", cand "ef-nativity", of_temporal (off (-39)), - "Omit" ); + "Commemorate(Privileged)" ); (* 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 @@ -623,6 +640,17 @@ let privileged_hi = cand ~rank:V.Class2 "ef-privileged-hi" thing under test, not merely how many. *) let ordinary_lowest = cand ~rank:V.Class4 "ef-ordinary-lowest" +(* Class3, tagged [Ordinary] -- fix round 1, F7: the RG 111(b) rank-floor + witness [admit_cases] was missing. [ordinary_hi] above is already Class2, + so every existing II-class-Sunday row here passes whether or not + [admit]'s "de festo II classis" filter is even present -- reverting that + filter would only redden [test_oracle.ml], not this file, which is + exactly the coverage gap the review round found. This candidate is the + ONLY thing due on the Sunday row below, so a version of [admit] without + the rank floor would (wrongly) admit it on pure "best available" + dignity, same as it would have admitted [ordinary_hi]. *) +let ordinary_class3 = cand ~rank:V.Class3 "ef-ordinary-class3" + 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". *) @@ -658,6 +686,18 @@ let admit_cases = observed_class2_sunday, [ (ordinary_hi, P.Ordinary); (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, + so the pre-fix-round code's "no privileged? take the best of what's + left" fallback would (wrongly) admit it -- is admitted NOTHING. The + slot is reserved for a II-class candidate specifically; a III-class + ordinary one has no standing for it at all, unlike "other II class" + below, which has no such restriction. *) + ( "II-class Sunday, sole candidate is an ORDINARY Class3 (not \ + \"de festo II classis\") -> admitted nothing, not the best available", + observed_class2_sunday, + [ (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: same candidate pair as the II-class-Sunday row above, OPPOSITE -- cgit v1.3 From 37e058066a5f17db6c3d577703c0a39065ea8117 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 12 Aug 2026 10:15:33 +0200 Subject: kernel(precedence-ef): fix precedence_ef.mli's stale RG33/RG26/RG111(b) contract The .mli's disposition doc still said a Class1-or-Class2 vigil is Omit (RG 33) -- the pre-Task-16 mistranscription the register corrects at its RG 33 entry. The .ml has read Class2 || Class3 since commit 079e332; the .mli never caught up. It also named only vigil_suffix, when the vigil test the code actually runs also checks vigil_prefix (the shape the sanctoral bootstrap's four real vigils use); omitted RG 26's Class4 temporal-ferias-are-never-commemorated branch entirely, then asserted the listed cases 'exhaust every representable shape', which was false as written; and omitted RG 111(b)'s 'de festo II classis' rank floor from admit's doc, describing only the privilege-override half of that rule. Fixed all four: the vigil-omission bullet now names Class2/Class3 and both slug conventions; the missing RG 26 branch is now documented, folding the exhaustiveness claim into an accurate five-branch count; admit's Sunday case now states the rank floor as a second, independent condition. The same stale RG 109(e) reading this interface carried ('leaves the Advent and Lent Ember sets ordinary') also survived as the stated reason september_ember_prefix exists, in the .ml, about 330 lines from the already-corrected privilege_of comment it contradicts. Fixed there too: September is broken out because it sits outside RG 109(e)'s three named seasons entirely, not because Advent/Lent Ember needs excluding from (e) -- it does not, per privilege_of's own corrected comment. No behaviour change: both fixes are doc-comment-only edits to already- correct code (precedence_ef.ml's disposition/admit implementations were fixed in an earlier commit; only the .mli's prose and one earlier .ml comment lagged). --- lib/rites/rite_ef/precedence_ef.ml | 16 ++++-- lib/rites/rite_ef/precedence_ef.mli | 110 +++++++++++++++++++++++------------- 2 files changed, 84 insertions(+), 42 deletions(-) (limited to 'lib') diff --git a/lib/rites/rite_ef/precedence_ef.ml b/lib/rites/rite_ef/precedence_ef.ml index 88f1a54..bfd3b93 100644 --- a/lib/rites/rite_ef/precedence_ef.ml +++ b/lib/rites/rite_ef/precedence_ef.ml @@ -87,10 +87,18 @@ let is_vigil slug = [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. *) + September set alone: RG 109(e)'s three named seasons (Advent, Lent, + Passiontide, §4 "Commemorations") never include September, which sits + entirely in time after Pentecost under any reading -- so September Ember + days need their own separate privilege category, (d), regardless of how + (e) itself is read. CORRECTED (fix round 1, F1/F2): this comment + previously justified the split the other way round, claiming RG 109(e) + privileges September specifically "while leaving the Advent and Lent + sets ordinary" -- WRONG; see [privilege_of]'s own (e) comment below for + the full argument. The Advent and Lent Ember sets ARE privileged under + (e), the same as any other Advent/Lent feria; building [ember_prefixes] + from this constant 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-" diff --git a/lib/rites/rite_ef/precedence_ef.mli b/lib/rites/rite_ef/precedence_ef.mli index 8234bf3..161d890 100644 --- a/lib/rites/rite_ef/precedence_ef.mli +++ b/lib/rites/rite_ef/precedence_ef.mli @@ -65,8 +65,8 @@ val unclassified : int (** [band ctx c]: RG 91's Table of Precedence. Returns the table's own entry number -- I class 1-13, II class 14-21, III class 22-26, IV class 27-28; lower wins (see {!Precedence.rules.band}) -- EXCEPT where the table's own - text states an exception: entry 8 (All Souls, register line 334) reads - "yields to an occurring Sunday", so on a Sunday this returns a value that + text states an exception: entry 8 (All Souls) reads "yields to an + occurring Sunday", so on a Sunday this returns a value that loses to entry 15 rather than the literal integer 8 (see the comment on entry 8 in precedence_ef.ml for the exact value and why). Total over every candidate {!Precedence.resolve} or {!Calendar} can construct, @@ -82,39 +82,62 @@ 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 -(** [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), - except RG 33's vigil omission, which also reads the winner: +(** [disposition ~winner ~loser]: RG 92-95, 33, 21-27, 94 (docs/research/ + rules-register.md §4, "Occurrence", "Vigils" and "Caput IV, 'De + feriis'"). What becomes of a losing candidate, decided by the LOSER's + own rank and status (RG 95), except RG 33's vigil omission, which also + reads the winner: - a {!Celebration.status} of [Commemoration_only] is always [Commemorate] (checked first: it can never win -- see {!Precedence.resolve} -- and, by that same status's own definition, already denotes an office with nothing left to translate, so it never transfers either; not itself a further RG citation beyond RG 93's general four-mechanism statement above); - - a [Class1] or [Class2] loser whose slug marks it a vigil ({!vigil_suffix}) - is [Omit] when the winner is any Sunday ({!sunday_marker}) or itself - [Class1] (RG 33 -- entirely omitted, not merely commemorated); + - a [Class2] or [Class3] loser whose slug marks it a vigil + ({!vigil_suffix} OR {!vigil_prefix} -- both conventions this + codebase's data uses, see {!vigil_prefix}'s own comment) is [Omit] + when the winner is any Sunday ({!sunday_marker}) or itself [Class1] + (RG 33 -- entirely omitted, not merely commemorated). A [Class1] + vigil (Nativity, Pentecost) is outside RG 33 entirely -- RG 30 makes + it preferred to any feast whatsoever, so a real one can never reach + this function as a [loser] in the first place (see the .ml's own + comment on [is_omissible_vigil] for the full argument); - any other [Class1] loser that is NOT a Sunday ({!sunday_marker}) is - [Transfer] (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, from feasts, entries 11-13, so a Sunday is - never a "feast" in RG 95's sense and does not transfer even when - impeded by a higher I-class day. 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 -- including an impeded I-class Sunday -- is - [Commemorate], carrying its real RG 109 privilege (see {!admit} - below); RG 109(a) (register line 374) lists "of a Sunday" as a - privileged commemoration category precisely because an impeded Sunday - stays put rather than moving to another day. + [Transfer] (RG 95 -- only I-class FEASTS have the right of + translation; RG 91's own table lists Sundays as a separate row, entry + 6, from feasts, entries 11-13, so a Sunday is never a "feast" in RG + 95's sense and does not transfer even when impeded by a higher + I-class day. This is also what moves All Souls, RG 91 entry 8, once + it loses to an occurring Sunday -- WHERE it lands is + {!Rite.t.transfer_target}'s job, not this function's); + - a TEMPORAL-origin, non-vigil loser of [Class4] is [Omit] (RG 26, + "Caput IV, De feriis" -- "every feria not named in [RG 23-25] is IV + class ... and IV-class ferias are NEVER commemorated." A SEPARATE + rule from RG 109's honour-class one immediately below, keyed on + ferial CLASS rather than on RG 109's privilege letters: RG 109 sorts + commemorations that already exist into honour classes (RG 108's + differing liturgical hours), it does not itself decide which offices + have the right to be commemorated at all -- that is Caput IV's own + business. A SANCTORAL loser of the same rank is unaffected by this + branch (the [is_temporal] guard): RG 21 defines "feria" as any + weekday, never a saint's day, and RG 111(c)/(d) admit an "ordinary" + commemoration of a losing SAINT freely, with no such class-keyed + gate); + - everything else -- including an impeded I-class Sunday, and a + SANCTORAL loser of any rank below I class -- is [Commemorate], + carrying its real RG 109 privilege (see {!admit} below); RG 109(a) + lists "of a Sunday" as a privileged commemoration category precisely + because an impeded Sunday stays put rather than moving to another + day, and RG 24/25 make a losing II- or III-class FERIA's own + commemoration mandatory when impeded, not merely eligible. Total over every winner/loser pair {!Precedence.resolve} or {!Calendar} can construct: [Vocab_ef.rank] (RG 8) and {!Celebration.status} are both - closed variants, so the cases above exhaust every representable shape -- - there is no fifth, "unclassified" case the way {!band} needs one, - because this function's own return type has no such slot to fall into - by accident. *) + closed variants, and the five cases above -- an if/else-if chain ending + in the unconditional [Commemorate] catch-all -- exhaust every value + those two fields can take between them; there is no fifth, + "unclassified" case the way {!band} needs one, because this function's + own return type has no such slot to fall into by accident. *) val disposition : winner:Vocab_ef.rank Precedence.candidate -> loser:Vocab_ef.rank Precedence.candidate -> @@ -130,26 +153,37 @@ val disposition : 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. *) + 109(d) (§4, "Commemorations") privileges September Ember days under its + own name, and September sits outside RG 109(e)'s three named seasons + (Advent, Lent, Passiontide) under any reading of that clause -- NOT + because the Advent and Lent Ember sets need excluding from (e), which + they do not: (e)'s own bare text privileges them too, the same as any + other Advent/Lent feria (see {!Precedence_ef.privilege_of}'s own (e) + comment in the .ml for the full argument, corrected fix round 1). + {!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: + "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: - [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] a [Class2] Sunday (its slug carries {!sunday_marker}): 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; - [observed] any other [Class2] day: one, by dignity alone -- no - privilege override, unlike the Sunday case immediately above; + privilege override and no rank floor, 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 -- cgit v1.3 From 3159bed3c71c35fecc141cfd1453e27b6a4a3780 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 12 Aug 2026 10:23:40 +0200 Subject: kernel(rite-ef): replace unearned/retracted citations with verified ones MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Four citation problems, all resolved against the primary scans (docs/research/*.pdf via pdftotext): 1. temporal_ef.ml's Ember-day date-derivation comment still carried a retracted note claiming the scans have no numbered-paragraph statement of the rule. Register §3a corrected this in an earlier commit (the search used the genitive "Quatuor Temporum"; the rubric heading is the nominative "Quatuor Tempora") and the register's own words warn "a false 'not in the source' note is worse than no note" -- the code still carried the retracted note verbatim. Replaced with the verified citation and the primary Latin. 2. temporal_ef.ml cited RG 71 for "Advent I is the Sunday nearest 30 November". RG 71 is a season-boundary citation only ("a I Vesperis dominicae I Adventus..."); it does not say which Sunday opens the season. The actual rule is RG 20 (Caput III, "De Dominicis"): "Dominica I Adventus ea est, quae cadit die 30 novembris vel est ipsi proximior" -- verified against the scan and added to the register. Behaviour was always correct; only the citation was borrowed. 3. RG 88 ("de Litaniis minoribus nihil fit in Officio") is cited five times across code and tests, load-bearing twice (why Rogation days take their season's ordinary ferial class; why privilege_of lets them fall through to Ordinary), but appeared nowhere in the register. RG 67 and RG 69 were likewise cited at expected-divergences-missalemeum.sexp (M11) without register backing. All three verified against the scan and added to the register's §4 (Octaves / Rogations subsections). 4. Two citations flagged for re-verification, both CONFIRMED accurate against the primary scan (word for word): - precedence_ef.ml's RG 32 "si impeditur, commemoratur" (the sole textual basis for treating a vigil as always-commemorated once RG 33 doesn't omit it outright) -- the register previously stated RG 32 only as "same pattern as RG 31", not verbatim; the full sentence is now in the register too. - precedence_ef.ml's RG 111(b) full sentence (the sole textual basis for the shipped Sunday rank-floor fix) -- the register previously carried only the fragment "de festo II classis"; the full sentence is now there. - temporal_ef.ml's RG 91 entry 7 "feria IV cinerum et II, III et IV Hebdomadae sanctae" (the sole justification for stopping the I-class ferias at Wednesday) was also checked and matches the scan exactly; left as-is (already correctly cited), noted in the report. Bonus finding while re-verifying RG 20: RG 17(d), same chapter, states "festum D. N. Iesu Christi Regis, celebrandum dominica ultima mensis octobris" -- primary-source confirmation that Christ the King falls on the last Sunday of October. This was the register's one oracle-backed-but-not-primary-verified rule (CLAUDE.md's own carried-item language); it no longer is. Updated temporal_ef.ml's christ_the_king comment and closed the item in register §6. No behaviour change: every edit here is a comment/citation change to already-correct code. Verified byte-identical `colitur day` output across 1583, 1900, 1902, 2008, 2011, 2026, 2038, 9999. 259/259 tests green. --- lib/rites/rite_ef/precedence_ef.ml | 25 +++++++++++----- lib/rites/rite_ef/temporal_ef.ml | 59 +++++++++++++++++++++++++++----------- 2 files changed, 60 insertions(+), 24 deletions(-) (limited to 'lib') diff --git a/lib/rites/rite_ef/precedence_ef.ml b/lib/rites/rite_ef/precedence_ef.ml index bfd3b93..3c417bb 100644 --- a/lib/rites/rite_ef/precedence_ef.ml +++ b/lib/rites/rite_ef/precedence_ef.ml @@ -596,7 +596,13 @@ let disposition ~(winner : Vocab_ef.rank Precedence.candidate) (III class, "si impeditur, commemoratur"), is ALWAYS commemorated once RG 33 does not omit it outright, regardless of ferial class -- a rule Caput IV does not speak to at all (vigils are Caput V, RG - 28-34, not "feriae"). *) + 28-34, not "feriae"). RG 32's own full sentence, primary-source- + verified (final fix wave): "Vigilia III classis est vigilia S. + Laurentii. Haec vigilia praefertur diebus liturgicis IV classis; et, + si impeditur, commemoratur, iuxta rubricas" -- confirmed word for + word against the scan, not constructed by analogy with RG 31 (the + register's own §4 "Vigils" entry states RG 32 only as "same pattern + [as RG 31]", not verbatim -- now closed here). *) Precedence.Omit else (* RG 95's other branch: "aut commemorantur aut penitus omittuntur" -- @@ -698,12 +704,17 @@ let admit ~(observed : Vocab_ef.rank Precedence.candidate) several are. *) (match List.filter is_privileged sorted with [] -> [] | best :: _ -> [ best ]) | Class2, true -> - (* RG 111(b), primary text: "in dominicis II classis, una tantum - admittitur commemoratio, SCILICET DE FESTO II CLASSIS, quæ tamen - omittitur si commemoratio privilegiata facienda sit" -- "on Sundays - of the II class, only ONE commemoration is admitted, NAMELY OF A - FEAST OF THE II CLASS, which however is dropped if a privileged - commemoration is due." Two clauses, not one: (i) a privileged + (* 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 + shipped rank-floor fix below, and the register's own §4 "RG 111" + entry previously carried only the fragment "de festo II classis", + not the full sentence -- now added there too): "in dominicis II + classis, una tantum admittitur commemoratio, SCILICET DE FESTO II + CLASSIS, quæ tamen omittitur si commemoratio privilegiata facienda + sit" -- "on Sundays of the II class, only ONE commemoration is + admitted, NAMELY OF A FEAST OF THE II CLASS, which however is + 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, so an ordinary commemoration that would otherwise win on raw diff --git a/lib/rites/rite_ef/temporal_ef.ml b/lib/rites/rite_ef/temporal_ef.ml index 1b3d219..c3db15c 100644 --- a/lib/rites/rite_ef/temporal_ef.ml +++ b/lib/rites/rite_ef/temporal_ef.ml @@ -17,9 +17,17 @@ let weekday_index d = (* The Sunday on or before [d]. *) let sunday_on_or_before d = Date.add_days d (-(weekday_index d)) -(* RG 71: Advent I is the Sunday nearest 30 November -- equivalently the fourth - Sunday before Christmas, i.e. three weeks before the last Sunday on or before - 24 December. *) +(* RG 20 (Caput III, "De Dominicis"), primary-source-verified (final fix + wave): "Dominica I Adventus ea est, quae cadit die 30 novembris vel est + ipsi proximior" -- Advent I Sunday is that which falls on 30 November or + is nearest to it. CORRECTED citation: this comment previously cited RG + 71 for this placement rule -- WRONG, RG 71 (cited on [season] below) + states only Advent's own season BOUNDARY ("a I Vesperis dominicae I + Adventus..."), not which Sunday opens it; the register's own RG 71 entry + is a boundary citation, and the only "nearest 30 November" text there + before this fix was UNLYC nn. 39-42, the MODERN form's rule, not this + one's. Equivalently the fourth Sunday before Christmas, i.e. three weeks + before the last Sunday on or before 24 December. *) let advent_start y = Date.add_days (sunday_on_or_before (mk y 12 24)) (-21) let year_start = advent_start @@ -47,8 +55,13 @@ let season d = else if Date.compare d paschal_end <= 0 then Paschaltide (* RG 76 *) else Time_after_pentecost (* RG 77 *) -(* Last Sunday of October, per the 1960 calendar -- NOT the OF's last Sunday - before Advent. Register §6 flags this for primary-source confirmation. *) +(* RG 17(d) (Caput III, "De Dominicis"), PRIMARY-SOURCE-VERIFIED (final fix + wave, closing the item register §6 previously carried as "oracle-backed, + not yet primary-verified"): "festum D. N. Iesu Christi Regis, celebrandum + dominica ultima mensis octobris" -- the feast of Our Lord Jesus Christ + the King is to be celebrated on the LAST SUNDAY OF OCTOBER. NOT the OF's + last Sunday before Advent -- a genuine EF/OF divergence, not merely a + citation gap. *) let christ_the_king y = sunday_on_or_before (mk y 10 31) let same a b = Date.compare a b = 0 @@ -253,18 +266,30 @@ let id = "ef" (* The third Sunday of September: the Ember week's anchor. - This specific date-derivation rule is one of the more contested points in - the 1962 calendar: pre-1955 practice tied the September Ember days to the - week following the Exaltation of the Holy Cross (14 Sept) instead. The two - rules only disagree when 1 September is a Monday -- 2025 is such a year -- - and the primary-source scan available to this project does not contain an - explicit numbered-paragraph statement of either rule (searched; see - register §3 "Ember days"), so this citation is deliberately left at the - rank rules only (RG 91 entries 18/22, cited on [ember] below), not the - date-derivation rule itself: a wrong citation is worse than none. - Empirically: for 2025 this rule gives 24/26/27 September, confirmed - against an independent oracle; the Holy-Cross rule would give 17/19/20 - September instead. See register §3 for the full note. *) + [cited] PRIMARY-SOURCE-VERIFIED (register §3a): MR1962, "De anno et eius + partibus", under the heading "Quatuor Tempora" (not a numbered RG + paragraph, which is why an earlier paragraph-number search missed it): + + "Quatuor Tempora celebrantur quarta et sexta feria ac sabbato post + tertiam dominicam Adventus, post primam dominicam Quadragesimae, post + dominicam Pentecostes, post dominicam tertiam septembris." + + -- the Ember Days are kept on the Wednesday, Friday and Saturday after + Advent III, after Lent I, after Pentecost, [and] after the third Sunday + of September -- confirming all four of this module's anchors, including + this specific contested one. This specific date-derivation rule was one + of the more contested points in the 1962 calendar: pre-1955 practice + tied the September Ember days to the week following the Exaltation of + the Holy Cross (14 Sept) instead. The two rules only disagree when 1 + September is a Monday -- 2025 is such a year, and confirms the + third-Sunday reading empirically too (24/26/27 September against an + independent oracle, vs the Holy-Cross rule's 17/19/20). An earlier + version of this comment said the scan contained no numbered-paragraph + statement of either rule and left the citation at the rank rules only + (RG 91 entries 18/22) -- WRONG, corrected once the nominative heading + "Quatuor Tempora" was found rather than the genitive "Quatuor Temporum" + the original search used; register §3a records the correction, because a + false "not in the source" note is worse than no note. *) let third_sunday_of_september y = let sep1 = mk y 9 1 in let first_sunday = Date.add_days sep1 ((7 - weekday_index sep1) mod 7) in -- cgit v1.3 From 7ac8a25700c9d930eaaa4f9895665248dac32c52 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 12 Aug 2026 10:26:11 +0200 Subject: docs(citations): migrate register line-number pointers to stable anchors MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 68 "register line N" pointers in tracked code and data cited the register's line numbers directly. The register has moved since: line 334 (cited six times as RG 91 entry 8) is now rose/colour prose; lines 375-376 (cited as "RG 109 leaves Advent/Lent Ember ordinary") are now RG 26, the paragraph that refutes that exact reading; line 374 (cited as RG 109(a)) is now RG 25's Latin; line 378 (RG 111) is blank. expected-divergences.sexp even wrote "RG 91 line 332" three times, as though the line offset were part of the rubric's own identity. Since docs/research/rules-register.md is gitignored, no reader of the public repo could resolve any of these, and -- since the register has moved on its own copy too -- neither can the author's. Replaced every pointer with an anchor that survives editing: the RG paragraph/entry number itself (already present in nearly every case, since the citation text already names "RG 91 entry N" or "RG 109(a)" next to the stale line number -- the line number was redundant, not load-bearing) plus a "§4" or quoted-subsection-heading pointer into the register for readers who want to locate the fuller discussion. Also corrected one genuinely stale content error found while migrating its anchor: test_precedence_ef.ml's RG33 disposition-cases comment still said "a I/II-class vigil impeded by any Sunday" -- the pre-Task-16 mistranscription the register itself corrects to II/III class; fixed the prose alongside its citation, since leaving a wrong RG-class claim next to a freshly-verified anchor would be worse than the stale line number it replaced. Covers lib/rites/rite_ef/precedence_ef.ml (18), precedence_ef.mli (already fixed with item 1), test/test_precedence_ef.ml (44, including two instances that only word-wrapped "register\nline N" across a line break and so did not match a same-line grep), and data/ef/expected-divergences.sexp (5, including three "RG 91 line 332" instances). All 68 original pointers resolved -- none needed guessing; every citation's target rule was already named in the surrounding prose. No behaviour change: every edit is a comment/citation/data-note change. Verified byte-identical `colitur day` output across 1583, 1900, 1902, 2008, 2011, 2026, 2038, 9999. 259/259 tests green. --- data/ef/expected-divergences.sexp | 10 ++-- lib/rites/rite_ef/precedence_ef.ml | 37 +++++++-------- test/test_precedence_ef.ml | 97 +++++++++++++++++++------------------- 3 files changed, 72 insertions(+), 72 deletions(-) (limited to 'lib') diff --git a/data/ef/expected-divergences.sexp b/data/ef/expected-divergences.sexp index 6b7bbdd..c8d863d 100644 --- a/data/ef/expected-divergences.sexp +++ b/data/ef/expected-divergences.sexp @@ -20,15 +20,15 @@ ((id C1) (citation "RG 72-73 (Nativity/Epiphany season boundary, Jan 1-13) + RG 119a (white through \"expletum tempus Epiphaniae\"); register §3c item 1") (verdict colitur) - (note "6-13 January is Christmastide in colitur, matching RG 72-73's explicit boundary at 13 January (corroborated independently by RG 119a's colour rule, register lines 241-246). lectio's efSeason switches to time-after-epiphany on 6 January. The season disagreement cascades into colour (green vs white) and, on 7-8 January specifically, into the ferial slug family name (colitur's ef-christmas-2- vs lectio's ef-time-after-epiphany-1- for the same two days).") + (note "6-13 January is Christmastide in colitur, matching RG 72-73's explicit boundary at 13 January (corroborated independently by RG 119a's colour rule, §3b). lectio's efSeason switches to time-after-epiphany on 6 January. The season disagreement cascades into colour (green vs white) and, on 7-8 January specifically, into the ferial slug family name (colitur's ef-christmas-2- vs lectio's ef-time-after-epiphany-1- for the same two days).") (expected_rows 368)) ((id C2) - (citation "RG 91 line 332 (\"Sundays of Advent, Lent, Passiontide, and Low Sunday\" -- I class, unqualified); extends register §3c item 4 (stated there for Advent only) to Lent on the same textual basis") + (citation "RG 91 entry 6, §4 (\"Sundays of Advent, Lent, Passiontide, and Low Sunday\" -- I class, unqualified); extends register §3c item 4 (stated there for Advent only) to Lent on the same textual basis") (verdict colitur) - (note "Advent II & IV and Lent I-III are I class in colitur, matching RG 91's own unqualified line 332 (already confirmed for Passion Sunday, Palm Sunday, Low Sunday and Advent I, where lectio agrees). lectio's temporal_ef.go generic Sunday branch assigns Class2 and special-cases only Advent I, Passion/Palm/Low Sunday -- a lectio gap for the remaining five Sundays this entry covers.") + (note "Advent II & IV and Lent I-III are I class in colitur, matching RG 91's own unqualified entry 6 (already confirmed for Passion Sunday, Palm Sunday, Low Sunday and Advent I, where lectio agrees). lectio's temporal_ef.go generic Sunday branch assigns Class2 and special-cases only Advent I, Passion/Palm/Low Sunday -- a lectio gap for the remaining five Sundays this entry covers.") (expected_rows 215)) ((id C3) - (citation "RG 91 line 332 (same I-class Sunday rule as C2) + RG 131 (rose indult, Gaudete/Laetare, \"in Officio et Missa diei dominici tantum\")") + (citation "RG 91 entry 6, §4 (same I-class Sunday rule as C2) + RG 131 (rose indult, Gaudete/Laetare, \"in Officio et Missa diei dominici tantum\")") (verdict colitur) (note "Gaudete (Advent III) and Laetare (Lent IV): I class per C2's citation, plus the RG 131 rose indult. lectio has no Rose case in its EF colour function and zero rose rows in tridentine-calendar.ini -- Rose exists only on lectio's OF path -- so it prints violet for both Sundays.") (expected_rows 89)) @@ -58,7 +58,7 @@ (note "Rogation Monday and Tuesday exist as colitur's own ef-rogation-{monday,tuesday} slugs (violet) whenever no higher-ranked saint intervenes. lectio computes no Rogation days at all and shows the plain paschaltide-week-6 feria instead.") (expected_rows 31)) ((id C9) - (citation "RG 95 (translation is a right of I-class FEASTS only) + RG 91 line 332 (Sundays are a separate table row, not feasts) + RG 109(a) (\"of a Sunday\" is a privileged commemoration, presupposing the Sunday stays put) + RG 96 (the general translation walk) -- the same reasoning already fixed for the analogous impeded-Sunday defect in Precedence_ef (Task 9)") + (citation "RG 95 (translation is a right of I-class FEASTS only) + RG 91 entry 6, §4 (Sundays are a separate table row, not feasts) + RG 109(a) (\"of a Sunday\" is a privileged commemoration, presupposing the Sunday stays put) + RG 96 (the general translation walk) -- the same reasoning already fixed for the analogous impeded-Sunday defect in Precedence_ef (Task 9)") (verdict colitur) (note "St Joseph (19 March, I class) colliding with a Lent Sunday (I class per C2): colitur keeps the Sunday observed and transfers Joseph to the next free day (usually 20 March; in years the walk is congested enough to cross Easter, as far as 1 April -- 2008, 2035, 2046, independently pinned by this project's own transfer tests). lectio instead puts Joseph ON the Sunday, displacing the Lenten Sunday office RG 95 says cannot be displaced by a translated feast.") (expected_rows 15)) diff --git a/lib/rites/rite_ef/precedence_ef.ml b/lib/rites/rite_ef/precedence_ef.ml index 3c417bb..9997bb2 100644 --- a/lib/rites/rite_ef/precedence_ef.ml +++ b/lib/rites/rite_ef/precedence_ef.ml @@ -152,7 +152,7 @@ let band (ctx : Vocab_ef.season Precedence.context) (c : Vocab_ef.rank Precedenc (* 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 + (* 8: All Souls -- RG 91 entry 8's own text (§4) 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 @@ -182,9 +182,9 @@ let band (ctx : Vocab_ef.season Precedence.context) (c : Vocab_ef.rank Precedenc 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 + (* 14: Feasts of the Lord, II class -- RG 91 entry 14, deliberately + UNQUALIFIED (contrast entry 16, which explicitly says "not + of the Lord"; RG 37c (§4, "Sundays") 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, @@ -232,7 +232,7 @@ let band (ctx : Vocab_ef.season Precedence.context) (c : Vocab_ef.rank Precedenc 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, + IV-class vigil at all (RG 91's own vigil list, §4 "Vigils", 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 @@ -339,7 +339,7 @@ let impedes_vigil (winner : Vocab_ef.rank Precedence.candidate) = 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 + Passiontide" (§4, "Commemorations") -- temporal_ef.ml's generic -- 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 @@ -349,7 +349,7 @@ let nativity_octave_prefix = "ef-nativity-octave-day-" [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 +(* RG 109 (docs/research/rules-register.md §4, "Commemorations"): 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 @@ -374,10 +374,10 @@ let privilege_of (c : Vocab_ef.rank Precedence.candidate) : Precedence.privilege 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 + (* (a) RG 109(a) (§4): "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 + (* (b) RG 109(b) (§4): "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 @@ -385,17 +385,17 @@ let privilege_of (c : Vocab_ef.rank Precedence.candidate) : Precedence.privilege 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". *) + (* (c) RG 109(c) (§4): "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" -- named on its + (* (d) RG 109(d) (§4): "of September Ember days" -- named on its own because September falls entirely outside (e)'s three seasons (Advent/Lent/Passiontide) under ANY reading, not because it needs excluding FROM (e) the way review round 1's F1/F2 finding corrected the Advent/Lent Ember sets below to no longer need. *) 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" -- + (* (e) RG 109(e) (§4): "of ferias of Advent, Lent and Passiontide" -- CORRECTED, fix round 1 (F1/F2): this branch previously excluded the Advent and Lent Ember sets via [not (is_ember_18 slug)], reading RG 109(e)'s bare "feriis Adventus, Quadragesimae" as tacitly narrower than @@ -428,7 +428,7 @@ let privilege_of (c : Vocab_ef.rank Precedence.candidate) : Precedence.privilege it under its own name. *) else if is_temporal && 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 + (* (f) RG 109(f) (§4): "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 @@ -478,13 +478,12 @@ let disposition ~(winner : Vocab_ef.rank Precedence.candidate) 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 + (* RG 95 (§4, "Occurrence" and "Transfer/translation"): 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 + (entry 6) from feasts (entries 11-13), 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 + branch that completes Task 7's All Souls fix (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 @@ -613,7 +612,7 @@ let disposition ~(winner : Vocab_ef.rank Precedence.candidate) the temporal Class4 [Omit] branch above because a Sunday is never IV class -- RG 11-12/91 entry 6/15 make every Sunday I or II class, never a "feria" at all in Caput IV's own sense, RG 21): RG 109(a) - (register line 374) lists "of a Sunday" as a privileged commemoration + (§4) 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 @@ -632,7 +631,7 @@ let disposition ~(winner : Vocab_ef.rank Precedence.candidate) 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" + (docs/research/rules-register.md §4, "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. diff --git a/test/test_precedence_ef.ml b/test/test_precedence_ef.ml index efbdb04..a0e1db1 100644 --- a/test/test_precedence_ef.ml +++ b/test/test_precedence_ef.ml @@ -49,45 +49,45 @@ let off n = D.add_days easter n (* (description, date, candidate, expected RG 91 entry). *) let cases = - [ (* Entry 1 -- register line 327: Nativity, Easter Sunday, Pentecost Sunday. *) + [ (* Entry 1 -- RG 91 entry 1 (§4): Nativity, Easter Sunday, Pentecost Sunday. *) ("1 Nativity", mk 2026 12 25, cand "ef-nativity", 1); ("1 Easter Sunday", off 0, cand "ef-easter-sunday", 1); ("1 Pentecost Sunday", off 49, cand "ef-pentecost", 1); - (* Entry 2 -- register line 328: Sacred Triduum. Thu-Sat of Holy Week, + (* Entry 2 -- RG 91 entry 2 (§4): Sacred Triduum. Thu-Sat of Holy Week, NOT entry 7 (which stops at Wednesday -- see entry 7 below). *) ("2 Holy Thursday", off (-3), cand "ef-holy-thursday", 2); ("2 Good Friday", off (-2), cand "ef-good-friday", 2); ("2 Holy Saturday", off (-1), cand "ef-holy-saturday", 2); - (* Entry 3 -- register line 329. *) + (* Entry 3 -- RG 91 entry 3 (§4). *) ("3 Epiphany", mk 2026 1 6, cand "ef-epiphany", 3); ("3 Ascension", off 39, cand "ef-ascension", 3); ("3 Trinity", off 56, cand "ef-trinity", 3); ("3 Corpus Christi", off 60, cand "ef-corpus-christi", 3); ("3 Sacred Heart", off 68, cand "ef-sacred-heart", 3); ("3 Christ the King", T.christ_the_king 2026, cand "ef-christ-the-king", 3); - (* Entry 4 -- register line 330. Sanctoral-origin: neither feast is part + (* Entry 4 -- RG 91 entry 4 (§4). Sanctoral-origin: neither feast is part of temporal_ef's movable cycle. *) ( "4 Immaculate Conception", mk 2026 12 8, cand ~origin:P.Sanctoral ~subject:Sub.Bvm ~layer:PE.universal_layer "ef-immaculate-conception", 4 ); ("4 Assumption", mk 2026 8 15, cand ~origin:P.Sanctoral ~subject:Sub.Bvm ~layer:PE.universal_layer "ef-assumption", 4); - (* Entry 5 -- register line 331. *) + (* Entry 5 -- RG 91 entry 5 (§4). *) ("5 Nativity Vigil", mk 2026 12 24, cand "ef-nativity-vigil", 5); ("5 Octave day (Circumcision)", mk 2026 1 1, cand "ef-circumcision", 5); - (* Entry 6 -- register line 332. *) + (* Entry 6 -- RG 91 entry 6 (§4). *) ("6 Advent Sunday", T.advent_start 2026, cand "ef-advent-sunday-1", 6); ("6 Lent Sunday", off (-42), cand "ef-lent-sunday-1", 6); ("6 Passion Sunday (I Passiontide)", off (-14), cand "ef-passion-sunday", 6); ("6 Palm Sunday (II Passiontide)", off (-7), cand "ef-palm-sunday", 6); ("6 Low Sunday", off 7, cand "ef-low-sunday", 6); - (* Entry 7 -- register line 333: Ash Wednesday and Mon/Tue/Wed of Holy + (* Entry 7 -- RG 91 entry 7 (§4): Ash Wednesday and Mon/Tue/Wed of Holy Week ONLY -- Thu-Sat are entry 2 above, not this entry. *) ("7 Ash Wednesday", off (-46), cand "ef-ash-wednesday", 7); ("7 Monday of Holy Week", off (-6), cand "ef-holy-monday", 7); ("7 Tuesday of Holy Week", off (-5), cand "ef-holy-tuesday", 7); ("7 Wednesday of Holy Week", off (-4), cand "ef-holy-wednesday", 7); - (* Entry 8 -- register line 334. 2 Nov 2026 is a Monday (verified + (* Entry 8 -- RG 91 entry 8 (§4). 2 Nov 2026 is a Monday (verified independently below the table), so this row is the plain case. The register's own qualifying case -- "yields to an occurring Sunday" -- gets its own row and its own end-to-end test after this table (2 Nov @@ -101,31 +101,31 @@ let cases = [test_all_souls_yields_to_sunday] below; this row pins the specific integer [band] returns. *) ("8 All Souls (yields to a Sunday, 2 Nov 2025)", mk 2025 11 2, cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-all-souls", 16); - (* Entry 9 -- register line 335. *) + (* Entry 9 -- RG 91 entry 9 (§4). *) ("9 Pentecost Vigil", off 48, cand "ef-pentecost-vigil", 9); - (* Entry 10 -- register line 336: both range boundaries, to guard the + (* Entry 10 -- RG 91 entry 10 (§4): both range boundaries, to guard the off-by-one an inclusive Easter-offset window invites. *) ("10 Easter octave, day+1", off 1, cand "ef-easter-1-mon", 10); ("10 Easter octave, day+6", off 6, cand "ef-easter-1-sat", 10); ("10 Pentecost octave, day+50", off 50, cand "ef-pentecost-1-mon", 10); ("10 Pentecost octave, day+55", off 55, cand "ef-pentecost-1-sat", 10); - (* Entry 11 -- register line 337. *) + (* Entry 11 -- RG 91 entry 11 (§4). *) ( "11 Universal I-class feast", mk 2026 6 29, cand ~origin:P.Sanctoral ~subject:Sub.Saint ~layer:PE.universal_layer "ef-ss-peter-paul", 11 ); - (* Entry 12 -- register line 338. The one non-base-layer case the brief + (* Entry 12 -- RG 91 entry 12 (§4). The one non-base-layer case the brief asks for explicitly: same date/rank/subject as 11, only the layer differs, so this row isolates the layer test as the deciding factor. *) ( "12 Proper I-class feast (non-base layer)", mk 2026 6 29, cand ~origin:P.Sanctoral ~subject:Sub.Saint ~layer:"diocese-warsaw" "ef-local-patron", 12 ); - (* Entry 13 -- register line 339. *) + (* Entry 13 -- RG 91 entry 13 (§4). *) ( "13 Indult I-class feast", mk 2026 6 29, cand ~origin:P.Sanctoral ~subject:Sub.Saint ~layer:(PE.indult_prefix ^ "local-grant") "ef-indult-feast-1", 13 ); - (* Entry 14 -- register line 341, deliberately UNQUALIFIED (contrast - entry 16, line 342, which explicitly says "not of the Lord"). *) + (* Entry 14 -- RG 91 entry 14 (§4), deliberately UNQUALIFIED (contrast + entry 16, which explicitly says "not of the Lord"). *) ( "14 Feast of the Lord, II class", mk 2026 7 1, cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Lord ~layer:PE.universal_layer "ef-precious-blood", @@ -138,21 +138,21 @@ let cases = cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Lord ~layer:"diocese-warsaw" "ef-local-feast-of-the-lord", 14 ); - (* Entry 15 -- register line 342: an ordinary Sunday not named at entry 6 + (* Entry 15 -- RG 91 entry 15 (§4): an ordinary Sunday not named at entry 6 -- Septuagesima is II class (RG 11-12 names only Advent/Lent/ Passiontide/Easter/Low/Pentecost as I class). *) ("15 II-class Sunday (Septuagesima)", off (-63), cand ~rank:V.Class2 "ef-septuagesima-sunday", 15); - (* Entry 16 -- register line 342. *) + (* Entry 16 -- RG 91 entry 16 (§4). *) ( "16 Universal II-class feast, not of the Lord", mk 2026 1 20, cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Saint ~layer:PE.universal_layer "ef-some-saint", 16 ); - (* Entry 17 -- register line 343: days WITHIN the Nativity octave (26-28 + (* Entry 17 -- RG 91 entry 17 (§4): days WITHIN the Nativity octave (26-28 Dec are Stephen/John/Innocents -- sanctoral, not this entry; 1 Jan is entry 5's Octave DAY, not this entry either). *) ("17 Nativity octave, 29 Dec", mk 2026 12 29, cand ~rank:V.Class2 "ef-nativity-octave-day-5", 17); ("17 Nativity octave, 31 Dec", mk 2026 12 31, cand ~rank:V.Class2 "ef-nativity-octave-day-7", 17); - (* Entry 18 -- register line 343-344: Advent 17-23 Dec ferias AND the + (* Entry 18 -- RG 91 entry 18 (§4): Advent 17-23 Dec ferias AND the Ember days of Advent/Lent/September share this one entry. The second row is deliberately a Lent date (season Lent, NOT Advent) to prove the Ember-slug path fires on its own, not merely because it also happens @@ -164,17 +164,17 @@ let cases = rather than a hand-typed "ef-lent-ember-wed" -- closes review finding 3's coupling concern for the Ember prefixes specifically. *) ("18 Lent Ember Wednesday (from Temporal_ef.temporal)", off (-39), of_temporal (off (-39)), 18); - (* Entry 19 -- register line 344. *) + (* Entry 19 -- RG 91 entry 19 (§4). *) ( "19 Proper II-class feast", mk 2026 1 20, cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Saint ~layer:"diocese-warsaw" "ef-local-saint-2", 19 ); - (* Entry 20 -- register line 345. *) + (* Entry 20 -- RG 91 entry 20 (§4). *) ( "20 Indult II-class feast", mk 2026 1 20, cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Saint ~layer:(PE.indult_prefix ^ "local-grant-2") "ef-indult-feast-2", 20 ); - (* Entry 21 -- register line 345 (RG 28-34). Two rows: the Ascension + (* Entry 21 -- RG 91 entry 21 (§4, RG 28-34). Two rows: the Ascension Vigil is the one II-class vigil temporal_ef already produces today (temporal-origin); the Assumption Vigil stands in for the sanctoral-origin case no task has loaded data for yet -- proving @@ -194,12 +194,12 @@ let cases = cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Lord ~layer:PE.universal_layer "ef-precious-blood-vigil", 21 ); - (* Entry 22 -- register line 347-348 (corrected: ends at Palm Sunday, not + (* Entry 22 -- RG 91 entry 22 (§4) (corrected: ends at Palm Sunday, not Passion Sunday). Both a Lent and a Passiontide feria, clear of Ash Wednesday, Holy Week and the Ember days. *) ("22 Lent feria", off (-41), cand ~rank:V.Class3 "ef-lent-1-mon", 22); ("22 Passiontide feria", off (-12), cand ~rank:V.Class3 "ef-passiontide-1-tue", 22); - (* Entry 23 -- register line 349. NOTE the table's own order here is the + (* Entry 23 -- RG 91 entry 23 (§4). NOTE the table's own order here is the REVERSE of 11/12 and 14/16/19/20 above: entry 23 (particular calendars) is numbered BELOW entry 24 (universal), so a proper III-class feast outranks a universal one -- transcribed as the @@ -207,13 +207,13 @@ let cases = ( "23 Proper III-class feast (non-base layer)", mk 2026 6 30, cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:"diocese-warsaw" "ef-local-saint-3", 23 ); - (* Entry 24 -- register line 349. *) + (* Entry 24 -- RG 91 entry 24 (§4). *) ( "24 Universal III-class feast", mk 2026 6 30, cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "ef-some-saint-3", 24 ); - (* Entry 25 -- register line 350. *) + (* Entry 25 -- RG 91 entry 25 (§4). *) ("25 Advent feria to 16 Dec", mk 2026 12 1, cand ~rank:V.Class3 "ef-advent-1-tue", 25); - (* Entry 26 -- register line 350. *) + (* Entry 26 -- RG 91 entry 26 (§4). *) ( "26 III-class vigil", mk 2026 8 9, cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "ef-lawrence-vigil", 26 ); @@ -238,12 +238,12 @@ let cases = mk 2026 8 9, cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "vigil-of-st-lawrence", 26 ); - (* Entry 27 -- register line 352: an otherwise-unoccupied IV-class + (* Entry 27 -- RG 91 entry 27 (§4): an otherwise-unoccupied IV-class Saturday. *) ( "27 Office of the BVM on Saturday", off 62, cand ~rank:V.Class4 "ef-time-after-pentecost-1-sat", 27 ); - (* Entry 28 -- register line 352: the unqualified IV-class catch-all. *) + (* Entry 28 -- RG 91 entry 28 (§4): the unqualified IV-class catch-all. *) ("28 IV-class feria", off 65, cand ~rank:V.Class4 "ef-time-after-pentecost-1-tue", 28); (* Not an RG 91 row at all: a I-class candidate marked as a vigil, which is not the Nativity or Pentecost (entries 5/9, the only I-class @@ -264,7 +264,7 @@ let cases = [not is_temporal] guard's role in the entry-25 mutation test recorded in the task report). *) ("unclassified: I-class temporal candidate on an unnamed date", mk 2026 7 15, cand "ef-unnamed-day", PE.unclassified); - (* RG 91's own vigil list (register lines 381-384) stops at III class -- + (* RG 91's own vigil list (§4, "Vigils / octaves / Rogations / Sunday classes") stops at III class -- there is no IV-class vigil for entry 28's ferial catch-all to absorb. *) ( "unclassified: IV-class candidate marked as a vigil", mk 2026 6 20, cand ~rank:V.Class4 "ef-second-mystery-vigil", PE.unclassified ) @@ -298,7 +298,7 @@ let test_all_souls_yields_to_sunday () = (S.to_string resolution.P.observed.P.cel.Cel.slug) (* Task 8: [disposition] -- what happens to the day's LOSING candidate (RG - 92-95, 33, 94; register lines 316-325, 381-384). Table-driven like [band]'s + 92-95, 33, 94; §4). Table-driven like [band]'s own [cases] above, one row per rule, each checked against a description of which register clause it pins. [disposition] takes no context (see precedence.mli's [rules.disposition]), so "is the winner a Sunday" is read @@ -320,7 +320,7 @@ let an_ordinary_sunday = cand ~rank:V.Class2 "ef-time-after-pentecost-sunday-11" let disposition_cases = - [ (* RG 95 -- register line 323-325: only I-class feasts transfer; a + [ (* RG 95 -- §4, "Occurrence": only I-class feasts transfer; a II-class feast loses to a I-class day and is COMMEMORATED, not transferred. Paired with the next row (a I-class loser, same shape of winner) so the discriminating factor is provably the LOSER's own @@ -334,14 +334,14 @@ let disposition_cases = cand "ef-nativity", cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-local-i-class-feast", "Transfer" ); - (* Fix round 1 (post-Task-9 review): RG 95 (register lines 323, 363) + (* Fix round 1 (post-Task-9 review): RG 95 (§4, "Occurrence" and "Transfer/translation") restricts the right of translation to I-class FEASTS -- RG 91's own - table lists Sundays as a separate row (entry 6, register line 332) - from feasts (entries 11-13, lines 337-339) -- so an impeded I-class + table lists Sundays as a separate row (entry 6) + from feasts (entries 11-13) -- so an impeded I-class Sunday must NOT transfer, unlike the plain I-class feast row above: same [Class1] rank, same kind of winner, the ONLY difference is that - this loser's slug carries [PE.sunday_marker]. RG 109(a) (register - line 374) confirms this from the other direction: "of a Sunday" is a + this loser's slug carries [PE.sunday_marker]. RG 109(a) (§4) + confirms this from the other direction: "of a Sunday" is a privileged commemoration category, which presupposes an impeded Sunday stays put rather than moving to another day the way a feast does. Sourced from [Temporal_ef.temporal]'s own real output (Advent I @@ -356,8 +356,9 @@ let disposition_cases = cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-immaculate-conception", of_temporal (T.advent_start 2026), "Commemorate(Privileged)" ); - (* RG 33 -- register line 383-384: a I/II-class vigil impeded by any - Sunday or a I-class feast is entirely OMITTED, not commemorated. The + (* RG 33 -- §4, "Vigils / octaves / Rogations / Sunday classes": a II- or + III-class vigil impeded by any Sunday or a I-class feast is entirely + OMITTED, not commemorated. The vigil is sourced from [Temporal_ef.temporal]'s own real output (as [of_temporal]'s existing callers above do), not a hand-typed "ef-ascension-vigil", so a drift in temporal_ef's vigil-slug @@ -456,7 +457,7 @@ let disposition_cases = 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 + branch-order proof above), and RG 109(b) (§4, "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 @@ -542,7 +543,7 @@ let disposition_cases = "Commemorate(Ordinary)" ) ] -(* Task 9: [privilege_of]'s RG 109 categories (register lines 374-377), +(* Task 9: [privilege_of]'s RG 109 categories (§4, "Commemorations"), 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 @@ -560,14 +561,14 @@ let disposition_cases = 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, + [ (* (a) RG 109(a) (§4): "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" -- + (* (c) RG 109(c) (§4): "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 @@ -577,7 +578,7 @@ let privilege_cases = cand "ef-nativity", of_temporal (mk 2026 12 29), "Commemorate(Privileged)" ); - (* (d) register line 375-376: "of September Ember days" -- 23 Sep 2026 is + (* (d) RG 109(d) (§4): "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 @@ -593,7 +594,7 @@ let privilege_cases = cand "ef-nativity", of_temporal (mk 2026 9 23), "Commemorate(Privileged)" ); - (* (e) register line 376: "of ferias of Advent, Lent and Passiontide" -- + (* (e) RG 109(e) (§4): "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. *) @@ -666,7 +667,7 @@ let privilege_cases = "Omit" ) ] -(* Task 9: [PE.admit] -- RG 111's admission counts (register line 378), +(* Task 9: [PE.admit] -- RG 111's admission counts (§4, "Commemorations"), 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 @@ -719,7 +720,7 @@ 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." *) + [ (* RG 111 (§4): "I class: none save one privileged." *) ( "I-class day, only an ordinary commemoration due -> none admitted", observed_class1, [ (ordinary_hi, P.Ordinary) ], @@ -928,7 +929,7 @@ let test_ii_class_sunday_privileged_witness_admitted_end_to_end () = [ ("ef-some-saint", "omitted: admission limit reached") ] (List.map (fun (c, reason) -> (S.to_string c.P.cel.Cel.slug, reason)) resolution.P.omitted) -(* Completes Task 7's carried fix (register line 334): on a real Sunday +(* Completes Task 7's carried fix (RG 91 entry 8, §4): 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 be TRANSFERRED, not commemorated and not omitted. All Souls is I class -- cgit v1.3 From ac569e859be08320e47909e496d6e5e8f6057da7 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 12 Aug 2026 10:40:12 +0200 Subject: docs+test: small factual corrections (item 7, part 1) Six independent, small corrections found during the final review: - dune (workspace root): the comment said the stanza used "(:standard)" to preserve dune's default `default` alias target; the stanza actually spells that out explicitly via (alias_rec install). Comment now matches the code. - test_validate.ml's test_easter_extremes asserted `List.length ys = 2` where an identity check was called for -- the comment already named 1598 and 1666, but nothing confirmed extreme_years() found THOSE two rather than some other pair with the right cardinality. Now asserts the identities directly (the project's "cardinality where identity was required" vacuity flavour, per the review). - test_oracle.ml and expected-divergences-missalemeum.sexp both claimed "one entry (M13) is [verdict open]" -- M11 is open too (its own verdict changed from colitur to open in fix round 1); both now say "two entries (M11 and M13)". - expected-divergences-missalemeum.sexp's M2 note attributed `band` to temporal_ef.ml; `band` is precedence_ef.ml's own function. - lib/kernel/precedence.mli documented `dropped`/`admit`'s physical- equality obligation nowhere -- it lived only in one rite's own module (Rite_ef.Precedence_ef.admit's doc comment), but this signature is what an author of the next rite actually reads. Added the obligation here, cross-referencing the EF instance as precedent, not the only source. - README's opam install line omitted sexplib and ppx_sexp_conv (both in dune-project's own depends; `dune build` fails without them for a contributor following the README verbatim) and documented only `colitur easter`, though `temporal` and `day` both exist and are the more useful entry points. Fixed both. No behaviour change: comment/doc/test-assertion corrections only (the easter-extremes fix strengthens an assertion, it does not change what passes). Verified byte-identical `colitur day` output across 1583, 1900, 1902, 2008, 2011, 2026, 2038, 9999. 259/259 tests green. --- README.md | 6 ++++-- data/ef/expected-divergences-missalemeum.sexp | 9 ++++++--- dune | 7 ++++--- lib/kernel/precedence.mli | 18 +++++++++++++++++- test/test_oracle.ml | 10 +++++++--- test/test_validate.ml | 13 ++++++++++--- 6 files changed, 48 insertions(+), 15 deletions(-) (limited to 'lib') diff --git a/README.md b/README.md index e5a6c5f..9b11d73 100644 --- a/README.md +++ b/README.md @@ -12,10 +12,12 @@ reading citations, correct to year 9999. See the design and rules research under ```sh opam switch create . 5.2.0 -y # first time: local OCaml switch -opam install -y dune alcotest qcheck qcheck-alcotest +opam install -y dune alcotest qcheck qcheck-alcotest sexplib ppx_sexp_conv dune build dune test -dune exec colitur -- easter 2026 +dune exec colitur -- easter 2026 # Easter and its Easter-relative anchors +dune exec colitur -- temporal 2026 # the EF temporal cycle only, one line per day +dune exec colitur -- day 2026 # the full resolved EF calendar (temporal + sanctoral) ``` ## License diff --git a/data/ef/expected-divergences-missalemeum.sexp b/data/ef/expected-divergences-missalemeum.sexp index 5dbe3ed..f50898b 100644 --- a/data/ef/expected-divergences-missalemeum.sexp +++ b/data/ef/expected-divergences-missalemeum.sexp @@ -16,9 +16,12 @@ ; did not build. Those are honestly verdicted [missalemeum] -- colitur is ; short a feature or a row, not correct -- and each is cross-referenced ; into docs/research/rules-register.md §6 as an open item, not silently -; absorbed as if colitur were right. One entry (M13) is [verdict open]: +; absorbed as if colitur were right. TWO entries (M11 and M13) are +; [verdict open] -- corrected, final fix wave, item 7: this note previously +; said "one entry (M13)", missing M11 (whose own verdict changed from +; [colitur] to [open] in fix round 1, see M11's own entry below). Both are ; adjudicated as UNRESOLVED after real primary-source effort, not defaulted -; past -- see that entry's own note and the task report for the full +; past -- see each entry's own note and the task report for the full ; search. ; ; [expected_rows] is the exact row count this entry accounts for over the @@ -38,7 +41,7 @@ ((id M2) (citation "RG 91 entry 27 (\"Officium sanctae Mariae in sabbato\") -- register §4") (verdict missalemeum) - (note "Every otherwise-unoccupied IV-class Saturday should carry the votive Office of the BVM (white; missalemeum's own titles cycle \"I\"..\"V Mass of the B. V. M. -- Salve, Sancta Parens\"). temporal_ef.ml's [band] already has an entry-27 comment acknowledging this row exists, but [Temporal_ef.temporal] never actually CONSTRUCTS this office -- an unimpeded Time-after-Epiphany/-Pentecost Saturday gets a bare ferial slug and season green instead. A genuine feature gap, not a citation dispute; tracked in register §6, not built in this task.") + (note "Every otherwise-unoccupied IV-class Saturday should carry the votive Office of the BVM (white; missalemeum's own titles cycle \"I\"..\"V Mass of the B. V. M. -- Salve, Sancta Parens\"). precedence_ef.ml's [band] already has an entry-27 comment acknowledging this row exists (corrected attribution, final fix wave: this note previously said temporal_ef.ml, but [band] is precedence_ef.ml's own function), but [Temporal_ef.temporal] never actually CONSTRUCTS this office -- an unimpeded Time-after-Epiphany/-Pentecost Saturday gets a bare ferial slug and season green instead. A genuine feature gap, not a citation dispute; tracked in register §6, not built in this task.") (expected_rows 17)) ((id M3) (citation "RG 87 (Minor Litanies/Rogations, Mon/Tue before Ascension) -- the SAME citation as the lectio allow-list's own C8 (data/ef/expected-divergences.sexp)") diff --git a/dune b/dune index de5051c..8a00001 100644 --- a/dune +++ b/dune @@ -12,9 +12,10 @@ ; test suite could not have caught this on its own -- it took a genuinely ; clean rebuild to surface it. ; -; (:standard) keeps whatever `default` would otherwise resolve to (the -; package's own install artifacts -- executables, libraries) so this ADDS a -; requirement rather than replacing dune's own default behaviour. +; (alias_rec install) keeps whatever `default` would otherwise resolve to +; (the package's own install artifacts -- executables, libraries, reached +; recursively through every subdirectory's own `install` alias) so this +; ADDS a requirement rather than replacing dune's own default behaviour. (alias (name default) (deps diff --git a/lib/kernel/precedence.mli b/lib/kernel/precedence.mli index d30e5c3..4225eb7 100644 --- a/lib/kernel/precedence.mli +++ b/lib/kernel/precedence.mli @@ -38,7 +38,23 @@ type ('s, 'r) rules = { ('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. *) + dropped. + + 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 ... }] + record update, even one that copies every field back unchanged). + {!resolve}'s own [omitted] accounting distinguishes an admitted + candidate from a dropped one by PHYSICAL equality ([==]) on the + candidate value, not structural equality -- a rebuilt record is + [=] to the original but not [==], so {!resolve} would then count + it as dropped a SECOND time (once because it is genuinely absent + from the admitted set, once because its identity no longer + matches its own admitted copy), silently double-counting rather + than raising. This obligation previously lived only in one rite's + own module documentation (Rite_ef.Precedence_ef.admit); stated + here because this signature -- not any one rite's implementation + of it -- is what an author of the next rite reads. *) } (** The outcome of resolving one day's candidates. *) diff --git a/test/test_oracle.ml b/test/test_oracle.ml index 152464a..ac8d95d 100644 --- a/test/test_oracle.ml +++ b/test/test_oracle.ml @@ -56,9 +56,13 @@ entries; RG 110's inseparable-Peter/Paul commemoration is unimplemented code, a real feature this task did not build) -- honestly verdicted [missalemeum] (colitur is short a feature or a row, not right), never - silently absorbed as if colitur were correct. One entry (M13) is - [verdict open]: adjudicated as unresolved, not resolved either way -- - the brief's own explicit permission ("say so as an open item") used for + silently absorbed as if colitur were correct. TWO entries (M11 and + M13) are [verdict open] -- CORRECTED, final fix wave, item 7: this + comment previously said "one entry (M13)", missing M11, whose own + verdict was changed from [colitur] to [open] in fix round 1 (see M11's + own entry below for why) but this summary was never updated to match. + Both are adjudicated as unresolved, not resolved either way -- the + brief's own explicit permission ("say so as an open item") used for real, not defaulted past. See the task report for every entry's full reasoning and primary-source citation. *) diff --git a/test/test_validate.ml b/test/test_validate.ml index ee7f288..89053c1 100644 --- a/test/test_validate.ml +++ b/test/test_validate.ml @@ -79,9 +79,16 @@ let test_easter_extremes () = let ys = extreme_years () in (* Both extremes genuinely occur in 1583..2500 (earliest 1598, latest 1666 -- verified against Computus.gregorian_easter directly, not - transcribed); requiring just "non-empty" would have passed even if the - search silently found only one of them (register finding 15). *) - Alcotest.(check int) "found both extreme years (earliest 22 Mar and latest 25 Apr)" 2 (List.length ys); + transcribed). CORRECTED (final fix wave, item 7): this used to assert + only [List.length ys = 2], a cardinality check where an identity check + was called for -- the comment already named 1598 and 1666, but nothing + confirmed [ys] actually contained THOSE two years rather than some + other pair the search happened to find first; a version of + [extreme_years] that silently found the wrong two years but still + found exactly two would have passed this unchanged. Asserting the + identities directly is strictly stronger and costs nothing extra. *) + Alcotest.(check (list int)) "found exactly 1598 (earliest 22 Mar) and 1666 (latest 25 Apr)" + [ 1598; 1666 ] ys; List.iter check_year ys (* The confidence-to-9999 core: random years across the whole domain. *) -- cgit v1.3 From 6d6ba502d8022d9e0b8cdc5302f5761d39895192 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 12 Aug 2026 10:40:27 +0200 Subject: kernel+rite-ef: correct stale plan-relative deferrals (item 7, part 2) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Several comments described work as "arriving with Plan 3" or "waiting for Plan 3" that either shipped without it or refer to the wrong future plan number, all now false in ways that would mislead the next reader: - temporal_ef.ml (two places) and precedence_ef.ml said the Major Litanies (25 April, RG 80) "arrive with Plan 3's sanctoral". Plan 3 shipped, in this branch, without them; register §6 tracks this as a plain open item with no plan committed to build it, and now says so. - temporal_ef.ml said the Sacred Triduum's "own named offices are a Plan 3 sanctoral addition". Wrong on two counts: Plan 3 shipped without adding them, AND a proper office for I-class FERIAS was never a sanctoral matter in the first place (RG 21 defines "feria" to exclude Sundays/feasts, not the reverse). 2026-04-02/03/04 still resolve to the ordinary Passiontide ferial fallback's own generic slugs (ef-passiontide-2-{thursday,friday,saturday}), confirmed against real output; register §6 now records this as its own open item. - temporal_ef.ml said the Rogation-Wednesday commemoration (Ascension Vigil day, entry 21) "waits for RG 108-111" -- both the precedence framework and RG 108-111 exist now; the Wednesday's own commemoration is still never constructed, but for a different, still-real reason (no candidate is wired for it), not a forward dependency. Fixed at both of this comment's two occurrences in the file. - vocab.ml/vocab.mli's `seasons` field doc said "Validate's contiguity check reads this" -- false since validate.ml's "seasons" check switched to Rite.t.season_runs in this branch (rite-supplied, to support a season appearing in more than one run, which the modern form's Ordinary Time needs and EF does not). - vocab.ml/vocab.mli's `ranks` field doc said "it is not a precedence relation until Plan 3 defines one" -- Plan 3 did define one (RG 111's dignity ordering), but as its own small, separately-hardcoded function in precedence_ef.ml, not one derived from this field; corrected to say so precisely rather than leaving a forward-looking claim unresolved. - The lectionary bootstrap (reading citations, Liturgical_day.t's own `citations` field) is called "Plan 3" at slug.ml, vocab_ef.ml, and three places in temporal_ef.ml, but "Plan 4" at liturgical_day.mli (whose own doc comment -- "always empty until Plan 4" -- is the authoritative one: the SANCTORAL bootstrap is Plan 3 and shipped; the LECTIONARY bootstrap is a separate, later Plan 4). All six corrected to say Plan 4, cross-referencing the Plan 3/4 distinction at the first (slug.ml) occurrence so the reasoning is not duplicated six times. No behaviour change: every edit here is a comment/documentation correction. Verified byte-identical `colitur day` output across 1583, 1900, 1902, 2008, 2011, 2026, 2038, 9999. 259/259 tests green. --- lib/kernel/slug.ml | 8 +++- lib/kernel/vocab.ml | 25 +++++++++++-- lib/kernel/vocab.mli | 25 +++++++++++-- lib/rites/rite_ef/precedence_ef.ml | 12 +++--- lib/rites/rite_ef/temporal_ef.ml | 77 +++++++++++++++++++++++++++----------- lib/rites/rite_ef/vocab_ef.ml | 5 ++- 6 files changed, 117 insertions(+), 35 deletions(-) (limited to 'lib') diff --git a/lib/kernel/slug.ml b/lib/kernel/slug.ml index 5139c99..25281f2 100644 --- a/lib/kernel/slug.ml +++ b/lib/kernel/slug.ml @@ -1,6 +1,10 @@ (* Stable celebration identifiers. Also the lectionary key: EF slugs are adopted - verbatim from lectio so the Plan 3 lectionary bootstrap needs no mapping - table (spec §4.4). *) + verbatim from lectio so the Plan 4 lectionary bootstrap needs no mapping + table (spec §4.4). CORRECTED (final fix wave, item 7): this comment said + "Plan 3" -- the SANCTORAL bootstrap (data/ef/sanctoral.sexp) is Plan 3 and + shipped in this branch; the LECTIONARY bootstrap (reading citations, + Liturgical_day.t's own [citations] field) is a separate, later Plan 4, + per that field's own doc comment ("always empty until Plan 4"). *) type t = string let valid_char c = (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') || c = '-' diff --git a/lib/kernel/vocab.ml b/lib/kernel/vocab.ml index 78729bb..bcb48b8 100644 --- a/lib/kernel/vocab.ml +++ b/lib/kernel/vocab.ml @@ -7,13 +7,32 @@ parametric types natively. *) type ('s, 'r) t = { seasons : 's list; - (** canonical liturgical-year order; Validate's contiguity check reads this *) + (** canonical liturgical-year order. CORRECTED (final fix wave, item + 7): this used to say "Validate's contiguity check reads this" -- + false since validate.ml's own "seasons" check switched to + {!Colitur_kernel.Rite.t}.season_runs in this branch (Plan 2 + carried item 1: EF has each season in one run, but the modern + form's Ordinary Time does not, so the expected run sequence had + to become rite-supplied rather than derived from this field). + For EF specifically {!Rite_ef.rite_ef.ml} sets season_runs to + this very list, so the two happen to agree there, but Validate + itself no longer reads [seasons] to build its expectation. *) season_to_string : 's -> string; season_of_string : string -> 's option; ranks : 'r list; (** documentation order, highest first. Plan 2 uses it only for the - closure check -- it is not a precedence relation until Plan 3 - defines one. *) + closure check. CORRECTED (final fix wave, item 7): this used to + say "it is not a precedence relation until Plan 3 defines one" -- + Plan 3 did define one (RG 111's dignity ordering, Rite_ef. + Precedence_ef.dignity/compare_dignity), but as its OWN small, + separately-hardcoded function, not one derived from this field: + [admit] needs Vocab_ef.rank's dignity as plain data (RG 8's four + classes), and reusing this field's own [int list] position would + couple that meaning to documentation order the way {!band} is + explicitly NOT allowed to (precedence_ef.ml's own file comment). + This field therefore still carries no precedence relation of its + own; a rite that wanted one derived from it would have to build + it itself. *) rank_to_string : 'r -> string; rank_of_string : string -> 'r option; } diff --git a/lib/kernel/vocab.mli b/lib/kernel/vocab.mli index 78729bb..bcb48b8 100644 --- a/lib/kernel/vocab.mli +++ b/lib/kernel/vocab.mli @@ -7,13 +7,32 @@ parametric types natively. *) type ('s, 'r) t = { seasons : 's list; - (** canonical liturgical-year order; Validate's contiguity check reads this *) + (** canonical liturgical-year order. CORRECTED (final fix wave, item + 7): this used to say "Validate's contiguity check reads this" -- + false since validate.ml's own "seasons" check switched to + {!Colitur_kernel.Rite.t}.season_runs in this branch (Plan 2 + carried item 1: EF has each season in one run, but the modern + form's Ordinary Time does not, so the expected run sequence had + to become rite-supplied rather than derived from this field). + For EF specifically {!Rite_ef.rite_ef.ml} sets season_runs to + this very list, so the two happen to agree there, but Validate + itself no longer reads [seasons] to build its expectation. *) season_to_string : 's -> string; season_of_string : string -> 's option; ranks : 'r list; (** documentation order, highest first. Plan 2 uses it only for the - closure check -- it is not a precedence relation until Plan 3 - defines one. *) + closure check. CORRECTED (final fix wave, item 7): this used to + say "it is not a precedence relation until Plan 3 defines one" -- + Plan 3 did define one (RG 111's dignity ordering, Rite_ef. + Precedence_ef.dignity/compare_dignity), but as its OWN small, + separately-hardcoded function, not one derived from this field: + [admit] needs Vocab_ef.rank's dignity as plain data (RG 8's four + classes), and reusing this field's own [int list] position would + couple that meaning to documentation order the way {!band} is + explicitly NOT allowed to (precedence_ef.ml's own file comment). + This field therefore still carries no precedence relation of its + own; a rite that wanted one derived from it would have to build + it itself. *) rank_to_string : 'r -> string; rank_of_string : string -> 'r option; } diff --git a/lib/rites/rite_ef/precedence_ef.ml b/lib/rites/rite_ef/precedence_ef.ml index 9997bb2..fcd2116 100644 --- a/lib/rites/rite_ef/precedence_ef.ml +++ b/lib/rites/rite_ef/precedence_ef.ml @@ -429,11 +429,13 @@ let privilege_of (c : Vocab_ef.rank Precedence.candidate) : Precedence.privilege else if is_temporal && List.exists (fun p -> String.starts_with ~prefix:p slug) alp_feria_prefixes then Precedence.Privileged (* (f) RG 109(f) (§4): "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 + Major Litanies (25 April, RG 80) are STILL not computed anywhere in + this codebase (temporal_ef.ml's own comment on [temporal]'s Rogation + branch, CORRECTED final fix wave item 7: they did not, in fact, + "arrive with Plan 3's sanctoral" -- Plan 3 shipped without them, + register §6 tracks this as an open item with no plan yet committed to + build it), 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 diff --git a/lib/rites/rite_ef/temporal_ef.ml b/lib/rites/rite_ef/temporal_ef.ml index c3db15c..7782876 100644 --- a/lib/rites/rite_ef/temporal_ef.ml +++ b/lib/rites/rite_ef/temporal_ef.ml @@ -90,7 +90,10 @@ let named d = if m = 12 && dd = 25 then Some (Christmastide, "ef-nativity", Colour.White, Class1) else if m = 12 && dd = 24 then (* RG 91 entry 5: the Vigil of the Nativity is I class. lectio has no slug - for it, so this key has no lectionary entry until Plan 3 fills it. *) + for it, so this key has no lectionary entry until Plan 4 fills it + (CORRECTED, final fix wave, item 7 -- this is the lectionary/reading- + citations bootstrap, Plan 4, not the sanctoral one, Plan 3, which + already shipped in this branch). *) Some (Advent, "ef-nativity-vigil", Colour.Violet, Class1) else if m = 12 && (dd = 29 || dd = 30 || dd = 31) then (* Days within the Octave of the Nativity; 26-28 Dec are Stephen, John and @@ -111,9 +114,15 @@ let named d = else if same d (off 7) then Some (Paschaltide, "ef-low-sunday", Colour.White, Class1) (* RG 91 entry 6 *) else if same d (off 38) then - (* RG 91 entry 21: II-class vigil. It is also Rogation Wednesday; with no - precedence framework until Plan 3, temporal emits the higher-ranked - vigil and the Rogation commemoration waits for RG 108-111. *) + (* RG 91 entry 21: II-class vigil. It is also Rogation Wednesday; [named] + emits the higher-ranked vigil (entry 21 outranks any Rogation-day + ferial rank). CORRECTED (final fix wave, item 7): this comment + previously said the Rogation commemoration itself "waits for RG + 108-111" -- the precedence framework and RG 108-111 both exist now + (this branch), but no candidate for the Rogation Wednesday's own + observance is constructed here or anywhere else, so there is nothing + for RG 108-111 to admit; see the fuller comment on the Rogation + branch further down in [temporal] for the current, still-real gap. *) Some (Paschaltide, "ef-ascension-vigil", Colour.White, Class2) else if same d (off 39) then Some (Paschaltide, "ef-ascension", Colour.White, Class1) else if same d (off 48) then Some (Paschaltide, "ef-pentecost-vigil", Colour.Red, Class1) (* RG 91 entry 9 *) @@ -183,8 +192,10 @@ let week d = this to "ef-christmas-0-", indistinguishable from the stretch above in lectio's own data. colitur cannot preserve a distinction lectio doesn't make, so this becomes "ef-christmas-1-" -- a - colitur-only key and a lectionary gap for the Plan 3 bootstrap to fill, - exactly like the Nativity vigil and octave-day keys above. + colitur-only key and a lectionary gap for the Plan 4 bootstrap to fill + (CORRECTED, final fix wave, item 7: the lectionary bootstrap is Plan 4, + not Plan 3 -- see Slug.ml's own corrected comment), exactly like the + Nativity vigil and octave-day keys above. - 7-13 Jan, split in two by the *actual* first-Sunday-after-Epiphany origin ([week_origin Time_after_epiphany], which by construction always falls somewhere in this window -- see that function's own comment): @@ -303,8 +314,10 @@ let third_sunday_of_september y = The September and Advent sets match lectio's own Ember slugs. The Lent and Whitsun (Pentecost) sets do not -- lectio has no Ember slug for either, so "ef-lent-ember-*" and "ef-pentecost-ember-*" are colitur-only keys and a - lectionary gap for the Plan 3 bootstrap to fill (spec §4.4), the same - status as the Nativity vigil and the Rogation days below. *) + lectionary gap for the Plan 4 bootstrap to fill (spec §4.4; CORRECTED, + final fix wave, item 7 -- Plan 4, not Plan 3, is the lectionary + bootstrap), the same status as the Nativity vigil and the Rogation days + below. *) let ember d = let y = Date.year d in let easter = Computus.gregorian_easter y in @@ -327,12 +340,23 @@ let ember d = (* RG 91 entry 7: Ash Wednesday (named above) and Monday-Wednesday of Holy Week are I-class ferias -- the primary text reads "feria IV cinerum et II, - III et IV Hebdomadae sanctae", i.e. explicitly stops at Wednesday. Thursday - to Saturday of Holy Week are the Sacred Triduum, RG 91 entry 2 -- ranked - even above entry 7, not a mere feria -- but their own named offices are a - Plan 3 sanctoral addition; until then this gives them the same I-class rank - via the generic ferial path. RG 91 entry 10: the weekdays within the - privileged Octaves of Easter and Pentecost are I class too. *) + III et IV Hebdomadae sanctae", i.e. explicitly stops at Wednesday + (PRIMARY-SOURCE-VERIFIED, final fix wave: confirmed word for word + against the scan). Thursday to Saturday of Holy Week are the Sacred + Triduum, RG 91 entry 2 -- ranked even above entry 7, not a mere feria -- + but the Sacred Triduum has NO PROPER OFFICE of its own in this codebase + (CORRECTED, final fix wave, item 7: this comment previously said their + "own named offices are a Plan 3 sanctoral addition"; WRONG on two + counts -- Plan 3 shipped, in this branch, without adding them, AND a + proper office for I-class FERIAS was never a sanctoral matter to begin + with, RG 21's own definition of "feria" excludes Sundays/feasts, not the + other way round). `Temporal_ef.temporal 2026-04-02/03/04` (Holy + Thursday/Good Friday/Holy Saturday) still resolve today to the ordinary + Passiontide ferial fallback's own generic slugs, + "ef-passiontide-2-{thursday,friday,saturday}" -- register §6 records + this as its own open item now. This gives them the same I-class rank + via the generic ferial path regardless. RG 91 entry 10: the weekdays + within the privileged Octaves of Easter and Pentecost are I class too. *) let privileged_feria d = let easter = Computus.gregorian_easter (Date.year d) in let n = days_between easter d in @@ -392,16 +416,27 @@ let temporal d = | None -> ( (* Rogations (the Minor Litanies only -- RG 87, Monday and Tuesday before Ascension). The Major Litanies (25 April, RG 80) are a fixed - date and are not yet computed; they arrive with Plan 3's sanctoral - (register §6). The Wednesday here is the Ascension vigil (see Task - 11). RG 88: "de Litaniis minoribus nihil fit in Officio" -- the - Office (hence the day's rank) is unchanged by the Rogation; only the - Mass is proper. No RG 91 table entry elevates these days, so they + date and are STILL not computed (CORRECTED, final fix wave, item 7: + this comment previously said "they arrive with Plan 3's sanctoral" + -- Plan 3 shipped, in this branch, without them; register §6 tracks + this as a plain open item, with no plan committed to build it yet). + The Wednesday here is the Ascension vigil (see Task 11), which + happens to also fall on Rogation Wednesday -- the vigil (higher + RG 91 entry) is what [named] emits for that date; the Rogation + Wednesday's own commemoration is not separately constructed (a real + gap, not a forward dependency: the precedence framework and RG + 108-111 both exist now, but nothing wires a Rogation-Wednesday + candidate into the contest for this specific date the way Monday + and Tuesday get one below). RG 88: "de Litaniis minoribus nihil fit + in Officio" -- the Office (hence the day's rank) is unchanged by + the Rogation; only the Mass is proper. No RG 91 table entry + elevates these days, so they take the ordinary ferial rank of their season via [ferial_rank] rather than a fixed class. lectio has no Rogation slug at all, so "ef-rogation-monday"/"-tuesday" are colitur-only keys and a - lectionary gap for Plan 3, like the Ember and Nativity-vigil keys - above. *) + lectionary gap for Plan 4 (CORRECTED, final fix wave, item 7 -- + the lectionary bootstrap is Plan 4, not Plan 3), like the Ember + and Nativity-vigil keys above. *) let rogation = days_between easter d in if rogation = 36 || rogation = 37 then build ~season:s diff --git a/lib/rites/rite_ef/vocab_ef.ml b/lib/rites/rite_ef/vocab_ef.ml index 13e7309..e5726e8 100644 --- a/lib/rites/rite_ef/vocab_ef.ml +++ b/lib/rites/rite_ef/vocab_ef.ml @@ -45,7 +45,10 @@ let season_of_string = function (* Deliberately NOT season_to_string: slugs are lectionary keys adopted verbatim from lectio, which names these two seasons differently. Changing these words - would silently break the Plan 3 lectionary bootstrap. *) + would silently break the Plan 4 lectionary bootstrap (CORRECTED, final fix + wave, item 7 -- see Slug.ml's own corrected comment for the Plan 3/4 + distinction: the sanctoral bootstrap these slugs already serve is Plan 3 + and shipped; the lectionary/reading-citations bootstrap is Plan 4). *) let season_slug_word = function | Christmastide -> "christmas" | Paschaltide -> "easter" -- cgit v1.3 From d0b78ca2ef533080d4621b22071718bb8d3a6158 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 12 Aug 2026 11:19:51 +0200 Subject: docs: close the final review's four documentation residues precedence_ef.mli said "there is no fifth, unclassified case" after the same commit renumbered the disposition list from four cases to five; the count is now six. precedence.mli's physical-equality obligation described the failure mode as counting a drop "a SECOND time (once because it is genuinely absent, once because its identity no longer matches)" -- the same condition stated twice. What actually happens to a rebuilt candidate record is that the celebration surfaces in BOTH commemorations (the copy) and omitted (the original), one admission double-reported. precedence_ef.ml carried the same muddled sentence, which is where the kernel's copy came from; both now say it plainly. vocab.ml/.mli referenced {!Rite_ef.rite_ef.ml} -- a filename inside an odoc reference, which is malformed. Now plain [Rite_ef.rite]. README documented only `dune test`, so the exhaustive 1583-9999 Validate sweep was discoverable only by reading test_validate.ml's own comment. With no CI in this repo, that line is what stands between a committed artifact and one anyone runs. No behaviour change: `colitur day` output is byte-identical across 1583, 1900, 1902, 2008, 2011, 2026, 2038 and 9999 (2921 days, both domain edges). 259 tests by default, 260 with the sweep. --- README.md | 3 ++- lib/kernel/precedence.mli | 12 +++++++----- lib/kernel/vocab.ml | 2 +- lib/kernel/vocab.mli | 2 +- lib/rites/rite_ef/precedence_ef.ml | 10 +++++----- lib/rites/rite_ef/precedence_ef.mli | 2 +- 6 files changed, 17 insertions(+), 14 deletions(-) (limited to 'lib') diff --git a/README.md b/README.md index 9b11d73..6f71f6c 100644 --- a/README.md +++ b/README.md @@ -14,7 +14,8 @@ reading citations, correct to year 9999. See the design and rules research under opam switch create . 5.2.0 -y # first time: local OCaml switch opam install -y dune alcotest qcheck qcheck-alcotest sexplib ppx_sexp_conv dune build -dune test +dune test # fast suite (~3s) +COLITUR_EXHAUSTIVE_SWEEP=1 dune test --force # + every year 1583-9999 (~50s) dune exec colitur -- easter 2026 # Easter and its Easter-relative anchors dune exec colitur -- temporal 2026 # the EF temporal cycle only, one line per day dune exec colitur -- day 2026 # the full resolved EF calendar (temporal + sanctoral) diff --git a/lib/kernel/precedence.mli b/lib/kernel/precedence.mli index 4225eb7..ae054dd 100644 --- a/lib/kernel/precedence.mli +++ b/lib/kernel/precedence.mli @@ -47,11 +47,13 @@ type ('s, 'r) rules = { {!resolve}'s own [omitted] accounting distinguishes an admitted candidate from a dropped one by PHYSICAL equality ([==]) on the candidate value, not structural equality -- a rebuilt record is - [=] to the original but not [==], so {!resolve} would then count - it as dropped a SECOND time (once because it is genuinely absent - from the admitted set, once because its identity no longer - matches its own admitted copy), silently double-counting rather - than raising. This obligation previously lived only in one rite's + [=] to the original but not [==], so {!resolve} cannot match the + rebuilt copy against the original it was given. The celebration + then surfaces TWICE in the same day's result -- once in + {!resolution.commemorations} (the rebuilt copy, admitted) and once + in {!resolution.omitted} (the original, which nothing in the + admitted set matches). One admission, double-reported, silently + rather than raising. This obligation previously lived only in one rite's own module documentation (Rite_ef.Precedence_ef.admit); stated here because this signature -- not any one rite's implementation of it -- is what an author of the next rite reads. *) diff --git a/lib/kernel/vocab.ml b/lib/kernel/vocab.ml index bcb48b8..a4e61a3 100644 --- a/lib/kernel/vocab.ml +++ b/lib/kernel/vocab.ml @@ -14,7 +14,7 @@ type ('s, 'r) t = { carried item 1: EF has each season in one run, but the modern form's Ordinary Time does not, so the expected run sequence had to become rite-supplied rather than derived from this field). - For EF specifically {!Rite_ef.rite_ef.ml} sets season_runs to + For EF specifically [Rite_ef.rite] sets season_runs to this very list, so the two happen to agree there, but Validate itself no longer reads [seasons] to build its expectation. *) season_to_string : 's -> string; diff --git a/lib/kernel/vocab.mli b/lib/kernel/vocab.mli index bcb48b8..a4e61a3 100644 --- a/lib/kernel/vocab.mli +++ b/lib/kernel/vocab.mli @@ -14,7 +14,7 @@ type ('s, 'r) t = { carried item 1: EF has each season in one run, but the modern form's Ordinary Time does not, so the expected run sequence had to become rite-supplied rather than derived from this field). - For EF specifically {!Rite_ef.rite_ef.ml} sets season_runs to + For EF specifically [Rite_ef.rite] sets season_runs to this very list, so the two happen to agree there, but Validate itself no longer reads [seasons] to build its expectation. *) season_to_string : 's -> string; diff --git a/lib/rites/rite_ef/precedence_ef.ml b/lib/rites/rite_ef/precedence_ef.ml index fcd2116..db7e708 100644 --- a/lib/rites/rite_ef/precedence_ef.ml +++ b/lib/rites/rite_ef/precedence_ef.ml @@ -685,11 +685,11 @@ let admit ~(observed : Vocab_ef.rank Precedence.candidate) 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. *) + accounting: the original would then match nothing in [admitted], so the + 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 let observed_rank = observed.Precedence.cel.Celebration.rank in diff --git a/lib/rites/rite_ef/precedence_ef.mli b/lib/rites/rite_ef/precedence_ef.mli index 161d890..55f947e 100644 --- a/lib/rites/rite_ef/precedence_ef.mli +++ b/lib/rites/rite_ef/precedence_ef.mli @@ -135,7 +135,7 @@ val sunday_marker : string can construct: [Vocab_ef.rank] (RG 8) and {!Celebration.status} are both closed variants, and the five cases above -- an if/else-if chain ending in the unconditional [Commemorate] catch-all -- exhaust every value - those two fields can take between them; there is no fifth, + those two fields can take between them; there is no sixth, "unclassified" case the way {!band} needs one, because this function's own return type has no such slot to fall into by accident. *) val disposition : -- cgit v1.3