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 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