summaryrefslogtreecommitdiff
path: root/lib/kernel
diff options
context:
space:
mode:
authorLukasz Kasprzak <lukas@labunix.xyz>2026-08-17 17:22:43 +0200
committerLukasz Kasprzak <lukas@labunix.xyz>2026-08-17 17:22:43 +0200
commit2b9f8133a22ce6dc309644a98bbe61507f574b38 (patch)
treeedb24a59d092f56f00dcbca654224a0622725d5e /lib/kernel
parentf2a0660a9b60b70af32f1157dc78cdfcb298c9f7 (diff)
downloadcolitur-2b9f8133a22ce6dc309644a98bbe61507f574b38.tar.gz
colitur-2b9f8133a22ce6dc309644a98bbe61507f574b38.zip
feat(kernel): movable Date_spec variants, and Rogation Wednesday
Date_spec carried one variant, Fixed(month, day), and its own header said Sunday- and Easter-relative forms would arrive with the OF sanctoral. They arrive early because two things needed them at once: a user-supplied overlay carrying a local movable feast had no way to express "the first Sunday of October", and Rogation Wednesday's commemoration has been recorded as architecturally blocked since 2026-08-13. That blockage turns out to have been a premise, not a fact. The register concluded the Rogation "is not Commemoration_only sanctoral data by nature... it needs a genuinely THIRD kind of thing this architecture has no name for" -- but the reasoning rested on there being "no civil (month, day) pair to anchor a Fixed entry to". That is a statement about Date_spec's expressiveness. With Easter_offset the entity is ordinary sanctoral data, the identical shape Add major-litanies already ships, differing only in how the date is written. No third channel was needed. The register is corrected rather than left contradicting the code. Two variants: Easter_offset of int, and Nth_weekday of {month; nth; weekday} with negative nth counting from the end. Fixed's sexp representation is untouched, so all 327 sanctoral entries and the whole overlay parse unchanged. Both are re-validated in t_of_sexp through their smart constructors, extending the idiom Fixed already used -- the failure that guards against is invisible, a spec deserialising into something that silently never resolves and a celebration vanishing with no diagnostic. Easter is supplied by the rite, not computed in the kernel. Computus ships Gregorian and Julian both, and picking one here would hard-code a Roman assumption into rite-agnostic code and be silently wrong for a Julian-reckoning rite. Rite.t gains an easter field; Rite_ef supplies the Gregorian one. Layer keeps a split index. Fixed entries stay in the year-independent (month, day) table, which preserves the fast path and the "30 November counted twice in a 371-day span" behaviour validate.mli documents for St Andrew. Movable entries have no year-independent key by construction -- the same spec lands on a different (month, day) each year -- so they resolve per civil year into a rata-die table. index_by_date is removed rather than kept as an alias: two ways to index a layer, one of which silently ignores movable entries, is the trap this change exists to avoid. Two domain-edge defects, both found by the suite rather than reasoning. A liturgical year is Advent-anchored, so resolving civil year y names y +/- 1, and at the edges those are 1582 and 10000, which Computus correctly refuses by raising. The ceiling surfaced through the domain-ceiling test, the floor through `colitur day 1583` failing outright. Fixed once, in Layer.index, the single point that calls the rite's easter -- a clamp repeated per caller would have been two places to get wrong a third time. Rogation Wednesday: RG 87 assigns the Litaniae minores to the Monday, Tuesday AND Wednesday before Ascension (scan1:691); colitur built the first two from the start and never the third. RG 88 keeps it out of the Office, so the Ascension Vigil remains observed. RG 89 routes it through the Major Litanies' rules, but RG 109's closed list names only maiores, so by RG 107 it is an ORDINARY commemoration -- confirmed in the output, not assumed. Name from the Missal's own "feria IV" (scan1:20495-20497), violet to match the Monday and Tuesday offices. Blast radius, full 1583-9999 sweep against the pre-change binary: 2257 days, every one the same shape, zero unclassified, line counts equal both sides. The complement is the informative half -- in the other 6160 years the Rogation does not appear at all, because RG 111 admits one commemoration on a II-class day and an impeded feast takes it under RG 113, a Commemoration_only candidate having no row in RG 91's table. Both shapes are pinned. Allow-lists unmoved: layer 3 compares no commemorations and is blind by construction, and layer 4's 2026-2027 window has a competing feast on both Wednesdays, so the Rogation is capped out in exactly the years the oracle can see. C8 is unchanged, asserted by its own count pin. Not built: Sunday-relative specs, which nothing needs yet, and the --overlay plumbing that would let a user actually supply a local movable feast. Nth_weekday therefore ships with synthetic and property coverage only; inventing a shipped entry to exercise it would be fabricating calendar data. Register: section 6.10.
Diffstat (limited to 'lib/kernel')
-rw-r--r--lib/kernel/calendar.ml22
-rw-r--r--lib/kernel/date_spec.ml120
-rw-r--r--lib/kernel/date_spec.mli46
-rw-r--r--lib/kernel/layer.ml65
-rw-r--r--lib/kernel/layer.mli25
-rw-r--r--lib/kernel/rite.ml1
-rw-r--r--lib/kernel/rite.mli7
-rw-r--r--lib/kernel/validate.ml11
8 files changed, 250 insertions, 47 deletions
diff --git a/lib/kernel/calendar.ml b/lib/kernel/calendar.ml
index 724641d..99992b3 100644
--- a/lib/kernel/calendar.ml
+++ b/lib/kernel/calendar.ml
@@ -58,7 +58,7 @@ let year_bounds (rite : ('s, 'r) Rite.t) (y : int) : Date.t * Date.t =
[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)
+let resolve_with_injected (rite : ('s, 'r) Rite.t) (idx : 'r Layer.index)
(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
@@ -66,7 +66,7 @@ let resolve_with_injected (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date)
{ Precedence.cel = temporal.Temporal.office; origin = Precedence.Temporal }
in
let natural =
- Layer.on_date idx ~month:(Date.month date) ~day:(Date.day date)
+ Layer.on_date idx date
|> List.map (fun (e : 'r Layer.entry) ->
{ Precedence.cel = e.Layer.cel; origin = Precedence.Sanctoral })
in
@@ -81,7 +81,7 @@ let resolve_with_injected (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date)
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)
+let occupant_of (rite : ('s, 'r) Rite.t) (idx : 'r Layer.index)
(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
@@ -185,7 +185,7 @@ let injected_index_of_assignment (assignment : (string, Date.t * Date.t) Hashtbl
[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)
+let place_transfers (rite : ('s, 'r) Rite.t) (idx : 'r Layer.index) ~(start : Date.t)
~(stop : Date.t) (dates : Date.t array) :
(string, Date.t * Date.t) Hashtbl.t
* (string, 'r Precedence.candidate) Hashtbl.t
@@ -273,7 +273,7 @@ let place_transfers (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) ~(start :
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)
+let build_day (rite : ('s, 'r) Rite.t) (idx : 'r Layer.index)
(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)
@@ -442,7 +442,15 @@ let build_day (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date)
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
+ (* A liturgical year is Advent-anchored and straddles two civil years --
+ [year_start y .. year_start (y+1) - 1] -- so BOTH must be resolved for
+ movable entries, or a movable feast in the tail of the span silently
+ vanishes. *)
+ (* A liturgical year straddles two civil years, so both are named.
+ [Layer.index] filters them to the kernel domain, which is what keeps
+ the edges (y = 1583 naming 1582, y = 9999 naming 10000) from
+ calling the rite's [easter] out of range. *)
+ let idx = Layer.index layer ~easter:rite.Rite.easter ~years:[ y - 1; y; y + 1 ] 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
@@ -468,7 +476,7 @@ let year (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) (y : int) :
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
+ forbid one. [Layer.index] 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
diff --git a/lib/kernel/date_spec.ml b/lib/kernel/date_spec.ml
index 732f6b1..6b328df 100644
--- a/lib/kernel/date_spec.ml
+++ b/lib/kernel/date_spec.ml
@@ -1,14 +1,33 @@
open Sexplib0.Sexp_conv
-(* How a sanctoral entry expresses its date. Plan 2 ships the only form the EF
- sanctoral needs -- a fixed calendar date -- because EF movable feasts come
- from the rite's temporal code, not from data. Sunday-relative and
- Easter-relative forms arrive with the OF sanctoral. *)
+(* How a sanctoral entry expresses its date.
+
+ Plan 2 shipped [Fixed] alone, and this file's own header then said
+ "Sunday-relative and Easter-relative forms arrive with the OF sanctoral".
+ They arrive here instead, ahead of OF, because two things needed them at
+ once: user-supplied overlays carrying LOCAL MOVABLE FEASTS (a patronal
+ feast on "the first Sunday of October" was simply inexpressible), and
+ ROGATION WEDNESDAY's own commemoration (RG 87/88/89), recorded as
+ architecturally blocked since 2026-08-13 for exactly one reason -- its
+ trigger is Easter+38, and there is no (month, day) pair a [Fixed] spec
+ could anchor to.
+
+ Sunday-relative forms ("the Sunday on or after 2 November") are still NOT
+ built: no entry in this repository needs one, and the same mechanism adds
+ them when one does. See
+ docs/superpowers/specs/2026-08-17-colitur-movable-date-specs-design.md. *)
module Repr = struct
- type t = Fixed of { month : int; day : int } [@@deriving sexp]
+ type t =
+ | Fixed of { month : int; day : int }
+ | Easter_offset of int
+ | Nth_weekday of { month : int; nth : int; weekday : Date.weekday }
+ [@@deriving sexp]
end
-type t = Repr.t = Fixed of { month : int; day : int }
+type t = Repr.t =
+ | Fixed of { month : int; day : int }
+ | Easter_offset of int
+ | Nth_weekday of { month : int; nth : int; weekday : Date.weekday }
(* Leap-year maximum, so 29 February is constructible; it simply does not
resolve in a common year. *)
@@ -24,20 +43,89 @@ let fixed ~month ~day =
Error (Printf.sprintf "date_spec: day %d out of range for month %d" day month)
else Ok (Fixed { month; day })
-let resolve t ~year =
+(* Deliberately generous rather than tight. Septuagesima is Easter-63 and Time
+ after Pentecost runs well past Easter+180, so a bound that merely LOOKED
+ precise would reject legitimate specs; a full year either way is the point
+ past which a spec is certainly a data error rather than a calendar. *)
+let easter_offset n =
+ if n < -365 || n > 365 then
+ Error (Printf.sprintf "date_spec: easter offset %d is further than a year from Easter" n)
+ else Ok (Easter_offset n)
+
+(* [nth] is 1-based forward, or negative from the end (-1 = the last). Zero is
+ meaningless, and no month has a sixth of any weekday. *)
+let nth_weekday ~month ~nth ~weekday =
+ if month < 1 || month > 12 then Error (Printf.sprintf "date_spec: month %d out of range 1..12" month)
+ else if nth = 0 then Error "date_spec: nth = 0 is meaningless (1 is the first, -1 the last)"
+ else if nth < -5 || nth > 5 then
+ Error (Printf.sprintf "date_spec: nth %d out of range (no month has six of a weekday)" nth)
+ else Ok (Nth_weekday { month; nth; weekday })
+
+(* The domain check on [Easter_offset] is load-bearing, not defensive
+ decoration: date.mli states plainly that [add_days] is "unbounded total
+ arithmetic (they may denote a date outside the domain)", so Easter+200 in
+ 9999 yields a perfectly well-formed [Date.t] that is nonetheless outside
+ 1583..9999. Returning it would leak an out-of-domain date into a [Layer]
+ index and from there into resolution. [None] is the same answer 29 February
+ already gives in a common year: "this spec does not occur". *)
+let in_domain d = Date.year d >= 1583 && Date.year d <= 9999
+
+let weekday_index = function
+ | Date.Sun -> 0
+ | Date.Mon -> 1
+ | Date.Tue -> 2
+ | Date.Wed -> 3
+ | Date.Thu -> 4
+ | Date.Fri -> 5
+ | Date.Sat -> 6
+
+(* Total: every branch returns [option], and nothing here raises on an in-range
+ year. *)
+let resolve t ~year ~easter =
match t with
| Fixed { month; day } -> Result.to_option (Date.make ~year ~month ~day)
+ | Easter_offset n ->
+ (* [easter] is the caller's Easter for THIS civil year -- the rite
+ supplies it ({!Rite.t}'s own [easter] field), so a Julian-reckoning
+ rite is never silently handed a Gregorian date. *)
+ let d = Date.add_days easter n in
+ if in_domain d then Some d else None
+ | Nth_weekday { month; nth; weekday } -> (
+ match Date.make ~year ~month ~day:1 with
+ | Error _ -> None
+ | Ok first ->
+ (* [Date.make] is the authority on month length, so no leap rule is
+ duplicated here: probe downward from 31 for the last day that
+ actually constructs. Every month has at least 28. *)
+ let rec last_day d =
+ if d <= 28 then d else if Result.is_ok (Date.make ~year ~month ~day:d) then d else last_day (d - 1)
+ in
+ let days_in_month = last_day 31 in
+ let offset_to_first = (weekday_index weekday - weekday_index (Date.weekday first) + 7) mod 7 in
+ let first_occurrence = 1 + offset_to_first in
+ let count = ((days_in_month - first_occurrence) / 7) + 1 in
+ (* Negative [nth] counts back from the end: -1 is the last. *)
+ let index = if nth > 0 then nth else count + nth + 1 in
+ if index < 1 || index > count then None
+ else Result.to_option (Date.make ~year ~month ~day:(first_occurrence + ((index - 1) * 7))))
let sexp_of_t = Repr.sexp_of_t
(* Validating parser, matching Slug and Lang: [ppx_sexp_conv]'s derived
- [t_of_sexp] (relocated to [Repr] above) accepts any in-range int pair, so
- [(Fixed (month 13) (day 40))] would otherwise deserialise into a spec that
- silently never resolves -- a saint quietly vanishing with no diagnostic.
- Re-running the value through [fixed] closes that gap the same way loaders
- already close it for slugs and language codes. *)
+ [t_of_sexp] (relocated to [Repr] above) accepts any in-range int, so
+ [(Fixed (month 13) (day 40))] or [(Nth_weekday (month 10) (nth 0) ...)]
+ would otherwise deserialise into a spec that silently never resolves -- a
+ celebration quietly vanishing with no diagnostic. Re-running the value
+ through the smart constructors closes that gap the same way loaders already
+ close it for slugs and language codes.
+
+ EVERY variant is re-validated here. Adding one without extending this
+ function reopens exactly the hole it exists to close, and the failure mode
+ is invisible: nothing errors, a feast simply never appears. *)
let t_of_sexp sexp =
- let (Fixed { month; day }) = Repr.t_of_sexp sexp in
- match fixed ~month ~day with
- | Ok t -> t
- | Error msg -> Sexplib0.Sexp_conv.of_sexp_error msg sexp
+ let reject msg = Sexplib0.Sexp_conv.of_sexp_error msg sexp in
+ match Repr.t_of_sexp sexp with
+ | Fixed { month; day } -> ( match fixed ~month ~day with Ok t -> t | Error msg -> reject msg)
+ | Easter_offset n -> ( match easter_offset n with Ok t -> t | Error msg -> reject msg)
+ | Nth_weekday { month; nth; weekday } -> (
+ match nth_weekday ~month ~nth ~weekday with Ok t -> t | Error msg -> reject msg)
diff --git a/lib/kernel/date_spec.mli b/lib/kernel/date_spec.mli
index 3fe9625..70a3030 100644
--- a/lib/kernel/date_spec.mli
+++ b/lib/kernel/date_spec.mli
@@ -1,9 +1,45 @@
-(** A sanctoral entry's date expression. *)
-type t = Fixed of { month : int; day : int } [@@deriving sexp]
+(** A sanctoral entry's date expression.
+
+ [Fixed] is a civil (month, day) that recurs every year. The other two move:
+ [Easter_offset] is a signed day count from the rite's own Easter, and
+ [Nth_weekday] is the nth (or nth-from-last) given weekday of a month.
+
+ Sunday-relative forms ("the Sunday on or after 2 November") are
+ deliberately absent: nothing in this repository needs one yet, and the same
+ mechanism admits them when something does. *)
+type t =
+ | Fixed of { month : int; day : int }
+ | Easter_offset of int
+ | Nth_weekday of { month : int; nth : int; weekday : Date.weekday }
+[@@deriving sexp]
(** Validates against the leap-year maximum, so 29 February is constructible. *)
val fixed : month:int -> day:int -> (t, string) result
-(** [None] when the spec does not occur in that year (29 February in a common
- year) or falls outside the supported domain. *)
-val resolve : t -> year:int -> Date.t option
+(** Rejects an offset further than a year from Easter in either direction --
+ past that, a spec is a data error rather than a calendar. Deliberately
+ generous: Septuagesima is Easter-63 and Time after Pentecost runs well past
+ Easter+180. *)
+val easter_offset : int -> (t, string) result
+
+(** [nth] is 1-based forward, or negative from the end ([-1] is the last).
+ Rejects [nth = 0] (meaningless), [|nth| > 5] (no month has six of any
+ weekday), and a month outside 1..12. *)
+val nth_weekday : month:int -> nth:int -> weekday:Date.weekday -> (t, string) result
+
+(** [resolve spec ~year ~easter] is the civil date [spec] denotes in [year],
+ where [easter] is that year's Easter as the RITE reckons it -- supplied by
+ the caller, never computed here, since {!Computus} ships both Gregorian and
+ Julian and choosing one in the kernel would be silently wrong for a
+ Julian-reckoning rite.
+
+ [None] means "this spec does not occur in that year", per variant:
+ - [Fixed]: 29 February in a common year, or a date outside 1583..9999.
+ - [Easter_offset]: the resolved date falls outside 1583..9999. This is
+ reachable at the domain edges -- {!Date.add_days} is unbounded total
+ arithmetic and will happily denote a date outside the domain.
+ - [Nth_weekday]: the month has no such occurrence (a fifth Sunday it
+ lacks).
+
+ Total: never raises on any in-range year, for any constructible spec. *)
+val resolve : t -> year:int -> easter:Date.t -> Date.t option
diff --git a/lib/kernel/layer.ml b/lib/kernel/layer.ml
index 515b052..ec074a7 100644
--- a/lib/kernel/layer.ml
+++ b/lib/kernel/layer.ml
@@ -20,26 +20,63 @@ let set t entry =
let t = remove t entry.cel.Celebration.slug in
{ t with entries = canonical (entry :: t.entries) }
-(* Dates are year-independent, so the index is built once per layer rather than
- once per year -- a full 1583..9999 sweep would otherwise rescan the entry
- list for every day. *)
-type 'r by_date = (int * int, 'r entry list) Hashtbl.t
+(* FIXED entries are year-independent, so their table is built once and keyed
+ (month, day) -- a full 1583..9999 sweep would otherwise rescan the entry
+ list for every day.
-let key = function Date_spec.Fixed { month; day } -> (month, day)
+ MOVABLE entries have no such key BY CONSTRUCTION: the same spec lands on a
+ different (month, day) in different years, so one year-independent table
+ cannot serve a multi-year span. They are resolved once per civil year in
+ the span and keyed by rata die instead.
-let index_by_date t =
- let tbl : 'r by_date = Hashtbl.create 512 in
+ Keeping the two separate, rather than resolving everything per year,
+ preserves the fixed path exactly as it was -- including the "30 November
+ counted twice in a 371-day liturgical span" behaviour validate.mli
+ documents for St Andrew, which falls straight out of querying by (month,
+ day) and would have to be re-established by hand under a uniform rata-die
+ index. *)
+type 'r index = {
+ fixed : (int * int, 'r entry list) Hashtbl.t;
+ movable : (int, 'r entry list) Hashtbl.t; (** keyed by rata die *)
+}
+
+let index t ~easter ~years =
+ (* Filter to the kernel domain BEFORE calling [easter] on anything. A
+ liturgical year is Advent-anchored, so a caller resolving civil year [y]
+ legitimately names [y - 1] or [y + 1] -- and at the two edges those are
+ 1582 and 10000, which {!Computus} correctly refuses by raising. Both
+ edges bit during development (the ceiling via the domain-ceiling test,
+ the floor via `colitur day 1583`), which is why the guard lives HERE, at
+ the single point that calls [easter], rather than as a clamp repeated in
+ every caller. A spec cannot resolve outside 1583..9999 anyway, so
+ dropping those years loses nothing. *)
+ let years = List.filter (fun y -> y >= 1583 && y <= 9999) years in
+ let fixed : (int * int, 'r entry list) Hashtbl.t = Hashtbl.create 512 in
+ let movable : (int, 'r entry list) Hashtbl.t = Hashtbl.create 32 in
+ let add tbl k e = Hashtbl.replace tbl k (e :: (try Hashtbl.find tbl k with Not_found -> [])) in
List.iter
(fun e ->
- let k = key e.date in
- Hashtbl.replace tbl k (e :: (try Hashtbl.find tbl k with Not_found -> [])))
+ match e.date with
+ | Date_spec.Fixed { month; day } -> add fixed (month, day) e
+ | _ ->
+ (* A spec resolving to nothing in a given year is not an error:
+ [Date_spec.resolve]'s own [None] means "does not occur this
+ year", the same contract 29 February has always had. *)
+ List.iter
+ (fun year ->
+ match Date_spec.resolve e.date ~year ~easter:(easter year) with
+ | Some d -> add movable (Date.to_rata d) e
+ | None -> ())
+ years)
t.entries;
- (* restore canonical order within each date bucket *)
- Hashtbl.iter (fun k v -> Hashtbl.replace tbl k (canonical v)) tbl;
- tbl
+ Hashtbl.iter (fun k v -> Hashtbl.replace fixed k (canonical v)) fixed;
+ Hashtbl.iter (fun k v -> Hashtbl.replace movable k (canonical v)) movable;
+ { fixed; movable }
-let on_date tbl ~month ~day =
- try Hashtbl.find tbl (month, day) with Not_found -> []
+let on_date idx date =
+ let f = try Hashtbl.find idx.fixed (Date.month date, Date.day date) with Not_found -> [] in
+ let m = try Hashtbl.find idx.movable (Date.to_rata date) with Not_found -> [] in
+ match m with [] -> f | _ -> canonical (f @ m)
let load rank_of_sexp path =
match Sexplib.Sexp.load_sexp path with
diff --git a/lib/kernel/layer.mli b/lib/kernel/layer.mli
index 3092353..ab6e56b 100644
--- a/lib/kernel/layer.mli
+++ b/lib/kernel/layer.mli
@@ -15,10 +15,29 @@ val remove : 'r t -> Slug.t -> 'r t
(** Date index. Built once per layer, not per year: [Date_spec] dates are
year-independent. *)
-type 'r by_date
+type 'r index
-val index_by_date : 'r t -> 'r by_date
-val on_date : 'r by_date -> month:int -> day:int -> 'r entry list
+(** [index t ~easter ~years] builds the per-date lookup for [t].
+
+ Fixed entries are keyed (month, day), year-independently, as they always
+ were. Movable entries ({!Date_spec.Easter_offset}, {!Date_spec.Nth_weekday})
+ have no year-independent key, so they are resolved once for each civil year
+ in [years] and keyed by rata die. [easter] supplies that year's Easter as
+ the RITE reckons it -- see {!Rite.t}'s own [easter] field.
+
+ [years] must list every civil year the caller's span touches. A liturgical
+ year is Advent-anchored and straddles two, so {!Calendar.year} and
+ {!Validate.run} both pass [[y; y + 1]]. A movable entry whose year is
+ omitted is simply absent from the index -- silently, so getting [years]
+ wrong loses celebrations rather than erroring.
+
+ NOTE the index is therefore no longer built once per layer independent of
+ year: for fixed entries it still is, for movable ones it is per-span. *)
+val index : 'r t -> easter:(int -> Date.t) -> years:int list -> 'r index
+
+(** Entries falling on [date], fixed and movable together, in the layer's
+ canonical slug order. *)
+val on_date : 'r index -> Date.t -> 'r entry list
(** Loads a layer from a sexp file. Parse and validation failures come back as
[Error], never as an exception. *)
diff --git a/lib/kernel/rite.ml b/lib/kernel/rite.ml
index 91326a6..600a691 100644
--- a/lib/kernel/rite.ml
+++ b/lib/kernel/rite.ml
@@ -7,6 +7,7 @@ type ('s, 'r) t = {
year_start : int -> Date.t;
temporal : Date.t -> ('s, 'r) Temporal.t;
anchors : int -> (string * Date.t) list;
+ easter : int -> Date.t;
rules : ('s, 'r) Precedence.rules;
season_runs : 's list;
transfer_target :
diff --git a/lib/kernel/rite.mli b/lib/kernel/rite.mli
index a41e034..0324bf2 100644
--- a/lib/kernel/rite.mli
+++ b/lib/kernel/rite.mli
@@ -10,6 +10,13 @@ type ('s, 'r) t = {
temporal : Date.t -> ('s, 'r) Temporal.t;
anchors : int -> (string * Date.t) list;
(** Easter-derived days: (expected slug, date) *)
+ easter : int -> Date.t;
+ (** The rite's own Easter for civil year [y]. Supplied by the rite, NOT
+ computed in the kernel: {!Computus} ships both Gregorian and Julian
+ reckonings, and choosing one here would hard-code a Roman assumption
+ into rite-agnostic code and be silently wrong for a Julian-reckoning
+ rite. Read by {!Layer.index} to resolve
+ {!Date_spec.Easter_offset}. *)
rules : ('s, 'r) Precedence.rules;
season_runs : 's list;
(** the expected run-length-compressed season sequence over one liturgical
diff --git a/lib/kernel/validate.ml b/lib/kernel/validate.ml
index 1a0248b..c9d4263 100644
--- a/lib/kernel/validate.ml
+++ b/lib/kernel/validate.ml
@@ -220,7 +220,14 @@ let run (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) ~year =
(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
+ (* Same span reasoning as {!Calendar.year}: the liturgical year
+ straddles civil [year] and [year + 1], so both are resolved for
+ movable entries. *)
+ (* A liturgical year straddles two civil years, so both are named.
+ [Layer.index] filters them to the kernel domain, which is what keeps
+ the edges (year = 1583 naming 1582, year = 9999 naming 10000) from
+ calling the rite's [easter] out of range. *)
+ let idx = Layer.index layer ~easter:rite.Rite.easter ~years:[ year - 1; year; year + 1 ] 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]
@@ -232,7 +239,7 @@ let run (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) ~year =
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)
+ Layer.on_date idx date
|> List.iter (fun (e : 'r Layer.entry) ->
bump expected (Slug.to_string e.Layer.cel.Celebration.slug)))
days;