diff options
Diffstat (limited to 'lib/rites')
| -rw-r--r-- | lib/rites/rite_of/precedence_of.ml | 90 | ||||
| -rw-r--r-- | lib/rites/rite_of/precedence_of.mli | 25 |
2 files changed, 115 insertions, 0 deletions
diff --git a/lib/rites/rite_of/precedence_of.ml b/lib/rites/rite_of/precedence_of.ml index 5d32ee2..2fab64d 100644 --- a/lib/rites/rite_of/precedence_of.ml +++ b/lib/rites/rite_of/precedence_of.ml @@ -254,3 +254,93 @@ let vigil_feast (_ : Vocab_of.rank Precedence.candidate) : Slug.t option = None together. *) let rules : (Vocab_of.season, Vocab_of.rank) Precedence.rules = { band; disposition; admit; vigil_feast } + +(* Normae n. 60 and Normae n. 5 together. THREE rules, in this priority order + -- n. 60's own text defers to n. 5 explicitly ("servatis iis quae n. 5 + statuuntur"), so the two are one rule set, not two competing ones. + + 1. THE ANNUNCIATION IN HOLY WEEK (Normae n. 60): "Sollemnitas vero + Annuntiationis Domini, quotiescumque occurrit aliquo die Hebdomadae + sanctae, semper ad feriam II post dominicam II Paschae erit + transferenda." A fixed destination, Easter + 8, not a search. The EF has + the identical rule for the identical feast (RG 96's own exception, "the + Monday after Low Sunday" -- Low Sunday IS the Second Sunday of Easter), + which is why Rite.t.transfer_target is a rite-supplied function at all; + see its own doc comment. + + 2. A SOLEMNITY ON A PRIVILEGED SUNDAY (Normae n. 5): "Sollemnitates autem in + his dominicis occurrentes ad feriam secundam sequentem transferuntur" -- + the FOLLOWING MONDAY, not a searched free day. "his dominicis" are n. 5's + own subject: the Sundays of Advent, Lent and Easter. The clause carries + its own exception -- "nisi agatur de occurrentia in Dominica in Palmis + aut in Dominica Resurrectionis Domini" -- and those two cases fall + through to rule 3, whose forward search handles them correctly (the + Monday after Palm Sunday is Tabula entry 2 and is therefore not free). + + 3. THE GENERAL RULE (Normae n. 60): "ad proximiorem diem transferatur qui + sit liber a diebus sub nn. 1-8 in tabula praecedentiae recensitis" -- + the nearest later day free of Tabula entries 1-8, i.e. the first date + whose occupant bands ABOVE 80 (entry 8 x 10). + + TERMINATION, which Rite.t.transfer_target requires the rite to guarantee: + the search is bounded at [max_search_days] steps and raises if exhausted. + That bound is STRUCTURAL -- it does not appeal to the real calendar's own + shape -- because Calendar's round guard bounds ROUNDS, not the internal + search of a single call, and an unbounded walk would hang the caller + outright before that guard was ever consulted. *) + +let max_search_days = 400 + +let annunciation_slug = "of-annunciation" + +(* Tabula entries 1-8, scaled: a day is FREE to receive a transfer when its + occupant bands strictly above entry 8. *) +let entry_8_band = 80 + +let transfer_target (c : Vocab_of.rank Precedence.candidate) (origin : Date.t) + (occupant : Date.t -> Vocab_of.rank Celebration.t) : Date.t = + let year = Date.year origin in + let easter = Computus.gregorian_easter year in + let offset d = Date.to_rata d - Date.to_rata easter in + let is_holy_week d = offset d >= -7 && offset d <= -1 in + (* Rule 1. *) + if Slug.to_string c.cel.slug = annunciation_slug && is_holy_week origin then + Date.add_days easter 8 + else + let season_of d = (Temporal_of.temporal d).Temporal.season in + let privileged_sunday d = + Date.weekday d = Date.Sun + && match season_of d with + | Vocab_of.Advent | Vocab_of.Lent | Vocab_of.Easter -> true + | Vocab_of.Christmas | Vocab_of.Ordinary_time -> false + in + let is_palm_sunday d = offset d = -7 in + let is_easter_sunday d = offset d = 0 in + (* Rule 2. *) + if + c.cel.rank = Vocab_of.Sollemnitas + && privileged_sunday origin + && (not (is_palm_sunday origin)) + && not (is_easter_sunday origin) + then Date.add_days origin 1 + else + (* Rule 3. *) + let free d = + let cel = occupant d in + let cand = { Precedence.cel; origin = Precedence.Temporal } in + let ctx = + { Precedence.date = d; season = season_of d; weekday = Date.weekday d } + in + band ctx cand > entry_8_band + in + let rec search d steps = + if steps > max_search_days then + failwith + (Printf.sprintf + "Precedence_of.transfer_target: no day free of Tabula entries \ + 1-8 within %d days of %s" + max_search_days (Date.to_iso8601 origin)) + else if free d then d + else search (Date.add_days d 1) (steps + 1) + in + search (Date.add_days origin 1) 1 diff --git a/lib/rites/rite_of/precedence_of.mli b/lib/rites/rite_of/precedence_of.mli index e81d35e..4822411 100644 --- a/lib/rites/rite_of/precedence_of.mli +++ b/lib/rites/rite_of/precedence_of.mli @@ -85,3 +85,28 @@ val vigil_feast : Vocab_of.rank Precedence.candidate -> Slug.t option (** The four functions assembled for {!Colitur_kernel.Precedence.resolve}. *) val rules : (Vocab_of.season, Vocab_of.rank) Precedence.rules + +(** [transfer_target c origin occupant]: where an impeded solemnity goes. + Normae n. 60 and Normae n. 5 together -- n. 60 defers to n. 5 explicitly + ("servatis iis quae n. 5 statuuntur"), so they are one rule set: + + - the Annunciation falling anywhere in Holy Week goes to Easter + 8, the + Monday after the Second Sunday of Easter (n. 60, a fixed destination); + - any other solemnity falling on a Sunday of Advent, Lent or Easter goes to + the following Monday (n. 5), except on Palm Sunday or Easter Sunday, + which n. 5 excludes and which fall through to the general rule; + - otherwise, the nearest later day free of Tabula entries 1-8 (n. 60). + + Shaped to match {!Colitur_kernel.Rite.t.transfer_target} exactly so a later + phase wires it with no adaptation, and honours both obligations that field + states: the result is strictly later than [origin], and the search carries + its own step bound rather than relying on {!Colitur_kernel.Calendar}'s + round guard, which bounds rounds rather than one call's internal search. + + @raise Failure if no free day is found within 400 days -- a structural + bound, not an appeal to the calendar's own shape. *) +val transfer_target : + Vocab_of.rank Precedence.candidate -> + Date.t -> + (Date.t -> Vocab_of.rank Celebration.t) -> + Date.t |