diff options
Diffstat (limited to 'lib/kernel/calendar.ml')
| -rw-r--r-- | lib/kernel/calendar.ml | 22 |
1 files changed, 15 insertions, 7 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 |