1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
(* 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)
(* [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 =
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
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;
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;
omitted;
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)
|
