diff options
Diffstat (limited to 'tools/bootstrap_lectionary_of.ml')
| -rw-r--r-- | tools/bootstrap_lectionary_of.ml | 827 |
1 files changed, 827 insertions, 0 deletions
diff --git a/tools/bootstrap_lectionary_of.ml b/tools/bootstrap_lectionary_of.ml new file mode 100644 index 0000000..f521bb1 --- /dev/null +++ b/tools/bootstrap_lectionary_of.ml @@ -0,0 +1,827 @@ +(* Bootstraps data/of/lectionary.sexp from lectio's of-lectionary.ini + (Task 4, 2026-08-25-colitur-of-phases-3-5). Lives in tools/, OCaml, not + Python -- deliberately: this task's own brief named + tools/extract_of_lectionary.py, but tools/bootstrap_lectionary.ml + already IS the established shape for exactly this job (EF's own + lectionary bootstrap), including a real, load-bearing safety net -- + [assert_reachable] below sweeps Rite_of.Temporal_of.temporal AND the + real merged sanctoral layer directly, so a mapping-table typo cannot + ship a dead key silently. Reimplementing that check in Python would mean + duplicating colitur's own date arithmetic in a second language, exactly + the drift risk this generator exists to avoid. Named to match the + OF-specific sibling convention (temporal_of.ml, precedence_of.ml), not + bootstrap_lectionary.ml's own bare name, since a second rite needs a + second, distinguishable generator. + + THE LINEAGE, stated once, here, because every downstream comment and the + emitted file's own header both lean on it: lectio's of-lectionary.ini + says of itself (its own top-of-file comment) that it is "Generated from + niedziela.pl by scripts/genlect-of.go (harvest 2020-2025)". niedziela.pl + is a POLISH VERNACULAR pastoral lectionary aid, not the Latin OLM + (Ordo Lectionum Missae) 1981 itself, and its own citations are, per the + design spec (2026-08-24-colitur-of-rite-module-design.md sec4.4), + ENGLISH-CANONICAL (English book names/verse numbering), not the OLM's + Vulgate-numbered Latin. THIS IS A SEPARATE LINEAGE from lectio's OF + CALENDAR (data/of/calendar-2002.sexp, roman-calendar.ini, upstream + calapi.inadiutorium.cz) -- lectio is not one OF witness but two, + unrelated upstreams glued together by one downstream project, and + neither is the typical edition. What this data CANNOT show: any + divergence between niedziela.pl's own pastoral choices and the Latin + OLM's own text (verse-range short/long forms, alternative readings, + Vulgate-vs-Nova-Vulgata numbering -- the design spec's own sec4.4 records + three real, confirmed such divergences against the actual OLM page + images: Holy Family Year A's second-reading short form, Trinity Sunday's + Dan 3:56, and the Baptism of the Lord's Mc 9:6 vs "Mark 9:7"); nor can it + show anything about the OLM's SHORT-FORM/LONG-FORM alternatives, which + niedziela.pl does not distinguish. This generator does not attempt to + correct any of that -- it transcribes the vernacular data faithfully, + states the lineage loudly, and lets a future task with the actual OLM + page images (docs/research/of/olm-1981.pdf) do primary-source + verification the way tools/bootstrap_lectionary.ml's own Holy Week + entries did for EF. *) +open Colitur_kernel + +let default_source = "../lectio/internal/caldata/of-lectionary.ini" +let default_dest = "data/of/lectionary.sexp" + +let die fmt = + Printf.ksprintf + (fun s -> prerr_endline ("bootstrap_lectionary_of: " ^ s); exit 1) + fmt + +(* ---- INI parsing --------------------------------------------------- *) + +type section = { name : string; fields : (string * string) list } + +(* Fails loudly, not silently, when the source file is absent -- Task 1's + own review found exactly this bug in the calendar extractor + (parse_lectio_ini swallowing FileNotFoundError, producing a DIFFERENT + file with a different SHA-256 and no warning): checked BEFORE any read + is attempted, and the [open_in] itself is also guarded as defence in + depth, mirroring tools/bootstrap_lectionary.ml's own [parse_ini]. *) +let parse_ini path = + if not (Sys.file_exists path) then + die "%s: no such file (a missing lectio snapshot must fail loudly, not \ + silently regenerate with a different SHA-256 and no warning -- Task 1's \ + own review round found exactly this bug)" + path; + let ic = try open_in path with Sys_error e -> die "%s" e in + let sections = ref [] and cur = ref None and malformed = ref [] and lineno = ref 0 in + let flush () = + match !cur with + | Some (n, fs) -> sections := { name = n; fields = List.rev fs } :: !sections + | None -> () + in + (try + while true do + incr lineno; + let raw = input_line ic in + let line = String.trim raw in + if line = "" || line.[0] = ';' || line.[0] = '#' then () + else if line.[0] = '[' then begin + flush (); + cur := Some (String.sub line 1 (String.length line - 2), []) + end + else + let known_key k = List.mem k [ "first"; "psalm"; "second"; "gospel" ] in + match String.index_opt line '=' with + | Some i when known_key (String.trim (String.sub line 0 i)) -> + let k = String.trim (String.sub line 0 i) in + let v = String.trim (String.sub line (i + 1) (String.length line - i - 1)) in + cur := + (match !cur with + | Some (n, fs) -> Some (n, (k, v) :: fs) + | None -> die "%s:%d: field %S before any section" path !lineno k) + | Some _ | None -> + (* Known, single, understood anomaly (see the assertion below): + line 1276 of the shipped snapshot, inside [holy-family-A], + reads bare "=Sir3:2-6,12-14-Gk" -- an EMPTY key, not "no + '=' sign" (an earlier version of this parser tested for the + latter and missed this line entirely, since [String. + index_opt] DOES find the '=' at position 0; a key must now + be one of the four known field names, checked explicitly). + This is the Polish lectionary's own Septuagint/Greek- + numbering variant for Sirach 3 (design spec sec5's own + "Polish is independent on one point": Syr 3,2-6.12-14 + against the OLM/CEI/USA table's shared Nova Vulgata + 3,3-7.14-17a), evidently emitted by niedziela.pl's own + scraper as a stray annotation rather than a proper + "first_alt = ..." field. Recorded, not silently dropped: + every such line is collected and the count is asserted + below, so a NEW malformed line in a future lectio snapshot + still fails loudly rather than being quietly absorbed by + this same tolerance. *) + malformed := (!lineno, line) :: !malformed + done + with End_of_file -> ()); + flush (); + close_in ic; + (match List.rev !malformed with + | [ (1276, "=Sir3:2-6,12-14-Gk") ] -> () + | [] -> die "%s: expected exactly one known malformed line (1276, the Sirach \ + Septuagint-numbering annotation) but found none -- either the \ + snapshot changed or this tolerance is now dead code; re-check \ + by hand before touching this assertion" path + | other -> + List.iter (fun (n, l) -> Printf.eprintf " line %d: %S\n" n l) other; + die "%s: %d unparseable line(s) found, not the one previously-known \ + anomaly (see above) -- investigate before shipping; a new \ + malformed line must be understood, not silently swallowed" + path (List.length other)); + List.rev !sections + +(* ---- Citation extraction -- First + Gospel only --------------------- *) + +(* Psalm and Second are deliberately dropped, even though lectio's ini + carries [psalm] (every entry) and [second] (Sundays/solemnities): + Colitur_kernel.Validate's own ["citations"] check (kernel, off limits to + this task) hard-asserts every day's citation-part list is EXACTLY + [[First; Gospel]] -- the identical scope boundary + tools/bootstrap_lectionary.ml's own [convert] already holds for EF + ("Nothing here encodes... the chants (Psalm, Second, Tract, Alleluia, + Sequence) are deliberately unbuilt"). Carrying Psalm/Second through here + would not add capability today (nothing reads them) and would set up a + guaranteed collision with that kernel check the moment a future task + wires Validate over OF data. *) +let cite sec = + let get k = match List.assoc_opt k sec.fields with None | Some "" -> None | Some v -> Some v in + match (get "first", get "gospel") with + | Some first, Some gospel -> + Some [ { Citation.part = Citation.First; reference = first }; + { Citation.part = Citation.Gospel; reference = gospel } ] + | _ -> None + +(* ---- Cycle-family grouping ------------------------------------------ *) + +(* Every one of the 988 sections carries a cycle suffix: -A/-B/-C (Sunday + cycle, 102 bases x 3 = 306) or -I/-II (weekday cycle, 341 bases x up to + 2 = up to 682; two bases are short one cycle -- see + [collapse_weekday] below). Measured exhaustively before writing this + generator: no section carries any OTHER suffix, and no base name + appears in both groups. *) +let strip_suffix ~suffix s = + let ls = String.length s and lsuf = String.length suffix in + if ls > lsuf && String.sub s (ls - lsuf) lsuf = suffix then + Some (String.sub s 0 (ls - lsuf)) + else None + +let base_and_letter name = + match strip_suffix ~suffix:"-A" name with + | Some b -> Some (b, `A) + | None -> ( + match strip_suffix ~suffix:"-B" name with + | Some b -> Some (b, `B) + | None -> ( + match strip_suffix ~suffix:"-C" name with + | Some b -> Some (b, `C) + | None -> ( + match strip_suffix ~suffix:"-II" name with + | Some b -> Some (b, `II) + | None -> ( + match strip_suffix ~suffix:"-I" name with + | Some b -> Some (b, `I) + | None -> None)))) + +type resolved = + | Flat of Citation.t list (* cycle-independent: one citation set for every year *) + | Sunday_cycle of (Citation.t list * Citation.t list * Citation.t list) (* A, B, C *) + | Weekday_cycle of (Citation.t list option * Citation.t list option) (* I, II -- either may be absent *) + +(* Sunday-cycle collapse: mechanical, not curated per-saint. Measured + across all 102 bases before this generator existed: 43 are byte- + identical across A/B/C (routine -- a fixed-date saint's own Mass simply + does not vary by year, e.g. andrew-the-apostle); 57 are genuinely + distinct on all three letters (real OLM n.66 three-year-cycle content -- + every numbered Sunday, plus the handful of movable/fixed solemnities of + the Lord whose OWN Gospel varies by year: Holy Family, Baptism of the + Lord, Ascension, Corpus Christi, Christ the King, Trinity, Sacred Heart, + Transfiguration); and EXACTLY 2 have a clean 2-of-3 majority with the + third an unrelated passage from a DIFFERENT day entirely -- + annunciation-of-the-lord (B is Monday of Holy Week's own Mass, + Isa 42:1-7/John 12:1-11 -- a scraping-year artifact: the Annunciation + was genuinely impeded and transferred that harvest year, so + niedziela.pl's site had Holy Week's Mass on 25 March instead) and + immaculate-conception-of-the-blessed-virgin-mary (A is Isa 35:1-10/ + Luke 5:17-26, an ordinary Lenten-feria Gospel, the same shape). Both + solemnities are, in real practice, NOT cycle-dependent at all (single + Mass every year) -- corroborated externally by the "2 of 3 agree, none + of the 57 genuine cases exhibit that shape" measurement itself, not + merely asserted -- so majority-collapse is applied, and the discarded + outlier is logged. No other base in the whole 102-base population has + this 2-of-3 shape; the rule is general, not hand-targeted at these two + names. *) +let collapse_sunday base va vb vc = + if va = vb && vb = vc then Flat va + else if va = vb then begin + Printf.eprintf + "bootstrap_lectionary_of: %s: cycle C disagreed with A/B (scraping-year \ + artifact, majority kept): %s\n" + base (match vc with [ f; _ ] -> f.Citation.reference | _ -> "?"); + Flat va + end + else if va = vc then begin + Printf.eprintf + "bootstrap_lectionary_of: %s: cycle B disagreed with A/C (scraping-year \ + artifact, majority kept): %s\n" + base (match vb with [ f; _ ] -> f.Citation.reference | _ -> "?"); + Flat va + end + else if vb = vc then begin + Printf.eprintf + "bootstrap_lectionary_of: %s: cycle A disagreed with B/C (scraping-year \ + artifact, majority kept): %s\n" + base (match va with [ f; _ ] -> f.Citation.reference | _ -> "?"); + Flat vb + end + else Sunday_cycle (va, vb, vc) + +(* Weekday-cycle collapse: same mechanical byte-identity test. OLM 1981 + Praenotanda n.69 points 2-3 (page-image verified, + docs/research/of/olm-1981.pdf p.33/"XXXIII") state that Lent has its own + fixed seasonal cycle and Advent/Christmastide/Paschaltide ferias "do not + change" year to year -- exactly the byte-identical shape measured for + those families (advent-1/2/3, advent-dec-17..24, lent-after-ashes-*, + holy-week-*, easter-octave-*: 119 of 341 bases). Point 4 confines the + REAL two-year alternation to Ordinary Time's 34 weeks, and even there + only the FIRST reading alternates -- the Gospel is one single, + year-independent cycle (n.69 point 4: "lectiones evangelicae unico + disponuntur cyclo... Prior vero lectio, in duplici cyclo ordinatur") -- + which is exactly why 198 of the 221 non-identical bases still share a + common Gospel with only the First Reading differing: real content, kept + as two entries because the FULL pair genuinely differs, not a scraping + artifact (unlike the two Sunday-cycle cases above, no base in this group + showed a "majority of one, unrelated outlier" shape). *) +let collapse_weekday base v1 v2 = + match (v1, v2) with + | Some a, Some b when a = b -> Flat a + | Some _, Some _ -> Weekday_cycle (v1, v2) + | Some _, None | None, Some _ -> + Printf.eprintf + "bootstrap_lectionary_of: %s: only one weekday-cycle year present in \ + lectio's own snapshot (a real gap in niedziela.pl's 2020-2025 harvest, \ + not a parsing defect) -- transcribed as-is\n" + base; + Weekday_cycle (v1, v2) + | None, None -> die "%s: cycle collapse called with no data" base + +let resolve_sections secs = + let tbl = Hashtbl.create 1024 in + List.iter + (fun sec -> + match base_and_letter sec.name with + | None -> die "%s: no recognised cycle suffix (-A/-B/-C/-I/-II)" sec.name + | Some (base, letter) -> ( + match cite sec with + | None -> die "%s: no first/gospel field" sec.name + | Some cs -> + let cur = try Hashtbl.find tbl base with Not_found -> (None, None, None, None, None) in + let a, b, c, i, ii = cur in + let updated = + match letter with + | `A -> (Some cs, b, c, i, ii) + | `B -> (a, Some cs, c, i, ii) + | `C -> (a, b, Some cs, i, ii) + | `I -> (a, b, c, Some cs, ii) + | `II -> (a, b, c, i, Some cs) + in + Hashtbl.replace tbl base updated)) + secs; + Hashtbl.fold + (fun base (a, b, c, i, ii) acc -> + match (a, b, c, i, ii) with + | Some va, Some vb, Some vc, None, None -> (base, collapse_sunday base va vb vc) :: acc + | None, None, None, i, ii when i <> None || ii <> None -> + (base, collapse_weekday base i ii) :: acc + | Some va, Some vb, Some vc, i, ii when i <> None || ii <> None -> + (* A real, measured duplicate in lectio's own source, confined + (checked below by this generator's own exhaustive Hashtbl.fold) + to the six Easter Octave weekdays: each carries BOTH an + -A/-B/-C section AND an -I/-II one, evidently written by two + different passes of niedziela.pl's own generation pipeline. + Content-verified identical in substance (Acts 2:14,22-32/33, + Ps 16, Matt 28:8-15 -- "Acts"/"The Acts" and "Mat"/"Matthew" + spelling differ, the citation does not), and each of the two + representations is ALSO internally self-consistent + (A=B=C, I=II) on its own -- so this is redundancy, not a real + conflict. The -A/-B/-C reading is kept (it is what this + generator's own [named_overrides] table for these six bases + already targets); the -I/-II reading is discarded, logged + here rather than silently dropped. *) + Printf.eprintf + "bootstrap_lectionary_of: %s: BOTH Sunday- and weekday-cycle data present \ + (a genuine lectio duplicate, not a defect -- see the comment on this branch); \ + keeping the Sunday-cycle (A/B/C) reading, discarding the weekday-cycle (I/II) one\n" + base; + (base, collapse_sunday base va vb vc) :: acc + | _ -> + die "%s: mixed or incomplete cycle data (a=%b b=%b c=%b i=%b ii=%b)" base (a <> None) + (b <> None) (c <> None) (i <> None) (ii <> None)) + tbl [] + +(* ---- colitur slug mapping -------------------------------------------- *) + +let weekday_pairs = + (* (colitur full word, lectio abbreviation) *) + [ ("monday", "mon"); ("tuesday", "tue"); ("wednesday", "wed"); ("thursday", "thu"); + ("friday", "fri"); ("saturday", "sat") ] + +let split_dash s = String.split_on_char '-' s + +(* (colitur season word, lectio season word, max week number) -- ferial + families. Min week is always 1. Week 6 of Lent (Holy Week) and week 1 of + Easter (the Octave) are deliberately excluded from this generic table -- + both have their own named families, handled in [special_overrides]. *) +let ferial_families = + [ ("advent", "advent", 4); ("lent", "lent", 5); ("easter", "easter", 7); + ("ordinary-time", "ordinary", 34) ] + +(* Easter's own numbered Sunday family runs 3..7 in lectio (2 is the + separately-named "easter-octave-sun", see [named_overrides]) but the + upper bound here is deliberately still a loose "any n >= 1" check (see + [pattern_match]'s own guard) -- lectio simply never emits an + "easter-sunday-1"/"-2" base for this family to collide with. *) +let sunday_families = + [ ("advent", "advent", 4); ("lent", "lent", 5); ("easter", "easter", 7); + ("ordinary-time", "ordinary", 33) ] + +(* A base that pattern-matches a numbered ferial or Sunday family. Returns + the colitur slug directly. *) +let pattern_match base = + match split_dash base with + | [ w; "sunday"; n ] -> ( + match (List.find_opt (fun (_, lw, _) -> lw = w) sunday_families, int_of_string_opt n) with + | Some (cw, _, max_n), Some ni when ni >= 1 && ni <= max_n -> + Some (Printf.sprintf "of-%s-sunday-%d" cw ni) + | _ -> None) + | [ w; n; wd ] -> ( + match + ( List.find_opt (fun (_, lw, _) -> lw = w) ferial_families, + int_of_string_opt n, + List.find_opt (fun (_, la) -> la = wd) weekday_pairs ) + with + | Some (cw, _, max_n), Some ni, Some (full_wd, _) when ni >= 1 && ni <= max_n -> + Some (Printf.sprintf "of-%s-%d-%s" cw ni full_wd) + | _ -> None) + | _ -> None + +(* Named-day and irregular-family renames -- everything [pattern_match] + above cannot reach because colitur's own slug uses a DIFFERENT word, a + DIFFERENT numbering scheme, or (the Christmas-season families) the SAME + weekday-keyed scheme lectio happens to expose under a differently-named + family. Each entry cites the content verification that justified it, + not merely the name resemblance -- three of these (christmas, + christmas-sunday-sun, easter-octave-sun) would have been WRONG if + matched by name alone; see the comment on each. *) +let named_overrides = + [ (* Content-verified against the real reading (Isa 62:1-5/Matt 1:18-25, + the genealogy/annunciation-to-Joseph narrative): this is the VIGIL + Mass, not "Christmas Day" despite the bare name -- the real Christmas + DAY Mass (Isa 52:7-10/John 1:1-14) is ABSENT from lectio's own 988 + keys entirely, a genuine, notable gap (see the generator's own + coverage report). *) + ("christmas", [ "of-nativity-vigil" ]); + (* Content-verified (Sirach 24 Wisdom-personified / Eph 1 / John 1:1-18): + this is the SECOND SUNDAY AFTER THE NATIVITY (Normae n.36), not a + generic "the Sunday of Christmas" despite the bare name -- Holy + Family (a DIFFERENT Sunday, Normae n.35(a)) has its own "holy-family" + base, mapped just below. *) + ("christmas-sunday-sun", [ "of-christmas-sunday-2" ]); + ("mary-mother-of-god-octave-of-christmas", [ "of-mary-mother-of-god" ]); + (* Content-verified (Joel 2:12-18/Matt 6:1-6,16-18, THE Ash Wednesday + Mass): lectio groups Ash Wednesday itself into this weekday-cycle + family rather than giving it a bare "ash-wednesday" key. Its own + three siblings (Thursday/Friday/Saturday right after Ash + Wednesday) are plain ferias, matched by the SAME family, needing + only the word rename ("lent-after-ashes" -> "of-lent-after-ashes") + [pattern_match] cannot supply on its own (it is not a numbered + week). *) + ("lent-after-ashes-wed", [ "of-ash-wednesday" ]); + ("lent-after-ashes-thu", [ "of-lent-after-ashes-thursday" ]); + ("lent-after-ashes-fri", [ "of-lent-after-ashes-friday" ]); + ("lent-after-ashes-sat", [ "of-lent-after-ashes-saturday" ]); + ("trinity-sunday", [ "of-trinity" ]); + (* Content-verified (John 20:19-31, the Divine Mercy Gospel): the + Sunday CLOSING the Easter Octave, colitur's own generic + week-2-of-Easter Sunday slug, not a second distinct office. *) + ("easter-octave-sun", [ "of-easter-sunday-2" ]); + (* The remaining single- or compound-word NAMED temporal days + (Temporal_of.named/[temporal]'s own Sunday branches): colitur's own + slug is simply "of-" prepended to lectio's own bare name, verified + against temporal_of.ml directly rather than assumed -- these are + NOT reachable by pass-through (pass-through checks the SANCTORAL + layer only, and none of these is sanctoral data). *) + ("epiphany", [ "of-epiphany" ]); + ("palm-sunday", [ "of-palm-sunday" ]); + ("easter-sunday", [ "of-easter-sunday" ]); + ("ascension", [ "of-ascension" ]); + ("pentecost", [ "of-pentecost" ]); + ("baptism-of-the-lord", [ "of-baptism-of-the-lord" ]); + ("christ-the-king", [ "of-christ-the-king" ]); + ("corpus-christi", [ "of-corpus-christi" ]); + ("holy-family", [ "of-holy-family" ]); + (* Sacred Heart is SANCTORAL data (calendar-2002.sexp, Easter_offset 68 + -- F-HEARTS finding, this plan's Task 1), not a Temporal_of slug, and + its colitur slug carries "-of-jesus" that lectio's bare "sacred-heart" + does not. *) + ("sacred-heart", [ "sacred-heart-of-jesus" ]); + (* Holy Week Monday-Wednesday and the Triduum: colitur's own + Temporal_of deliberately does NOT name these days (Lent's own + generic week-6 ferial slug covers them, see temporal_of.ml's own + [season] function -- Lent runs "through Holy Saturday inclusive"). + lectio names them by a WEEKDAY family lectio itself calls + "holy-week"/"triduum" rather than "lent-6". *) + ("holy-week-mon", [ "of-lent-6-monday" ]); + ("holy-week-tue", [ "of-lent-6-tuesday" ]); + ("holy-week-wed", [ "of-lent-6-wednesday" ]); + ("triduum-thu", [ "of-lent-6-thursday" ]); + ("triduum-fri", [ "of-lent-6-friday" ]); + ("triduum-sat", [ "of-lent-6-saturday" ]); + (* Easter Octave weekdays: colitur names these directly + (of-easter-octave-day-N, Monday=2..Saturday=7 -- temporal_of.ml's + own [named], "Easter Sunday (above) plus these six"). *) + ("easter-octave-mon", [ "of-easter-octave-day-2" ]); + ("easter-octave-tue", [ "of-easter-octave-day-3" ]); + ("easter-octave-wed", [ "of-easter-octave-day-4" ]); + ("easter-octave-thu", [ "of-easter-octave-day-5" ]); + ("easter-octave-fri", [ "of-easter-octave-day-6" ]); + ("easter-octave-sat", [ "of-easter-octave-day-7" ]); + (* The three Christmas-season ferial stretches + (Temporal_of.christmas_feria_slug's own three "of-christmas-{0,1,2}- + <weekday>" stretches, 26-31 Dec / 2-5 Jan / 7 Jan..pre-Baptism) are + WEEKDAY-keyed on colitur's side. lectio exposes THREE separate + weekday-keyed families that line up with them one-for-one, under + names that do not textually resemble colitur's own -- matched here + by CONTENT/POSITION, not by name: + - "christmas-octave-<wd>" (1 John/John 1, the Octave itself, 26-31 + Dec) -> stretch 0. + - "christmas-<wd>" bare, no "-octave-"/"-dec-"/"-jan-" (1 John + 2-3/John 1:29-51, the semi-continuous reading BETWEEN the Octave + and Epiphany, 2-5 Jan) -> stretch 1. + - "christmas-after-epiphany-<wd>" (7 Jan..Baptism) -> stretch 2. + lectio ALSO carries "christmas-dec-29/30/31" and "christmas-jan- + 2..7", a DATE-keyed duplicate of the same stretches -- deliberately + UNUSED (see [excluded_bases] below): colitur's own slugs are + weekday-keyed, not date-keyed, so a fixed civil date such as + "29 December" is not any single colitur slug -- it is a DIFFERENT + weekday (hence a different of-christmas-0-<weekday>) in different + years, and Lectionary.t has no per-date lookup at all. *) + ("christmas-octave-mon", [ "of-christmas-0-monday" ]); + ("christmas-octave-tue", [ "of-christmas-0-tuesday" ]); + ("christmas-octave-wed", [ "of-christmas-0-wednesday" ]); + ("christmas-octave-thu", [ "of-christmas-0-thursday" ]); + ("christmas-octave-fri", [ "of-christmas-0-friday" ]); + ("christmas-octave-sat", [ "of-christmas-0-saturday" ]); + ("christmas-mon", [ "of-christmas-1-monday" ]); + ("christmas-tue", [ "of-christmas-1-tuesday" ]); + ("christmas-wed", [ "of-christmas-1-wednesday" ]); + ("christmas-thu", [ "of-christmas-1-thursday" ]); + ("christmas-fri", [ "of-christmas-1-friday" ]); + ("christmas-sat", [ "of-christmas-1-saturday" ]); + ("christmas-after-epiphany-mon", [ "of-christmas-2-monday" ]); + ("christmas-after-epiphany-tue", [ "of-christmas-2-tuesday" ]); + ("christmas-after-epiphany-wed", [ "of-christmas-2-wednesday" ]); + ("christmas-after-epiphany-thu", [ "of-christmas-2-thursday" ]); + ("christmas-after-epiphany-fri", [ "of-christmas-2-friday" ]); + ("christmas-after-epiphany-sat", [ "of-christmas-2-saturday" ]) + ] + +(* Deliberately unmapped, with the reason named -- see [named_overrides]'s + own comment on the Christmas-season families for the date-vs-weekday + mismatch these two groups share: + + - "advent-dec-17".."advent-dec-24": the O-Antiphon days. colitur's own + Temporal_of has no per-date slug for late Advent at all (Temporal_ef's + EF counterpart doesn't either); these ferias fall through to the + ordinary week-numbered "of-advent-{3,4}-<weekday>" slug, and WHICH + weekday-string a given December date is varies year to year, so no + static base-name mapping is possible. A future task wanting these + eight dates covered needs a genuinely date-keyed lookup path in + Lectionary_of.readings, not a slug rename here. + - "christmas-dec-29/30/31", "christmas-jan-2/3/4/5/6/7": the date-keyed + duplicates of the weekday-keyed families already mapped above. Same + reasoning, same remedy if ever closed. + - "easter-6-thu": Thursday of Easter week 6 is STRUCTURALLY, always, + the Ascension (Easter+39 is always a Thursday) -- Temporal_of's own + [named] intercepts it before the generic ferial branch ever runs, so + "of-easter-6-thursday" is not a slug Temporal_of can ever produce. + - "advent-4-sat": the Saturday of Advent week 4 is STRUCTURALLY, always, + either 24 December (intercepted by [named]'s own Nativity Vigil + branch on every non-Sunday year) or does not exist as a ferial at all + (when 24 December is itself the Fourth Sunday of Advent, week 4 has + no ferial days whatsoever) -- "of-advent-4-saturday" is not a slug + Temporal_of can ever produce either. + Both confirmed, not assumed: [assert_reachable]'s own reachability + sweep flagged each as a genuine dead key this generator's own pattern + rule produced (after fixing the suffix-stripping bug that function's + own comment describes, which had masked them under 580 false + positives on this generator's first run). *) +let excluded_bases = + [ "advent-dec-17"; "advent-dec-18"; "advent-dec-19"; "advent-dec-20"; "advent-dec-21"; + "advent-dec-22"; "advent-dec-23"; "advent-dec-24"; + "christmas-dec-29"; "christmas-dec-30"; "christmas-dec-31"; + "christmas-jan-2"; "christmas-jan-3"; "christmas-jan-4"; "christmas-jan-5"; "christmas-jan-6"; + "christmas-jan-7"; "easter-6-thu"; "advent-4-sat" ] + +type mapping_report = { mapped : int; excluded : int; unmapped : string list } + +(* Resolves every (base, resolved-citations) pair into zero or more + (colitur-slug, resolved-citations) pairs, and separately tracks what + could not be resolved -- the second half of Step 1's own "measure the + gap in both directions" requirement. A sanctoral PASS-THROUGH (lectio's + own base name used verbatim as colitur's slug) is verified against the + real merged sanctoral layer at generation time, not assumed: an + unverified guess would be exactly the silent-drop failure mode this + whole task exists to avoid. *) +let map_bases resolved ~sanctoral_slugs = + let unmapped = ref [] in + let excluded = ref 0 in + let out = + List.filter_map + (fun (base, r) -> + if List.mem base excluded_bases then begin + incr excluded; + None + end + else + match pattern_match base with + | Some slug -> Some (slug, r) + | None -> ( + match List.assoc_opt base named_overrides with + | Some [ slug ] -> Some (slug, r) + | Some _ -> die "%s: named_overrides entry must name exactly one slug" base + | None -> + if Hashtbl.mem sanctoral_slugs base then Some (base, r) + else begin + unmapped := base :: !unmapped; + None + end)) + resolved + in + (out, { mapped = List.length out; excluded = !excluded; unmapped = List.sort compare !unmapped }) + +(* ---- Emit one Lectionary.t entry per (slug, resolved) pair ---------- *) + +let sunday_letter = function `A -> "a" | `B -> "b" | `C -> "c" +let weekday_letter = function `I -> "i" | `II -> "ii" + +let slug_or_die name = match Slug.of_string name with Ok s -> s | Error e -> die "%s" e + +let entries_of (slug, r) = + match r with + | Flat cs -> [ (slug_or_die slug, cs) ] + | Sunday_cycle (a, b, c) -> + [ (slug_or_die (slug ^ "-" ^ sunday_letter `A), a); + (slug_or_die (slug ^ "-" ^ sunday_letter `B), b); + (slug_or_die (slug ^ "-" ^ sunday_letter `C), c) ] + | Weekday_cycle (i, ii) -> + List.filter_map + (fun (letter, v) -> Option.map (fun cs -> (slug_or_die (slug ^ "-" ^ weekday_letter letter), cs)) v) + [ (`I, i); (`II, ii) ] + +(* ---- Real-code reachability, both temporal and sanctoral ------------ *) + +(* Same discipline as tools/bootstrap_lectionary.ml's own + [reachable_temporal_slugs]/[assert_reachable]: this sweeps + Rite_of.Temporal_of.temporal directly over a real civil-day range, so an + emitted key naming no real office is a DEAD KEY, caught here rather than + shipped silently. 2004-2051 matches the EF generator's own range and + for the same reason -- wide enough to enumerate every distinct slug + FAMILY (season/week/weekday recur every year; only which year exhibits a + given alignment changes), not a claim about the kernel's full + 1583-9999 domain, which is this bootstrap tool's business only insofar + as [Temporal_of.temporal] itself is already total over it. *) +let reachable_temporal_slugs () = + let tbl = Hashtbl.create 512 in + let mk y m d = match Date.make ~year:y ~month:m ~day:d with Ok t -> t | Error e -> die "%s" e in + for y = 2004 to 2051 do + let d = ref (mk y 1 1) in + let stop = mk y 12 31 in + while Date.compare !d stop <= 0 do + let t = Rite_of.Temporal_of.temporal !d in + Hashtbl.replace tbl (Slug.to_string t.Temporal.office.Celebration.slug) true; + d := Date.add_days !d 1 + done + done; + tbl + +(* The merged sanctoral layer -- calendar-2002.sexp plus all 13 decree + overlays, the SAME base + amendment set Tasks 1/2 shipped, loaded here + read-only, purely to know which slugs are real. A missing/malformed + calendar or amendment file is fatal (die), not silently treated as "zero + sanctoral slugs", which would make [map_bases]' own pass-through + validation vacuously reject every saint. *) +let amendment_files = + [ "001-padre-pio.sexp"; "002-juan-diego-cuauhtlatoatzin.sexp"; "003-our-lady-of-guadalupe.sexp"; + "004-john-xxiii-john-paul-ii.sexp"; "005-mary-magdalene-rank.sexp"; + "006-mary-mother-of-the-church.sexp"; "007-paul-vi.sexp"; "008-our-lady-of-loreto.sexp"; + "009-faustina-kowalska.sexp"; "010-narek-avila-hildegard.sexp"; "011-martha-mary-lazarus.sexp"; + "012-teresa-of-calcutta.sexp"; "013-john-henry-newman.sexp" ] + +let reachable_sanctoral_slugs () = + let base_path = "data/of/calendar-2002.sexp" in + let amendments_dir = "data/of/amendments/" in + let base = + match Layer.load Rite_of.Vocab_of.rank_of_sexp base_path with + | Ok l -> l + | Error e -> die "%s: %s" base_path e + in + let overlays = + List.map + (fun name -> + let path = amendments_dir ^ name in + match Overlay.load Rite_of.Vocab_of.rank_of_sexp path with + | Ok o -> o + | Error e -> die "%s: %s" path e) + amendment_files + in + let merged, diagnostics = Overlay.merge base overlays in + (match diagnostics with + | [] -> () + | ds -> + die "data/of/amendments: %d diagnostic(s) applying to the base calendar -- \ + fix the amendment files before bootstrapping the lectionary from them: %s" + (List.length ds) + (String.concat "; " (List.map Overlay.diagnostic_to_string ds))); + let tbl = Hashtbl.create 256 in + List.iter (fun (e : _ Layer.entry) -> Hashtbl.replace tbl (Slug.to_string e.Layer.cel.Celebration.slug) true) + merged.Layer.entries; + tbl + +(* [base_and_letter] strips the RAW ini suffixes (-A/-B/-C/-I/-II, + uppercase, as lectio itself spells them). The final EMITTED slugs use + {!entries_of}'s own lowercase letters (-a/-b/-c/-i/-ii, valid + {!Slug.t} characters -- Slug.ml's own [valid_char] rejects uppercase + outright), so a distinct stripper is needed here; reusing + [base_and_letter] silently matched nothing (a real bug this generator's + own first run caught: every emitted key showed up as "dead", 580 of + them, because "-a" never matches an uppercase "-A" test). *) +let strip_emitted_suffix s = + List.fold_left + (fun acc suf -> match acc with Some _ -> acc | None -> strip_suffix ~suffix:suf s) + None [ "-a"; "-b"; "-c"; "-ii"; "-i" ] + |> Option.value ~default:s + +let assert_reachable entries ~temporal_slugs ~sanctoral_slugs = + let base_of s = strip_emitted_suffix (Slug.to_string s) in + let dead = + List.filter + (fun (s, _) -> + let b = base_of s in + not (Hashtbl.mem temporal_slugs b || Hashtbl.mem sanctoral_slugs b)) + entries + in + (match dead with + | [] -> () + | _ -> + List.iter + (fun (s, _) -> + Printf.eprintf + "bootstrap_lectionary_of: DEAD KEY -- %S is not a real Temporal_of slug (2004-2051) \ + nor a real sanctoral slug\n" + (Slug.to_string s)) + dead; + die "%d emitted key(s) are unreachable (see above)" (List.length dead)); + let emitted_temporal = Hashtbl.create 512 in + List.iter + (fun (s, _) -> + let b = base_of s in + if Hashtbl.mem temporal_slugs b then Hashtbl.replace emitted_temporal b true) + entries; + let uncovered = + Hashtbl.fold (fun s _ acc -> if Hashtbl.mem emitted_temporal s then acc else s :: acc) temporal_slugs [] + |> List.sort compare + in + uncovered + +(* ---- Coverage measurement, both directions --------------------------- *) + +(* Number 1 (temporal-day coverage): over every day of civil year 2026, how + many days does Rite_of.Temporal_of.temporal produce a slug this + generator never emits an entry for (tried flat, then both cycle-letter + suffixes -- exactly the lookup order Lectionary_of.readings itself + uses). Those are days with no readings via the temporal-slug path + (a sanctoral proper on the same day, if any, is a separate, second + chance -- see the generator's own summary printout for that count too). *) +let temporal_day_gap ~lectionary ~year_start = + let mk m d = match Date.make ~year:2026 ~month:m ~day:d with Ok t -> t | Error e -> die "%s" e in + let count = ref 0 and total = ref 0 and misses = ref [] in + for m = 1 to 12 do + let days_in_month = match m with + | 1 | 3 | 5 | 7 | 8 | 10 | 12 -> 31 | 4 | 6 | 9 | 11 -> 30 | 2 -> 28 | _ -> assert false + in + for d = 1 to days_in_month do + incr total; + let date = mk m d in + let t = Rite_of.Temporal_of.temporal date in + let base = Slug.to_string t.Temporal.office.Celebration.slug in + let found = + Lectionary.mem lectionary (slug_or_die base) + || Lectionary.mem lectionary + (slug_or_die + (base ^ "-" + ^ Rite_of.Lectionary_of.sunday_cycle_letter (Rite_of.Lectionary_of.sunday_cycle ~year_start date))) + || Lectionary.mem lectionary + (slug_or_die + (base ^ "-" + ^ Rite_of.Lectionary_of.weekday_cycle_letter + (Rite_of.Lectionary_of.weekday_cycle ~year_start date))) + in + if not found then begin + incr count; + misses := (Date.to_iso8601 date, base) :: !misses + end + done + done; + (!count, !total, List.rev !misses) + +let sha256 path = + let ic = Unix.open_process_in (Printf.sprintf "sha256sum %s" (Filename.quote path)) in + let line = try input_line ic with End_of_file -> die "sha256sum failed" in + ignore (Unix.close_process_in ic); + List.hd (String.split_on_char ' ' line) + +let () = + let src = if Array.length Sys.argv > 1 then Sys.argv.(1) else default_source in + let dst = if Array.length Sys.argv > 2 then Sys.argv.(2) else default_dest in + let secs = parse_ini src in + let resolved = resolve_sections secs in + let sanctoral_slugs = reachable_sanctoral_slugs () in + let mapped, report = map_bases resolved ~sanctoral_slugs in + let entries = List.concat_map entries_of mapped in + let temporal_slugs = reachable_temporal_slugs () in + let uncovered_temporal = assert_reachable entries ~temporal_slugs ~sanctoral_slugs in + let lect = match Lectionary.of_entries entries with Ok l -> l | Error e -> die "%s" e in + let gap_count, gap_total, gap_misses = + temporal_day_gap ~lectionary:lect ~year_start:Rite_of.Temporal_of.year_start + in + let oc = open_out dst in + Printf.fprintf oc + "; data/of/lectionary.sexp -- OF (2002) temporal + sanctoral lectionary\n\ + ; (Epistle + Gospel citations, never scripture text), bootstrapped from\n\ + ; lectio.\n\ + ;\n\ + ; LINEAGE, stated loudly because it constrains what this file can show\n\ + ; (design spec 2026-08-24-colitur-of-rite-module-design.md sec4.4/sec5):\n\ + ; this is a POLISH VERNACULAR pastoral lectionary (niedziela.pl,\n\ + ; harvested 2020-2025 by lectio's own scripts/genlect-of.go), NOT the\n\ + ; Latin OLM (Ordo Lectionum Missae) 1981 itself, and its citations are\n\ + ; ENGLISH-CANONICAL, not OLM's Vulgate numbering. It CANNOT show any\n\ + ; divergence between niedziela.pl's own pastoral choices and OLM's own\n\ + ; text -- three such divergences are already confirmed against the real\n\ + ; OLM page images (design spec sec4.4): Holy Family Year A's second-\n\ + ; reading short form, Trinity Sunday's Dan 3:56, and the Baptism of the\n\ + ; Lord's Mc 9:6 vs \"Mark 9:7\". Nor can it show OLM's short/long-form\n\ + ; reading alternatives, which niedziela.pl does not distinguish. This is\n\ + ; ALSO a SEPARATE lineage from lectio's own OF CALENDAR data\n\ + ; (data/of/calendar-2002.sexp, roman-calendar.ini, upstream\n\ + ; calapi.inadiutorium.cz) -- lectio is two unrelated upstreams glued\n\ + ; together by one downstream project, not one witness, and neither is\n\ + ; the typical edition.\n\ + ;\n\ + ; Generator: tools/bootstrap_lectionary_of.ml -- do not hand-edit;\n\ + ; re-run against the same lectio snapshot (its SHA-256 is pinned below;\n\ + ; a MISSING source file is fatal, checked before any read is attempted --\n\ + ; see this generator's own [parse_ini]) and commit the diff instead.\n\ + ; Every emitted key is asserted, at generation time, to be a slug\n\ + ; Rite_of.Temporal_of actually computes OR a slug the real merged\n\ + ; sanctoral layer (data/of/calendar-2002.sexp + all 13 decree overlays)\n\ + ; actually carries -- see [assert_reachable].\n\ + ;\n\ + ; Source: %s\n\ + ; SHA-256: %s\n\ + ; %d ini sections (988 expected) -> %d resolved (base, cycle-shape) \ +pairs -> %d colitur slugs mapped, %d ini bases deliberately excluded (date-\n\ + ; keyed duplicates/late-Advent, no colitur date-keyed lookup exists --\n\ + ; see [excluded_bases]), %d ini bases genuinely unmapped (no pattern, no\n\ + ; override, no matching sanctoral slug) -> %d emitted lectionary entries.\n\ + ;\n\ + ; COVERAGE, BOTH DIRECTIONS (Step 1 of this task's own brief):\n\ + ; (1) Temporal-day gap: of the %d days of civil year 2026, %d produce a\n\ + ; Rite_of.Temporal_of slug with NO entry in this file (tried flat,\n\ + ; then both the Sunday- and weekday-cycle letter suffixes -- the\n\ + ; same order Lectionary_of.readings itself tries). Those are days\n\ + ; with no readings via the temporal-slug path (a sanctoral proper\n\ + ; on the same civil day, where one exists, is Lectionary_of's own\n\ + ; separate first chance). Named set below.\n\ + ; (2) Unmapped lectio keys: %d ini base names (of 988 sections, %d\n\ + ; distinct bases) map to no colitur slug at all -- data being\n\ + ; silently dropped if unreported. Named below.\n\ + ; Regenerate with:\n\ + ; eval $(opam env) && dune exec tools/bootstrap_lectionary_of.exe -- %s %s\n" + src (sha256 src) (List.length secs) (List.length resolved) report.mapped + (List.length excluded_bases) (List.length report.unmapped) (List.length entries) + gap_total gap_count (List.length report.unmapped) (List.length resolved) src dst; + Printf.fprintf oc "; Unmapped lectio bases (%d):\n" (List.length report.unmapped); + List.iter (fun b -> Printf.fprintf oc "; %s\n" b) report.unmapped; + Printf.fprintf oc "; Temporal_of slugs (2004-2051) with no lectionary entry (%d, informational --\n\ + ; most are the Christmas-season/late-Advent date-vs-weekday gap named above):\n" + (List.length uncovered_temporal); + List.iter (fun s -> Printf.fprintf oc "; %s\n" s) uncovered_temporal; + Sexplib.Sexp.output_hum oc (Lectionary.sexp_of_t lect); + output_char oc '\n'; + close_out oc; + Printf.printf "bootstrap_lectionary_of: %d entries -> %s\n" (List.length entries) dst; + Printf.printf "bootstrap_lectionary_of: coverage gap 1 (temporal days, 2026): %d/%d\n" gap_count gap_total; + Printf.printf "bootstrap_lectionary_of: coverage gap 2 (unmapped lectio bases): %d\n" + (List.length report.unmapped); + ignore gap_misses |