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 ++++++++++++++++++++++++ 2 files changed, 138 insertions(+) create mode 100644 lib/kernel/calendar.ml create mode 100644 lib/kernel/calendar.mli (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 -- cgit v1.3