diff options
Diffstat (limited to 'lib/kernel/layer.ml')
| -rw-r--r-- | lib/kernel/layer.ml | 65 |
1 files changed, 51 insertions, 14 deletions
diff --git a/lib/kernel/layer.ml b/lib/kernel/layer.ml index 515b052..ec074a7 100644 --- a/lib/kernel/layer.ml +++ b/lib/kernel/layer.ml @@ -20,26 +20,63 @@ let set t entry = let t = remove t entry.cel.Celebration.slug in { t with entries = canonical (entry :: t.entries) } -(* Dates are year-independent, so the index is built once per layer rather than - once per year -- a full 1583..9999 sweep would otherwise rescan the entry - list for every day. *) -type 'r by_date = (int * int, 'r entry list) Hashtbl.t +(* FIXED entries are year-independent, so their table is built once and keyed + (month, day) -- a full 1583..9999 sweep would otherwise rescan the entry + list for every day. -let key = function Date_spec.Fixed { month; day } -> (month, day) + MOVABLE entries have no such key BY CONSTRUCTION: the same spec lands on a + different (month, day) in different years, so one year-independent table + cannot serve a multi-year span. They are resolved once per civil year in + the span and keyed by rata die instead. -let index_by_date t = - let tbl : 'r by_date = Hashtbl.create 512 in + Keeping the two separate, rather than resolving everything per year, + preserves the fixed path exactly as it was -- including the "30 November + counted twice in a 371-day liturgical span" behaviour validate.mli + documents for St Andrew, which falls straight out of querying by (month, + day) and would have to be re-established by hand under a uniform rata-die + index. *) +type 'r index = { + fixed : (int * int, 'r entry list) Hashtbl.t; + movable : (int, 'r entry list) Hashtbl.t; (** keyed by rata die *) +} + +let index t ~easter ~years = + (* Filter to the kernel domain BEFORE calling [easter] on anything. A + liturgical year is Advent-anchored, so a caller resolving civil year [y] + legitimately names [y - 1] or [y + 1] -- and at the two edges those are + 1582 and 10000, which {!Computus} correctly refuses by raising. Both + edges bit during development (the ceiling via the domain-ceiling test, + the floor via `colitur day 1583`), which is why the guard lives HERE, at + the single point that calls [easter], rather than as a clamp repeated in + every caller. A spec cannot resolve outside 1583..9999 anyway, so + dropping those years loses nothing. *) + let years = List.filter (fun y -> y >= 1583 && y <= 9999) years in + let fixed : (int * int, 'r entry list) Hashtbl.t = Hashtbl.create 512 in + let movable : (int, 'r entry list) Hashtbl.t = Hashtbl.create 32 in + let add tbl k e = Hashtbl.replace tbl k (e :: (try Hashtbl.find tbl k with Not_found -> [])) in List.iter (fun e -> - let k = key e.date in - Hashtbl.replace tbl k (e :: (try Hashtbl.find tbl k with Not_found -> []))) + match e.date with + | Date_spec.Fixed { month; day } -> add fixed (month, day) e + | _ -> + (* A spec resolving to nothing in a given year is not an error: + [Date_spec.resolve]'s own [None] means "does not occur this + year", the same contract 29 February has always had. *) + List.iter + (fun year -> + match Date_spec.resolve e.date ~year ~easter:(easter year) with + | Some d -> add movable (Date.to_rata d) e + | None -> ()) + years) t.entries; - (* restore canonical order within each date bucket *) - Hashtbl.iter (fun k v -> Hashtbl.replace tbl k (canonical v)) tbl; - tbl + Hashtbl.iter (fun k v -> Hashtbl.replace fixed k (canonical v)) fixed; + Hashtbl.iter (fun k v -> Hashtbl.replace movable k (canonical v)) movable; + { fixed; movable } -let on_date tbl ~month ~day = - try Hashtbl.find tbl (month, day) with Not_found -> [] +let on_date idx date = + let f = try Hashtbl.find idx.fixed (Date.month date, Date.day date) with Not_found -> [] in + let m = try Hashtbl.find idx.movable (Date.to_rata date) with Not_found -> [] in + match m with [] -> f | _ -> canonical (f @ m) let load rank_of_sexp path = match Sexplib.Sexp.load_sexp path with |