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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
(* See lectionary_of.mli for the full citations and design argument. *)
open Colitur_kernel
type sunday_cycle = Year_a | Year_b | Year_c
type weekday_cycle = Year_i | Year_ii
let sunday_cycle_letter = function Year_a -> "a" | Year_b -> "b" | Year_c -> "c"
let weekday_cycle_letter = function Year_i -> "i" | Year_ii -> "ii"
(* The civil year in which the liturgical year CONTAINING [date] opened --
i.e. the year y such that [year_start y <= date < year_start (y + 1)].
This is the one piece of arithmetic both cycle rules share, and it is
exactly the "get the boundary right" the task brief names: a date in,
say, early December belongs to the liturgical year that opened THAT
same Advent only once Advent has actually started that year (compared
by real date, not by month) -- a month-based shortcut ("December always
means the new liturgical year") is wrong in the (real, if rare) case of
a December date still ahead of that year's own Advent I. *)
let liturgical_year_open_year ~year_start date =
let y = Date.year date in
if Date.compare date (year_start y) >= 0 then y else y - 1
(* OLM n.66 + footnote 102 (mli's own citation): the LABEL year is the one
most of the liturgical year falls in, i.e. one more than the year
Advent opened in ("a prima hebdomada Adventus, quae cadit in anno
civili praecedente" -- the first week of Advent falls in the PRECEDING
civil year relative to the label). Divisible by 3 -> C, then A, then B,
worked example 1980=C/1981=A/1982=B/1983=C verified against the real
page image. *)
let sunday_cycle ~year_start date =
let label = liturgical_year_open_year ~year_start date + 1 in
match label mod 3 with 0 -> Year_c | 1 -> Year_a | _ -> Year_b
(* OLM n.69 point 4 (mli's own citation): "Annus primus adhibetur annis
imparibus, annus secundus vero annis paribus" -- Year I in odd label
years, Year II in even. Same label-year computation as [sunday_cycle]
above, for the identical reason: this is a two-year cycle, not a
three-year one, but the label-year definition itself does not depend on
which modulus governs it. *)
let weekday_cycle ~year_start date =
let label = liturgical_year_open_year ~year_start date + 1 in
if label mod 2 = 1 then Year_i else Year_ii
(* Tries [base] flat, then [base]-<sunday letter>, then [base]-<weekday
letter>, in that order. Safe unconditionally: tools/
bootstrap_lectionary_of.ml emits a given base under AT MOST ONE of
these three forms (a flat entry when the two/three cycle years were
byte-identical, a cycle-lettered family otherwise -- never both), so at
most one of the three lookups below can ever hit, and trying the two
irrelevant forms for a family of the other kind or a flat family is
simply two wasted, harmless misses. This is what lets [readings] below
stay ignorant of which of the two cycle systems (or neither) a given
slug's own family actually uses. *)
let lookup_any lectionary ~year_start base date =
match Lectionary.find lectionary base with
| Some cs -> Some cs
| None -> (
let with_suffix suffix = Slug.of_string_exn (Slug.to_string base ^ "-" ^ suffix) in
match Lectionary.find lectionary (with_suffix (sunday_cycle_letter (sunday_cycle ~year_start date))) with
| Some cs -> Some cs
| None -> Lectionary.find lectionary (with_suffix (weekday_cycle_letter (weekday_cycle ~year_start date))))
(* See lectionary_of.mli's own doc comment for the full citation (OLM n.
69.3) and argument. Kept as ordinary [Printf.sprintf] string
construction, not a lookup table, so tools/bootstrap_lectionary_of.ml's
own reachability sweep (which calls this function directly, not a
hand-copied re-implementation) and this module's own runtime lookup can
never drift apart -- the single failure mode a hand-duplicated version
in each place would invite. *)
let date_keyed_slug date =
if Date.weekday date = Date.Sun then None
else
let m = Date.month date and dd = Date.day date in
if m = 12 && dd >= 17 && dd <= 24 then Some (Slug.of_string_exn (Printf.sprintf "of-advent-dec-%d" dd))
else if m = 12 && dd >= 29 && dd <= 31 then
Some (Slug.of_string_exn (Printf.sprintf "of-christmas-dec-%d" dd))
else if m = 1 && ((dd >= 2 && dd <= 5) || dd = 7) then
Some (Slug.of_string_exn (Printf.sprintf "of-christmas-jan-%d" dd))
else None
let readings ~lectionary ~year_start ~(observed : Vocab_of.rank Celebration.t)
~(temporal : (Vocab_of.season, Vocab_of.rank) Temporal.t) ~date ~temporal_at:_ =
match observed.Celebration.citations with
| _ :: _ as cs ->
(Some { Mass_formulary.said = Some observed.Celebration.slug; via = Mass_formulary.Proper }, cs)
| [] -> (
(* Step 2: a sanctoral entity actually won the day -- i.e. the
observed celebration is not itself the day's own temporal office.
Same guard shape as Rite_ef.Lectionary_ef.readings' own step 4
(see that module's implementation comment for the full argument
for why this comparison, not a [subject]/[status] test, is the
right one): comparing SLUGS is exact whenever the temporal and
sanctoral streams cannot collide, which holds here for the
identical reason it holds for EF -- every Temporal_of slug this
module ever constructs carries the "of-" prefix (temporal_of.ml's
own [temporal], every branch), and 0 of the 222 shipped
data/of/calendar-2002.sexp + amendments sanctoral slugs do. *)
let sanctoral_office =
not (Slug.equal observed.Celebration.slug temporal.Temporal.office.Celebration.slug)
in
match
if sanctoral_office then lookup_any lectionary ~year_start observed.Celebration.slug date else None
with
| Some cs ->
(* Mass_formulary.Proper, not .Common -- see lectionary_of.mli's
own doc comment on this branch for the full argument. In
short: EF's [Common] constructor names a SPECIFIC mechanism
(several saints sharing one formulary via an explicit
assignment table, data/ef/commons.sexp) that OF's own data has
no counterpart for -- every sanctoral slug this step resolves
carries its OWN dedicated lectio entry, not a shared one, so
relabelling it [Common] would claim a mechanism that is not
actually present. [Proper] is the honest fit: "the observed
celebration's own proper Mass", true regardless of whether the
citations are embedded on Celebration.t (step 1) or held
externally in [lectionary] (this step) -- a storage detail
Mass_formulary.source was never built to carry. *)
(Some { Mass_formulary.said = Some observed.Celebration.slug; via = Mass_formulary.Proper }, cs)
| None -> (
(* OLM n. 69.3's own date-fixed windows (see date_keyed_slug's
own doc comment): tried BEFORE the ordinary weekday-keyed
slug lookup, not instead of it, so every other temporal day
is unaffected -- this branch only ever hits inside the two
named civil-date windows, and [date_keyed_slug] itself
already refuses a Sunday, where a NAMED Sunday office (never
one of these weekday-keyed ferial slugs) is what temporal.
office actually names. *)
match (match date_keyed_slug date with Some s -> Lectionary.find lectionary s | None -> None) with
| Some cs ->
( Some { Mass_formulary.said = Some temporal.Temporal.office.Celebration.slug;
via = Mass_formulary.Own_slug },
cs )
| None -> (
match lookup_any lectionary ~year_start temporal.Temporal.office.Celebration.slug date with
| Some cs ->
( Some { Mass_formulary.said = Some temporal.Temporal.office.Celebration.slug;
via = Mass_formulary.Own_slug },
cs )
| None -> (None, []))))
|