diff options
Diffstat (limited to 'lib/kernel')
| -rw-r--r-- | lib/kernel/precedence.ml | 21 | ||||
| -rw-r--r-- | lib/kernel/precedence.mli | 15 | ||||
| -rw-r--r-- | lib/kernel/validate.ml | 26 |
3 files changed, 57 insertions, 5 deletions
diff --git a/lib/kernel/precedence.ml b/lib/kernel/precedence.ml index d48203e..2c55817 100644 --- a/lib/kernel/precedence.ml +++ b/lib/kernel/precedence.ml @@ -18,8 +18,13 @@ type ('s, 'r) rules = { admit : observed:'r candidate -> temporal:'r candidate -> - ('r candidate * privilege) list -> + ('r candidate * privilege * int) list -> ('r candidate * privilege) list; + (** the trailing [int] on each input triple is that candidate's own + [band] value, computed once by {!resolve} below (a rite's [admit] + has no [context] of its own to compute it with) -- see [resolve]'s + own comment for why this is a KERNEL-level policy, not a rite- + specific rule threaded in as data. *) } type 'r resolution = { @@ -56,7 +61,19 @@ let resolve rules ctx ~temporal ~sanctoral = ([], [], []) losers in let comms = List.rev comms and deferred = List.rev deferred in - let admitted = rules.admit ~observed ~temporal comms in + (* RG 113 (EF; docs/research/rules-register.md §4 "Commemorations"): "in + admittendis et ordinandis aliis commemorationibus, servetur ordo + tabellae praecedentiae" -- admitting AND ordering commemorations both + run on the rite's own table of precedence, the same [band] already + used above to pick [observed]. Computed here, once, generically (a + rite's own [admit] has no [ctx] of its own to call [band] with) rather + than inside every rite's [admit] separately -- a kernel-level POLICY + ("commemorations are ordered by the rite's own band"), not a + rite-specific RULE baked into the kernel: the actual [band] function, + and whether a rite's [admit] even uses the value it is handed, both + stay entirely rite-supplied. *) + let comms_by_precedence = List.map (fun (c, p) -> (c, p, rules.band ctx c)) comms in + let admitted = rules.admit ~observed ~temporal comms_by_precedence in let dropped = List.filter (fun c -> not (List.exists (fun a -> fst a == fst c) admitted)) comms in diff --git a/lib/kernel/precedence.mli b/lib/kernel/precedence.mli index d394cb1..09376d7 100644 --- a/lib/kernel/precedence.mli +++ b/lib/kernel/precedence.mli @@ -35,12 +35,25 @@ type ('s, 'r) rules = { admit : observed:'r candidate -> temporal:'r candidate -> - ('r candidate * privilege) list -> + ('r candidate * privilege * int) list -> ('r candidate * privilege) list; (** RG 108-111: how many commemorations are admitted, and in what order; anything filtered out here is recorded in {!resolution.omitted}, not dropped. + Each input triple's trailing [int] is that candidate's own {!band} + value, computed once by {!resolve} (RG 113: "in admittendis et + ordinandis aliis commemorationibus, servetur ordo tabellae + praecedentiae" -- ADMITTING and ORDERING commemorations is governed + by the same table-of-precedence order {!band} already supplies for + picking the day's own winner; docs/research/rules-register.md §4 + "Commemorations"). Supplied rather than left for [admit] to compute + itself because [admit] has no [context] (date/season/weekday) of + its own -- {!resolve} already holds one and calls {!band} with it + for every candidate regardless. A rite's [admit] is free to ignore + the value entirely (e.g. fall back to [Vocab.rank] alone), the same + as it may ignore [temporal] below. + [temporal] is {!resolve}'s own [~temporal] argument, passed through unchanged -- the day's temporal-cycle candidate, regardless of whether it won. Fix round 1 (RG16(a) task): before this, a rite's diff --git a/lib/kernel/validate.ml b/lib/kernel/validate.ml index a3208dd..433dc99 100644 --- a/lib/kernel/validate.ml +++ b/lib/kernel/validate.ml @@ -315,8 +315,29 @@ let run (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) ~year = { Precedence.cel = d.Liturgical_day.temporal.Temporal.office; origin = Precedence.Temporal } in + (* [band]'s own [context] (RG 113, docs/research/rules-register.md + §4 "Commemorations" -- {!Precedence.rules.admit}'s own new + [int] parameter, added alongside RG 113's fix: [admit] now + orders/selects by the rite's table-of-precedence value + {!resolve} attaches to each candidate, not by [Vocab.rank] + alone). Reconstructed from {!Liturgical_day.t}'s own embedded + [Temporal.t], the same source [temporal_candidate] above + already draws its [cel] from, so this is the exact [ctx] + {!Calendar} passed to {!Precedence.resolve} for this date in + the first place, not a re-derivation that could itself drift. *) + let day_ctx : 's Precedence.context = + { Precedence.date; + season = d.Liturgical_day.temporal.Temporal.season; + weekday = d.Liturgical_day.temporal.Temporal.weekday } + in let as_candidates comms = - List.map (fun (c, p) -> ({ Precedence.cel = c; origin = Precedence.Sanctoral }, p)) comms + List.map + (fun (c, p) -> + let cand : 'r Precedence.candidate = + { Precedence.cel = c; origin = Precedence.Sanctoral } + in + (cand, p, rite.Rite.rules.Precedence.band day_ctx cand)) + comms in let offered = as_candidates d.Liturgical_day.commemorations in let readmitted = @@ -327,7 +348,8 @@ let run (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) ~year = List.map (fun (c, p) -> (Slug.to_string c.Precedence.cel.Celebration.slug, p)) l |> List.sort compare in - if norm readmitted <> norm offered then + let offered_pairs = List.map (fun (c, p, _) -> (c, p)) offered in + if norm readmitted <> norm offered_pairs then fail date "admission" (Printf.sprintf "admit is not a fixed point on this day's own commemorations: re-offering %d \ |