worldvm 0.0.0-stage → 0.1.0

package/dist/_internal/forma/world/prelude.generated.js

@@ -0,0 +1,2 @@
+// Generated from preludes/world.lisp by scripts/generate-prelude.mjs. Do not edit.
+export const worldPrelude = "; world.lisp — the world prelude for Forma, owned by WorldVM.\n;\n; Descriptor forms elaborate authored operations into one canonical IR. Each form\n; declares its hole types, the names its expressions may use (:scope), the publish\n; checks it enforces (:check) and its IR. Nothing here knows what an I-9 is: the\n; library and account packages that use this prelude say that.\n;\n; Expressions are checked by Forma's own inference. Three conventions keep the\n; core unchanged:\n; - Date, Duration, Truth and Status are nominal brands. `if` requires Bool, so it\n;   refuses a Truth until true?, false? or unknown? collapses it.\n; - A reference to a role, entity or component is exposed to expressions as a record\n;   view of its fields, so `employee.legal-name` type-checks. WorldVM lowers it to a\n;   fact read. Bool fields read as Truth; Option is erased because absence is Unknown.\n; - Source logic uses and/or/not and comparisons use =/!=. The compiler adapts\n;   Truth expressions to the canonical kernel operators below before inference.\n\n; ── Scalar brands ──\n\n; Classification remains in authored IR; value typing uses the underlying type.\n(type (Sensitive classification value) value)\n\n(type Truth (Brand Bool))\n(type Date (Brand String))\n(type Instant (Brand String))\n(type Duration (Brand Int))\n(type Status (Brand Keyword))\n(type File (Brand String))\n(type Group (Brand String))\n(type Machine (Brand Keyword))\n\n; ── Vocabulary: the kernel's builtins, typed. Every expression hole sees these. ──\n\n(define\n  world/vocabulary\n  {\n    := (quote (-> a a Truth))\n    :not= (quote (-> a a Truth))\n    :!= (quote (-> a a Truth))\n    :< (quote (-> Int Int Truth))\n    :<= (quote (-> Int Int Truth))\n    :> (quote (-> Int Int Truth))\n    :>= (quote (-> Int Int Truth))\n    :in? (quote (-> a (List a) Truth))\n    :all? (quote (-> (Union Truth (List Truth)) Truth))\n    :any? (quote (-> (Union Truth (List Truth)) Truth))\n    :negate (quote (-> Truth Truth))\n    :true? (quote (-> Truth Bool))\n    :false? (quote (-> Truth Bool))\n    :unknown? (quote (-> Truth Bool))\n    :known? (quote (-> a Truth))\n    :today (quote Date)\n    :now (quote Instant)\n    :instant (quote (-> String Instant))\n    :hours-after (quote (-> Instant Int Instant))\n    :minutes-after (quote (-> Instant Int Instant))\n    :hours (quote (-> Int Duration))\n    :minutes (quote (-> Int Duration))\n    :earliest (quote (-> (List Date) Date))\n    :latest (quote (-> (List Date) Date))\n    :days (quote (-> Int Duration))\n    :years (quote (-> Int Duration))\n    :months (quote (-> Int Duration))\n    :years-after (quote (-> Date Int Date))\n    :months-after (quote (-> Date Int Date))\n    :days-after (quote (-> Date Int Date))\n    :days-before (quote (-> Date Int Date))\n    :business-days-after (quote (-> Date Int :calendar CalendarDef Date))\n    :before? (quote (-> (Union Date Instant) (Union Date Instant) Truth))\n    :on-or-after? (quote (-> (Union Date Instant) (Union Date Instant) Truth))\n    :asserted-at (quote (-> a Date))\n    :spells (quote (-> (List a) (-> a Date) (-> a Date) Duration (List (List a))))\n    :resource-generation (quote (-> Machine Int))\n    :entered-at (quote (-> Machine Keyword Date))\n    :attested-for (quote (-> Machine EvidenceDef Truth))\n    :notice-delivered? (quote (-> NoticeDef Truth))\n    :notice-acknowledged? (quote (-> NoticeDef Truth))\n    :attested (quote (-> EvidenceDef Truth))\n    :valid (quote (-> EvidenceDef Truth))\n    :decided (quote (-> DecisionDef Truth))\n    :added-on (quote (-> Keyword Date))\n    :status-is? (quote (-> Status Keyword Bool))\n    :satisfied? (quote (-> Status Truth))\n    :met? (quote (-> Status Truth))\n    :carried-over? (quote (-> Status Truth))\n    :started? (quote (-> Machine Truth))\n    :final? (quote (-> Machine Truth))\n    :in-state? (quote (-> Machine (List Keyword) Truth))})\n\n; ── Small helpers over authored data ──\n\n(define name-of [x] (if (nil? x) \"\" (if (keyword? x) (keyword/name x) (str x))))\n(define same? [a b] (= (name-of a) (name-of b)))\n(define pairs [record] (if (nil? record) [] (if (map? record) (meta/entries record) record)))\n(define head-name [x] (if (and (list? x) (not (empty? x))) (name-of (first x)) \"\"))\n(define member? [x xs] (some (fn [y] (same? x y)) xs))\n(define root-of [x] (first (split (name-of x) \".\")))\n(define dotted? [x] (and (symbol? x) (> (count (split (name-of x) \".\")) 1)))\n(define index-of\n  [x xs]\n  (get\n    (reduce\n      (fn [acc y] (if (nil? (get acc :found)) (if (same? x y) {:i (get acc :i) :found (get acc :i)} {:i (+ (get acc :i) 1) :found nil}) acc))\n      {:i 0 :found nil}\n      xs)\n    :found))\n(define fields->ir [fields] (map (fn [[k ty]] {:name (name-of k) :type ty}) (pairs fields)))\n(define option-type? [ty] (and (list? ty) (= (head-name ty) \"Option\")))\n(define strip-option [ty] (if (option-type? ty) (nth ty 1) ty))\n; Keyword unions, inline or through an author alias. Expressions see them as Keyword.\n(define\n  enum-values\n  [ty]\n  (let\n    [u (strip-option ty)]\n    (if (= (head-name u) \"Union\")\n      (rest u)\n      (if (symbol? u)\n        (let [d (type-definition u)] (if (and (not (nil? d)) (= (head-name d) \"Union\")) (rest d) nil))\n        nil))))\n(define widen [ty] (if (nil? (enum-values ty)) ty (quote Keyword)))\n; Follow simple author aliases (LegalName → String) so bindings compare base types.\n(define\n  resolve-alias\n  [ty]\n  (if (symbol? ty)\n    (let [d (type-definition ty)] (if (symbol? d) (resolve-alias d) ty))\n    (if (list? ty) (map (fn [x] (resolve-alias x)) ty) ty)))\n; Authored data back as source text, for diagnostics.\n(define\n  render\n  [x]\n  (if (list? x)\n    (if (and (not (empty? x)) (symbol? (first x)))\n      (str \"(\" (reduce (fn [acc y] (str acc (if (= acc \"\") \"\" \" \") (render y))) \"\" x) \")\")\n      (str \"[\" (reduce (fn [acc y] (str acc (if (= acc \"\") \"\" \" \") (render y))) \"\" x) \"]\"))\n    (if (keyword? x) (str \":\" (keyword/name x)) (if (string? x) (str \"\\\"\" x \"\\\"\") (str x)))))\n(define ref-target [ty] (let [u (strip-option ty)] (if (= (head-name u) \"Id\") (nth u 1) nil)))\n(define child-named [children kind] (filter (fn [c] (= (get c :kind) kind)) children))\n(define diag [code message at] {:severity :error :code code :message message :at at})\n(define warn [code message at] {:severity :warning :code code :message message :at at})\n\n; Every symbol in an expression datum, with its path from the expression root.\n(define\n  symbols-in\n  [e path]\n  (if (symbol? e)\n    [{:sym e :path path}]\n    (if (list? e)\n      (get\n        (reduce\n          (fn [acc x] {:i (+ (get acc :i) 1) :out (concat (get acc :out) (symbols-in x (concat path [(get acc :i)])))})\n          {:i 0 :out []}\n          e)\n        :out)\n      (if (map? e) (flat-map (fn [[k v]] (symbols-in v (concat path [k]))) (meta/entries e)) []))))\n\n; ── Views: what an (Id X) looks like to expressions ──\n\n(define declared? [kind x] (member? x (declarations-of kind)))\n\n(define\n  lift-field\n  [ty depth]\n  (let\n    [u (strip-option ty) target (ref-target u)]\n    (if (= (name-of u) \"Bool\")\n      (quote Truth)\n      (if (not (nil? (enum-values u)))\n        (quote Keyword)\n      (if (and (not (nil? target)) (> depth 0) (declared? (quote role) target))\n        (role-view target (- depth 1))\n        (if (and (not (nil? target)) (> depth 0) (declared? (quote entity) target))\n          (entity-view target (- depth 1))\n          u))))))\n(define\n  record-of\n  [fields depth]\n  (reduce (fn [acc [k ty]] (assoc acc (keyword (name-of k)) (lift-field ty depth))) {} (pairs fields)))\n(define role-view [role depth] (record-of (declaration-fields role) depth))\n(define entity-view [entity depth] (record-of (declaration-fields entity) depth))\n\n(define subject-role [] (let [libraries (declarations-of (quote library))] (if (empty? libraries) nil (declaration-hole (first libraries) :subject))))\n(define attached-type [] (let [subject (subject-role)] (if (nil? subject) (quote (List Unit)) [(sym \"List\") (role-view subject 1)])))\n\n(define child-forms [component] (let [children (declaration-hole component :child)] (if (nil? children) [] children)))\n(define\n  requirement-names\n  [children]\n  (map (fn [c] (nth c 1)) (filter (fn [c] (= (head-name c) \"requirement\")) children)))\n(define\n  output-names\n  [children]\n  (map (fn [c] (nth c 1)) (filter (fn [c] (= (head-name c) \"output\")) children)))\n(define\n  machine-names\n  [children]\n  (map (fn [c] (nth c 1)) (filter (fn [c] (= (head-name c) \"machine\")) children)))\n\n(define\n  component-view\n  [component]\n  (let\n    [inputs (declaration-hole component :inputs) children (child-forms component)]\n    (merge\n      (record-of inputs 1)\n      {:attached (attached-type)}\n      (reduce (fn [acc r] (assoc acc (keyword (name-of r)) (quote Status))) {} (concat (requirement-names children) (output-names children))))))\n\n(define\n  lift-type\n  [ty]\n  (let\n    [target (ref-target ty)]\n    (if (and (not (nil? target)) (= (head-name ty) \"Id\"))\n      (if (declared? (quote role) target)\n        (role-view target 1)\n        (if (declared? (quote entity) target)\n          (entity-view target 1)\n          (if (declared? (quote component) target) (component-view target) ty)))\n      (if (and (list? ty) (= (head-name ty) \"List\")) [(sym \"List\") (lift-type (nth ty 1))] (if (option-type? ty) (lift-type (nth ty 1)) (widen ty))))))\n\n(define names->scope [names type] (reduce (fn [acc n] (assoc acc (keyword (name-of n)) type)) {} names))\n(define typed->scope [record] (reduce (fn [acc [k ty]] (assoc acc (keyword (name-of k)) (lift-type ty))) {} (pairs record)))\n\n; What a component's children may name: vocabulary, its inputs and params, self,\n; attached (the subjects attached to this occurrence), its requirements and machines.\n(define\n  component/scope\n  [{:keys [name inputs params child]}]\n  (merge\n    world/vocabulary\n    (typed->scope inputs)\n    (typed->scope params)\n    {:self (component-view name) :attached (attached-type)}\n    (names->scope (requirement-names child) (quote Status))\n    (names->scope (machine-names child) (quote Machine))))\n\n; ── Library, roles and calendars ──\n\n(type\n  SourceIR\n  {:kind \"Source\" :name Symbol :doc (Option String) :source-kind Keyword\n   :jurisdiction (Option Keyword) :url String :as-of String})\n(form\n  (source name doc {:keys [kind jurisdiction url as-of]})\n  \"A dated authority or illustrative policy cited by library clauses.\"\n  :types {:name (Declares SourceDef) :doc (Option String) :kind Keyword\n          :jurisdiction (Option Keyword) :url String :as-of String}\n  :check (fn [{:keys [kind]}]\n    (if (member? kind [:law :regulation :guidance :framework :contract :policy]) []\n      [(diag \"E_SOURCE_KIND\" \"Unknown source kind.\" [:kind])]))\n  :ir SourceIR\n  {:kind \"Source\" :name name :doc doc :source-kind kind :jurisdiction jurisdiction :url url :as-of as-of})\n\n(type\n  LibraryIR\n  {:kind \"Library\" :name Symbol :doc (Option String) :version String :subject Symbol})\n(form\n  (library name doc {:keys [version subject]})\n  \"A versioned library of components, typed against roles.\"\n  :types\n    {:name (Declares LibraryDef) :doc (Option String) :version String :subject (Refers RoleDef)}\n  :ir LibraryIR\n  {:kind \"Library\" :name name :doc doc :version version :subject subject})\n\n(type FieldIR {:name String :type Type})\n(type RoleIR {:kind \"Role\" :name Symbol :doc (Option String) :fields (List FieldIR) :files (Option Syntax) :sealed-by (Option Syntax)})\n(form\n  (role name doc {:keys [files sealed-by]} fields)\n  \"An interface library components read. It stores nothing; entities implement it.\"\n  :types {:name (Declares RoleDef) :doc (Option String) :files (Option Syntax) :sealed-by (Option Syntax) :fields (Record Type)}\n  :ir RoleIR\n  {:kind \"Role\" :name name :doc doc :fields (fields->ir fields) :files files :sealed-by sealed-by})\n\n(type\n  HolidayIR\n  {\n    :kind \"Holiday\"\n    :name Symbol\n    :label String\n    :month Int\n    :day (Option Int)\n    :weekday (Option Keyword)\n    :nth (Option Int)\n    :observed Bool})\n(type calendar-child HolidayIR)\n(form\n  (calendar-child/holiday name label {:keys [month day weekday nth observed]})\n  :types\n    {\n      :name Symbol\n      :label String\n      :month Int\n      :day (Option Int)\n      :weekday (Option Keyword)\n      :nth (Option Int)\n      :observed (Option Bool)}\n  :check\n    (fn\n      [{:keys [day weekday nth]}]\n      (if (= (nil? day) (or (nil? weekday) (nil? nth)))\n        [(diag \"E_HOLIDAY_RULE\" \"A holiday is either a fixed :day or a :weekday with :nth (-1 is the last).\" [:name])]\n        []))\n  :ir HolidayIR\n  {\n    :kind \"Holiday\"\n    :name name\n    :label label\n    :month month\n    :day day\n    :weekday weekday\n    :nth nth\n    :observed (if (nil? observed) false observed)})\n(type\n  CalendarIR\n  {\n    :kind \"Calendar\"\n    :name Symbol\n    :doc (Option String)\n    :version String\n    :weekend (List Keyword)\n    :holidays (List HolidayIR)})\n(form\n  (calendar name doc {:keys [version weekend]} child ...)\n  \"A named, versioned business-day calendar.\"\n  :types\n    {\n      :name (Declares CalendarDef)\n      :doc (Option String)\n      :version String\n      :weekend (List Keyword)\n      :child (List calendar-child)}\n  :ir CalendarIR\n  {:kind \"Calendar\" :name name :doc doc :version version :weekend weekend :holidays child})\n\n; Tables select a named keyword parameter. Closed enums need all rows or a default.\n(define table/key-type [ty seen]\n  (if (or (= (head-name ty) \"Option\") (= (head-name ty) \"Brand\"))\n    (table/key-type (nth ty 1) seen)\n    (if (same? ty \"Keyword\") {:kind :open :values []}\n      (if (= (head-name ty) \"Union\")\n        (if (and (> (count (rest ty)) 0) (every? (fn [x] (keyword? x)) (rest ty)))\n          {:kind :enum :values (rest ty)} {:kind :invalid :values []})\n        (if (and (symbol? ty) (not (member? ty seen)))\n          (let [d (type-definition ty)]\n            (if (nil? d) {:kind :invalid :values []}\n              (table/key-type d (concat seen [ty]))))\n          {:kind :invalid :values []})))))\n(define table/rows [xs]\n  (if (empty? xs) {:valid true :keys []}\n    (if (< (count xs) 2) {:valid false :keys []}\n      (let [tail (table/rows (rest (rest xs)))]\n        {:valid (and (keyword? (first xs)) (get tail :valid))\n         :keys (concat [(first xs)] (get tail :keys))}))))\n(define table/check-one [e path params]\n  (let [selector (nth e 1)\n        param (first (filter (fn [[k ty]] (same? k selector)) (pairs params)))\n        ty (table/key-type (if (nil? param) nil (nth param 1)) [])\n        rows (table/rows (rest (rest e)))\n        keys (get rows :keys)\n        plain (filter (fn [k] (not (same? k :else))) keys)\n        fallback (member? :else keys)]\n    (if (or (< (count e) 4) (not (symbol? selector)) (nil? param)\n            (= (get ty :kind) :invalid) (not (get rows :valid))\n            (not (= (count keys) (count (distinct keys))))\n            (and fallback (not (same? (nth keys (- (count keys) 1)) :else)))\n            (and (= (get ty :kind) :enum)\n              (some (fn [k] (not (member? k (get ty :values)))) plain)))\n      [(diag \"E_TABLE_SHAPE\" \"A table needs a named keyword parameter and unique declared rows, with :else last.\" path)]\n      (if (and (not fallback)\n                (or (= (get ty :kind) :open)\n                    (some (fn [k] (not (member? k keys))) (get ty :values))))\n        [(diag \"E_TABLE_NOT_EXHAUSTIVE\" \"Table rows do not cover every possible keyword; add the missing rows or :else.\" path)]\n        []))))\n(define table/checks [e path params]\n  (if (list? e)\n    (concat\n      (if (= (head-name e) \"table\") (table/check-one e path params) [])\n      (get (reduce (fn [acc x]\n        {:i (+ (get acc :i) 1)\n         :out (concat (get acc :out) (table/checks x (concat path [(get acc :i)])\n           (if (= (head-name e) \"fn\")\n             (filter (fn [[k ty]] (not (member? k (nth e 1)))) (pairs params)) params)))})\n        {:i 0 :out []} e) :out))\n    []))\n\n; ── Derived values: named, typed expressions over facts ──\n(define derive/param-type [ty]\n  (if (= (get (table/key-type ty []) :kind) :invalid) (lift-type ty) (quote Keyword)))\n(define derive/scope [params]\n  (reduce (fn [scope [k ty]] (assoc scope (keyword (name-of k)) (derive/param-type ty))) {} (pairs params)))\n\n; UPSTREAM: Forma 0.5.0 resolves :scope and Expr aliases but omits the prelude\n; type map when resolving a form's :type result. Expand exported derive signatures\n; here until the result-type hook transports the same aliases as expression holes.\n(define derive/export-type [ty seen]\n  (if (and (symbol? ty) (not (member? ty seen)))\n    (let [definition (type-definition ty)]\n      (if (nil? definition) ty\n        (if (= (head-name definition) \"Brand\")\n          [(sym \"Brand\") ty (derive/export-type (nth definition 1) (concat seen [ty]))]\n          (if (symbol? definition)\n            (let [expanded (derive/export-type definition (concat seen [ty]))]\n              (if (= (head-name expanded) \"Brand\") expanded ty)) ty))))\n    (if (list? ty) (map (fn [part] (derive/export-type part seen)) ty)\n      (if (map? ty) (reduce (fn [out [k v]] (assoc out k (derive/export-type v seen))) {} (pairs ty)) ty))))\n\n(define\n  derive/fn-type\n  [params returns]\n  (derive/export-type (concat [(sym \"->\")] (map (fn [[k ty]] (derive/param-type ty)) (pairs params)) [returns]) []))\n(type\n  DeriveIR\n  {\n    :kind \"Derive\"\n    :name Symbol\n    :doc (Option String)\n    :params (List FieldIR)\n    :returns Type\n    :body RuntimeExpr})\n(form\n  (derive name doc {:keys [params returns]} body)\n  \"A derived value: an ordinary typed function that reads facts through its parameters.\"\n  :types\n    {\n      :name (Declares DeriveDef)\n      :doc (Option String)\n      :params (Record Type)\n      :returns Type\n      :body (Expr returns)}\n  :scope {:body (fn [{:keys [params]}] (merge world/vocabulary (derive/scope params)))}\n  :type (fn [{:keys [params returns]}] (derive/fn-type params returns))\n  :check\n    (fn\n      [{:keys [returns params body]}]\n      (concat (table/checks body [:body] params)\n      (if (some (fn [s] (same? (get s :sym) \"Id\")) (symbols-in returns []))\n        [(diag \"E_DERIVE_RETURNS_REF\" \"A derived value returns data, not references (PoC limit).\" [:returns])]\n        [])))\n  :ir DeriveIR\n  {\n    :kind \"Derive\"\n    :name name\n    :doc doc\n    :params (fields->ir params)\n    :returns returns\n    :body body})\n\n; ── Evidence: what gets signed, and the rules on it ──\n\n(define evidence/fields-scope [fields] (reduce (fn [acc [k ty]] (assoc acc (keyword (name-of k)) (widen (strip-option ty)))) {} (pairs fields)))\n(define evidence/scope [fields] (merge world/vocabulary (evidence/fields-scope fields)))\n; Expiry may also read signed-on, the record's signing date; a declared field of that name wins.\n(define evidence/expiry-scope [fields] (merge (assoc world/vocabulary :signed-on (quote Date)) (evidence/fields-scope fields)))\n\n(type RuleIR {:kind \"Rule\" :name Symbol :when (Option RuntimeExpr) :requires Syntax})\n(type AttestIR {:kind \"Attest\" :signer Symbol :covers Keyword :method Keyword :audit (Option Syntax)})\n(type AmendIR {:kind \"Amend\"})\n(type evidence-child (Union RuleIR AttestIR AmendIR))\n(form (evidence-child/amend) :types {} :ir AmendIR {:kind \"Amend\"})\n(form\n  (evidence-child/rule name {:keys [when requires]})\n  :types {:name Symbol :when (Option (Expr Truth)) :requires Syntax}\n  :ir RuleIR\n  {:kind \"Rule\" :name name :when when :requires requires})\n(form\n  (evidence-child/attest {:keys [signer covers method audit]})\n  :types {:signer Symbol :covers Keyword :method Keyword :audit (Option Syntax)}\n  :ir AttestIR\n  {:kind \"Attest\" :signer signer :covers covers :method method :audit audit})\n\n(define\n  rule/valid-requires?\n  [requires]\n  (or (symbol? requires)\n    (and (list? requires) (> (count requires) 1) (symbol? (first requires))\n      (member? (head-name requires) [\"one-of\" \"all-of\"])\n      (every? symbol? (rest requires)))))\n(define\n  rule/required-fields\n  [requires]\n  (if (rule/valid-requires? requires)\n    (if (symbol? requires) [requires] (rest requires))\n    []))\n(define\n  evidence/check\n  [{:keys [fields child]}]\n  (let\n    [names (map (fn [[k ty]] (name-of k)) (pairs fields))]\n    (flat-map\n      (fn\n        [rule]\n        (if (rule/valid-requires? (get rule :requires))\n          (flat-map\n            (fn\n              [field]\n              (if (member? field names)\n                []\n                [(diag \"E_UNKNOWN_FIELD\" (str \"Rule \" (name-of (get rule :name)) \" requires \" (name-of field) \", which is not a field of this evidence.\") [:child (get rule :name) :requires])]))\n            (rule/required-fields (get rule :requires)))\n          [(diag \"E_RULE_REQUIRES\" \"Evidence rule :requires accepts field, (one-of …), (all-of …); groups must contain one or more field names.\" [:child (get rule :name) :requires])]))\n      (child-named child \"Rule\"))))\n(type\n  EvidenceIR\n  {\n    :kind \"Evidence\"\n    :name Symbol\n    :doc (Option String)\n    :of Symbol\n    :label (Option String)\n    :expires (Option RuntimeExpr)\n    :fields (List FieldIR)\n    :files (Option Syntax) :sealed-by (Option Syntax)\n    :rules (List RuleIR)\n    :attest (List AttestIR)})\n(form\n  (evidence name doc {:keys [of label expires files sealed-by]} fields child ...)\n  \"A typed record kept exactly as signed. Rules on it decide which fields are required.\"\n  :types\n    {\n      :name (Declares EvidenceDef)\n      :doc (Option String)\n      :of (Refers ComponentDef)\n      :label (Option String)\n      :expires (Option (Expr Date))\n      :files (Option Syntax) :sealed-by (Option Syntax)\n      :fields (Record Type)\n      :child (List evidence-child)}\n  :scope {:expires (fn [{:keys [fields]}] (evidence/expiry-scope fields)) :child (fn [{:keys [fields]}] (evidence/scope fields))}\n  :check evidence/check\n  :ir EvidenceIR\n  {\n    :kind \"Evidence\"\n    :name name\n    :doc doc\n    :of of\n    :label label\n    :expires expires\n    :fields (fields->ir fields)\n    :files files\n    :sealed-by sealed-by\n    :rules (child-named child \"Rule\")\n    :attest (child-named child \"Attest\")})\n\n; Documents pin fixed templates over their component's committed evidence.\n(type DocumentIR {:kind \"Document\" :name Symbol :doc (Option String) :of Symbol :resource (Option Syntax) :sealed-by (Option Syntax)\n :from (Option Syntax) :edition (Option Syntax) :effective (Option Syntax) :template (Option Syntax)})\n(form (document name doc {:keys [of resource from edition effective template sealed-by]})\n \"A fixed versioned PDF template over signed evidence owned by one component.\"\n :types {:name (Declares DocumentDef) :doc (Option String) :of Symbol :resource (Option Syntax) :sealed-by (Option Syntax)\n  :from (Option Syntax) :edition (Option Syntax) :effective (Option Syntax) :template (Option Syntax)}\n :ir DocumentIR {:kind \"Document\" :name name :doc doc :of of :resource resource :from from :edition edition :effective effective :template template :sealed-by sealed-by})\n; Delivery and human acknowledgment refer to one exact document copy.\n(type NoticeIR {:kind \"Notice\" :name Symbol :doc (Option String)\n :of (Option Syntax) :document (Option Syntax) :to (Option Syntax) :sealed-by (Option Syntax)})\n(form (notice name doc {:keys [of document to sealed-by]})\n \"A document delivered to one person, with separate acknowledgment evidence.\"\n :types {:name (Declares NoticeDef) :doc (Option String)\n  :of (Option Syntax) :document (Option Syntax) :to (Option Syntax) :sealed-by (Option Syntax)}\n :ir NoticeIR {:kind \"Notice\" :name name :doc doc :of of :document document :to to :sealed-by sealed-by})\n; ── Components: keyed obligations with requirements, actions, children and outputs ──\n\n(type\n  RequirementIR\n  {\n    :kind \"Requirement\"\n    :name Symbol\n    :label (Option String)\n    :applies-when (Option RuntimeExpr)\n    :discretionary (Option Symbol)\n    :satisfied-by RuntimeExpr\n    :accepts (Option Syntax)\n    :reuse (Option Syntax)\n    :cycle (Option RuntimeExpr)\n    :recur (Option RuntimeExpr)\n    :effective (Option Syntax)\n    :due (Option RuntimeExpr)\n    :remind (Option RuntimeExpr)\n    :renew-within (Option Syntax)\n    :escalate (Option Syntax)\n    :cites (Option Syntax)})\n(type\n  ActionIR\n  {\n    :kind \"Action\"\n    :name Symbol\n    :label (Option String)\n    :advances (Union Symbol (List Symbol))\n    :needs (Option RuntimeExpr)\n    :assignee (Option Syntax)\n    :via Syntax\n    :dispatch (Option Keyword)\n    :on-ineligible (Option Keyword)\n    :idempotency (Option Syntax)})\n(type\n  SlotIR\n  {\n    :kind \"Slot\"\n    :mode String\n    :name Symbol\n    :component Symbol\n    :bind Syntax\n    :with (Option Syntax)\n    :discretionary (Option Symbol)\n    :applies-when (Option RuntimeExpr)})\n(type OutputIR {:kind \"Output\" :name Symbol :label (Option String) :expr Syntax})\n(type MachineUseIR {:kind \"MachineUse\" :name Symbol :protocol Symbol})\n(type InvariantIR {:kind \"Invariant\" :name Symbol :forbids Syntax :while RuntimeExpr :cites (Option Syntax)})\n(type MilestoneIR {:kind \"Milestone\" :name Symbol :label (Option String) :when RuntimeExpr})\n(type HoldIR {:kind \"Hold\" :name Symbol :label (Option String) :while RuntimeExpr :pauses Syntax :cites (Option Syntax)})\n(type ResourceIR {:kind \"Resource\" :name Symbol :acquire Syntax :release Syntax :release-when RuntimeExpr})\n(type RetentionIR {:kind \"Retention\" :until RuntimeExpr :disposal Keyword :cites (Option Syntax)})\n(type\n  component-child\n  (Union RequirementIR ActionIR SlotIR OutputIR MachineUseIR InvariantIR MilestoneIR HoldIR ResourceIR RetentionIR))\n\n(form\n  (component-child/resource name {:keys [acquire release release-when]})\n  :types {:name Symbol :acquire Syntax :release Syntax :release-when (Expr Truth)}\n  :ir ResourceIR\n  {:kind \"Resource\" :name name :acquire acquire :release release :release-when release-when})\n\n(form\n  (component-child/requirement name {:keys [label applies-when discretionary satisfied-by accepts reuse cycle recur effective due remind renew-within escalate cites]})\n  :types\n    {\n      :name Symbol\n      :label (Option String)\n      :applies-when (Option (Expr Truth))\n      :discretionary (Option Symbol)\n      :satisfied-by (Expr Truth)\n      :accepts (Option Syntax)\n      :reuse (Option Syntax)\n      :cycle (Option (Expr (Union Date Int)))\n      :recur (Option (Expr {:every Duration :from Date}))\n      :effective (Option Syntax)\n      :due (Option (Expr (Union Date Instant)))\n      :remind (Option (Expr Duration))\n      :renew-within (Option Syntax)\n      :escalate (Option Syntax)\n      :cites (Option Syntax)}\n  :ir RequirementIR\n  {\n    :kind \"Requirement\"\n    :name name\n    :label label\n    :applies-when applies-when\n    :discretionary discretionary\n    :satisfied-by satisfied-by\n    :accepts accepts\n    :reuse reuse\n    :cycle cycle\n    :recur recur\n    :effective effective\n    :due due\n    :remind remind\n    :renew-within renew-within\n    :escalate escalate\n    :cites cites})\n(form\n  (component-child/action name {:keys [label advances needs assignee via idempotency dispatch on-ineligible]})\n  :types\n    {\n      :name Symbol\n      :label (Option String)\n      :advances (Union Symbol (List Symbol))\n      :needs (Option (Expr (List Truth)))\n      :assignee (Option Syntax)\n      :via Syntax\n      :dispatch (Option Keyword)\n      :on-ineligible (Option Keyword)\n      :idempotency (Option Syntax)}\n  :ir ActionIR\n  {\n    :kind \"Action\"\n    :name name\n    :label label\n    :advances advances\n    :needs needs\n    :assignee assignee\n    :via via\n    :dispatch dispatch\n    :on-ineligible on-ineligible\n    :idempotency idempotency})\n(form\n  (component-child/child name component {:keys [bind with applies-when discretionary]})\n  :types\n    {:name Symbol :component (Refers ComponentDef) :bind Syntax :with (Option Syntax) :applies-when (Option (Expr Truth)) :discretionary (Option Symbol)}\n  :ir SlotIR\n  {:kind \"Slot\" :mode \"child\" :name name :component component :bind bind :with with :applies-when applies-when :discretionary discretionary})\n(form\n  (component-child/attach name component {:keys [bind with applies-when]})\n  :types\n    {:name Symbol :component (Refers ComponentDef) :bind Syntax :with (Option Syntax) :applies-when (Option (Expr Truth))}\n  :ir SlotIR\n  {:kind \"Slot\" :mode \"attach\" :name name :component component :bind bind :with with :applies-when applies-when :discretionary nil})\n(form\n  (component-child/output name {:keys [label]} expr)\n  :types {:name Symbol :label (Option String) :expr Syntax}\n  :ir OutputIR\n  {:kind \"Output\" :name name :label label :expr expr})\n(form\n  (component-child/machine name protocol)\n  :types {:name Symbol :protocol (Refers MachineDef)}\n  :ir MachineUseIR\n  {:kind \"MachineUse\" :name name :protocol protocol})\n(form\n  (component-child/invariant name {:keys [forbids while cites]})\n  :types {:name Symbol :forbids Syntax :while (Expr Truth) :cites (Option Syntax)}\n  :ir InvariantIR\n  {:kind \"Invariant\" :name name :forbids forbids :while while :cites cites})\n(form\n  (component-child/milestone name {:keys [label when]})\n  :types {:name Symbol :label (Option String) :when (Expr Truth)}\n  :ir MilestoneIR\n  {:kind \"Milestone\" :name name :label label :when when})\n\n(form\n  (component-child/hold name {:keys [label while pauses cites]})\n  :types {:name Symbol :label (Option String) :while (Expr Truth) :pauses Syntax :cites (Option Syntax)}\n  :ir HoldIR\n  {:kind \"Hold\" :name name :label label :while while :pauses pauses :cites cites})\n\n(form\n  (component-child/retention {:keys [until disposal cites]})\n  :types {:until (Expr Date) :disposal Keyword :cites (Option Syntax)}\n  :ir RetentionIR\n  {:kind \"Retention\" :until until :disposal disposal :cites cites})\n\n; Publish checks for a component (§9.1, P7).\n\n; Key closure: a keyed component may read only its key inputs and aggregates over\n; attached. Reading another input would differ between the subjects sharing it.\n(define\n  expression-holes\n  [child]\n  (flat-map\n    (fn\n      [c]\n      (map\n        (fn [hole] {:child (get c :name) :hole hole :expr (meta/get c hole)})\n        (filter (fn [hole] (not (nil? (meta/get c hole)))) [:applies-when :satisfied-by :cycle :recur :due :remind :escalate :needs :assignee :bind :while :when :until :forbids :idempotency :expr])))\n    child))\n(define raw [x] (if (and (map? x) (= (get x :kind) \"raw-expr\")) (get x :expr) x))\n(define\n  component/key-closure\n  [{:keys [key inputs child]}]\n  (let\n    [outside (filter (fn [n] (not (member? n key))) (map (fn [[k ty]] (name-of k)) (pairs inputs)))]\n    (flat-map\n      (fn\n        [h]\n        (flat-map\n          (fn\n            [s]\n            (if (member? (root-of (get s :sym)) outside)\n              [(diag \"E_READ_OUTSIDE_KEY\" (str \"Reads \" (name-of (get s :sym)) \", but \" (root-of (get s :sym)) \" is not part of :key \" (str \"[\" (reduce (fn [acc k] (str acc (if (= acc \"\") \"\" \" \") (name-of k))) \"\" key) \"]\") \". Subjects that share this instance could disagree about it.\") (concat [:child (get h :child) (get h :hole)] (get s :path)))]\n              []))\n          (symbols-in (raw (get h :expr)) [])))\n      (expression-holes child))))\n\n; Keys are stable identities: (Id E) references or keyword enums.\n(define\n  component/entity-home?\n  [component seen]\n  (if (member? component seen)\n    false\n    (let\n      [key (declaration-hole component :key)\n       input (first key)\n       typed (first (filter (fn [[n ty]] (same? n input)) (pairs (declaration-hole component :inputs))))\n       target (if (nil? typed) nil (ref-target (nth typed 1)))]\n      (if (nil? target)\n        false\n        (if (or (declared? (quote role) target) (declared? (quote entity) target))\n          true\n          (if (declared? (quote component) target)\n            (component/entity-home? target (concat seen [component]))\n            false))))))\n(define\n  component/home\n  [{:keys [name key]}]\n  (if (component/entity-home? name [])\n    []\n    [(diag \"E_NO_HOME\"\n      (str \"Component \" (name-of name) \" has no entity home. Its first key must lead to an entity reference.\")\n      (if (empty? key) [:key] [:key 0]))]))\n\n(define stable-type? [ty] (or (= (head-name ty) \"Id\") (same? ty \"Keyword\") (= (head-name ty) \"Union\")))\n(define\n  component/keys-stable\n  [{:keys [key inputs]}]\n  (let\n    [typed (pairs inputs) idx {:i 0}]\n    (get\n      (reduce\n        (fn\n          [acc k]\n          (let\n            [found (first (filter (fn [[n ty]] (same? n k)) typed)) at [:key (get acc :i)]]\n            {\n              :i (+ (get acc :i) 1)\n              :out\n                (concat\n                  (get acc :out)\n                  (if (nil? found)\n                    [(diag \"E_KEY_NOT_INPUT\" (str (name-of k) \" is in :key but is not an input.\") at)]\n                    (if (stable-type? (nth found 1))\n                      []\n                      [(diag \"E_UNSTABLE_KEY\" (str \"Key \" (name-of k) \" is a value, not a stable identity. Keys must be (Id E) references or keyword enums.\") at)])))}))\n        {:i 0 :out []}\n        key)\n      :out)))\n\n; P7: every requirement can make progress — an action advances it, or a declared\n; connector signal can move the machine it waits on.\n(define action-targets [a] (if (symbol? (get a :advances)) [(get a :advances)] (get a :advances)))\n(define mentions? [e names] (some (fn [s] (member? (root-of (get s :sym)) names)) (symbols-in (raw e) [])))\n(define\n  component/producers\n  [{:keys [child]}]\n  (let\n    [actions (child-named child \"Action\") machines (map (fn [m] (get m :name)) (child-named child \"MachineUse\"))]\n    (concat\n      (flat-map\n        (fn\n          [a]\n          (flat-map (fn [target]\n            (if (member? target (map (fn [r] (get r :name)) (child-named child \"Requirement\")))\n              []\n              [(diag \"E_UNKNOWN_REQUIREMENT\" (str \"Action \" (name-of (get a :name)) \" advances \" (name-of target) \", which this component does not declare.\") [:child (get a :name) :advances])])) (action-targets a)))\n        actions)\n      (flat-map\n        (fn\n          [r]\n          (if (or\n                (some (fn [a] (member? (get r :name) (action-targets a))) actions)\n                (mentions? (get r :satisfied-by) machines))\n            []\n            [(warn \"W_NO_PRODUCER\" (str \"Requirement \" (name-of (get r :name)) \" has no action that advances it and waits on no signal. It will be reported as blocked when open.\") [:child (get r :name) 1])]))\n        (child-named child \"Requirement\")))))\n\n; Bindings name exactly the inputs of the bound component.\n(define\n  component/bindings\n  [{:keys [child]}]\n  (flat-map\n    (fn\n      [slot]\n      (let\n        [expected (map (fn [[k ty]] (name-of k)) (pairs (declaration-hole (get slot :component) :inputs)))\n         given (map (fn [[k v]] (name-of k)) (pairs (get slot :bind)))]\n        (concat\n          (flat-map (fn [n] (if (member? n given) [] [(diag \"E_BIND\" (str (name-of (get slot :component)) \" needs :\" n \" in :bind.\") [:child (get slot :name) :bind])])) expected)\n          (flat-map (fn [n] (if (member? n expected) [] [(diag \"E_BIND\" (str (name-of (get slot :component)) \" has no input :\" n \".\") [:child (get slot :name) :bind n])])) given))))\n    (child-named child \"Slot\")))\n\n(define\n  component/check\n  [holes]\n  (concat\n    (component/keys-stable holes)\n    (component/home holes)\n    (component/key-closure holes)\n    (component/producers holes)\n    (component/bindings holes)))\n\n(type\n  ComponentIR\n  {\n    :kind \"Component\"\n    :library (Option Symbol)\n    :operations (Option Syntax)\n    :name Symbol\n    :doc (Option String)\n    :key (List Symbol)\n    :inputs (List FieldIR)\n    :params (List FieldIR)\n    :param-bounds (Option Syntax)\n    :cycle (Option RuntimeExpr)\n    :requirements (List RequirementIR)\n    :actions (List ActionIR)\n    :slots (List SlotIR)\n    :outputs (List OutputIR)\n    :machines (List MachineUseIR)\n    :invariants (List InvariantIR)\n    :milestones (List MilestoneIR)\n    :holds (List HoldIR)\n    :resources (List ResourceIR)\n    :retention (List RetentionIR)})\n(form\n  (component name doc {:keys [library operations key inputs params param-bounds cycle]} child ...)\n  \"A keyed obligation. Subjects with the same key share one live instance.\"\n  :types\n    {\n      :name (Declares ComponentDef)\n      :library (Option (Refers LibraryDef))\n      :operations (Option Syntax)\n      :doc (Option String)\n      :key (List Symbol)\n      :inputs (Record Type)\n      :params (Option (Record Type))\n      :param-bounds (Option Syntax)\n      :cycle (Option (Expr (List (List a))))\n      :child (List component-child)}\n  :scope\n    {:child component/scope :cycle (fn [holes] (merge (component/scope holes) {:attached (attached-type)}))}\n  :check component/check\n  :ir ComponentIR\n  {\n    :kind \"Component\"\n    :library library\n    :operations operations\n    :name name\n    :doc doc\n    :key key\n    :inputs (fields->ir inputs)\n    :params (fields->ir params)\n    :param-bounds param-bounds\n    :cycle cycle\n    :requirements (child-named child \"Requirement\")\n    :actions (child-named child \"Action\")\n    :slots (child-named child \"Slot\")\n    :outputs (child-named child \"Output\")\n    :machines (child-named child \"MachineUse\")\n    :invariants (child-named child \"Invariant\")\n    :milestones (child-named child \"Milestone\")\n    :holds (child-named child \"Hold\")\n    :resources (child-named child \"Resource\")\n    :retention (child-named child \"Retention\")})\n\n; Public components have named completed contracts; imports pin their public identity.\n(type ComponentContractIR\n  {:kind \"ComponentContract\" :name Symbol :doc (Option String) :of Symbol :library Symbol\n   :outputs Syntax :operations Syntax :capabilities Syntax})\n(form\n  (component-contract name doc {:keys [of library outputs operations capabilities]})\n  \"A completed public component surface, distinct from its implementation release.\"\n  :types {:name (Declares ComponentContractDef) :doc (Option String) :of Symbol :library Symbol\n          :outputs Syntax :operations Syntax :capabilities (Option Syntax)}\n  :ir ComponentContractIR\n  {:kind \"ComponentContract\" :name name :doc doc :of of :library library\n   :outputs outputs :operations operations :capabilities (if (nil? capabilities) [] capabilities)})\n(type ComponentImportIR\n  {:kind \"ComponentImport\" :name Symbol :doc (Option String) :library Symbol :from Symbol\n   :version String :contract Symbol})\n(form\n  (component-import name doc {:keys [library from version contract]})\n  \"Pin a completed contract for composition by another library.\"\n  :types {:name (Declares ComponentImportDef) :doc (Option String) :library Symbol :from Symbol\n          :version String :contract Symbol}\n  :ir ComponentImportIR\n  {:kind \"ComponentImport\" :name name :doc doc :library library :from from\n   :version version :contract contract})\n; ── Interactions and layouts ──\n\n(type\n  LayoutItemIR\n  {\n    :kind String\n    :name (Option Symbol)\n    :label (Option String)\n    :show-when (Option RuntimeExpr)\n    :options (Option Syntax)\n    :items (List Json)})\n(type step-child LayoutItemIR)\n(form\n  (step-child/field name {:keys [label show-when options]})\n  :types {:name Symbol :label (Option String) :show-when (Option (Expr Truth)) :options (Option Syntax)}\n  :ir LayoutItemIR\n  {:kind \"Field\" :name name :label label :show-when show-when :options options :items []})\n(form\n  (step-child/group name {:keys [label show-when]} child ...)\n  :types {:name Symbol :label (Option String) :show-when (Option (Expr Truth)) :child (List step-child)}\n  :ir LayoutItemIR\n  {:kind \"Group\" :name name :label label :show-when show-when :items child})\n(form\n  (step-child/widget name)\n  :types {:name Symbol}\n  :ir LayoutItemIR\n  {:kind \"Widget\" :name name :items []})\n(form (step-child/sign) :types {} :ir LayoutItemIR {:kind \"Sign\" :items []})\n(type StepIR {:kind \"Step\" :name Symbol :label (Option String) :items (List LayoutItemIR)})\n(type layout-child StepIR)\n(form\n  (layout-child/step name label child ...)\n  :types {:name Symbol :label (Option String) :child (List step-child)}\n  :ir StepIR\n  {:kind \"Step\" :name name :label label :items child})\n\n(define\n  interactions-for-layout\n  [layout]\n  (filter (fn [i] (same? (declaration-hole i :layout) layout)) (declarations-of (quote interaction))))\n(define\n  layout/evidence\n  [layout]\n  (let [found (interactions-for-layout layout)] (if (empty? found) nil (declaration-hole (first found) :produces))))\n(define\n  layout/scope\n  [{:keys [name]}]\n  (let [evidence (layout/evidence name)] (if (nil? evidence) world/vocabulary (evidence/scope (declaration-fields evidence)))))\n\n; Show-when coverage: whenever an evidence rule requires a field, the layout shows it.\n; Proven by enumerating the keyword unions the predicates mention.\n\n; Every field in the layout with the predicates that must hold for it to be shown,\n; and the :at path to its narrowest :show-when.\n(define\n  layout/fields\n  [steps]\n  (flat-map\n    (fn [step] (layout/items-of (get step :items) [] [:child (get step :name)]))\n    steps))\n(define\n  layout/items-of\n  [items guards path]\n  (flat-map\n    (fn\n      [item]\n      (let\n        [here (concat path [(get item :name)])\n         guard (raw (get item :show-when))\n         next-guards (if (nil? guard) guards (concat guards [guard]))]\n        (if (= (get item :kind) \"Field\")\n          [{:name (get item :name) :guards next-guards :at (if (nil? guard) here (concat here [:show-when]))}]\n          (if (= (get item :kind) \"Group\") (layout/items-of (get item :items) next-guards here) []))))\n    items))\n\n; A three-valued reading of the small predicate language over one assignment:\n; true, false, or nil when the predicate can't be decided statically.\n(define\n  pred/eval\n  [p env]\n  (if (= p true)\n    true\n    (if (= p false)\n      false\n      (let\n        [op (head-name p)]\n        (if (= op \"=\")\n          (let [v (meta/get env (keyword (name-of (nth p 1))))] (if (nil? v) nil (same? v (nth p 2))))\n          (if (= op \"in?\")\n            (let [v (meta/get env (keyword (name-of (nth p 1))))] (if (nil? v) nil (member? v (nth p 2))))\n            (if (= op \"negate\")\n              (let [v (pred/eval (nth p 1) env)] (if (nil? v) nil (not v)))\n              (if (= op \"all?\")\n                (let [vs (map (fn [q] (pred/eval q env)) (nth p 1))] (if (some (fn [v] (= v false)) vs) false (if (some (fn [v] (nil? v)) vs) nil true)))\n                (if (= op \"any?\")\n                  (let [vs (map (fn [q] (pred/eval q env)) (nth p 1))] (if (some (fn [v] (= v true)) vs) true (if (some (fn [v] (nil? v)) vs) nil false)))\n                  nil)))))))))\n(define\n  pred/fields\n  [p]\n  (distinct (flat-map (fn [s] (if (= (count (get s :path)) 1) [(name-of (get s :sym))] [])) (filter (fn [s] (= (get s :path) [1])) (concat (symbols-in p []) (flat-map (fn [q] (symbols-in q [])) (if (list? p) (filter (fn [q] (list? q)) p) [])))))))\n(define union-values [ty] (enum-values ty))\n(define\n  assignments\n  [names types]\n  (reduce\n    (fn\n      [envs n]\n      (let\n        [values (union-values (meta/get types (keyword n)))]\n        (if (nil? values) envs (flat-map (fn [env] (map (fn [v] (assoc env (keyword n) v)) values)) envs))))\n    [{}]\n    names))\n(define\n  show-text\n  [guards]\n  (if (empty? guards) \"always\" (reduce (fn [acc g] (str acc (if (= acc \"\") \"\" \" and \") (render g))) \"\" guards)))\n(define\n  layout/coverage-one\n  [{:keys [name child]} owner]\n  (let\n    [evidence (layout/evidence name)]\n    (if (nil? evidence)\n      []\n      (let\n        [types (reduce (fn [acc [k ty]] (assoc acc (keyword (name-of k)) ty)) {} (pairs (declaration-fields evidence)))\n         fields (concat (layout/fields child)\n           (map (fn [[k v]] {:name (sym (name-of k)) :guards [] :at [:name]})\n             (if (map? (declaration-hole owner :fixes)) (pairs (declaration-hole owner :fixes)) [])))\n         rules (filter (fn [c] (= (head-name c) \"rule\")) (declaration-hole evidence :child))]\n        (flat-map\n          (fn\n            [rule]\n            (let\n              [rule-name (nth rule 1)\n               when (let [i (index-of :when rule)] (if (nil? i) true (nth rule (+ i 1))))\n               requires (nth rule (+ (index-of :requires rule) 1))\n               one-of? (and (list? requires) (= (head-name requires) \"one-of\"))\n               required (rule/required-fields requires)\n               mentioned (distinct (concat (pred/fields when) (flat-map (fn [f] (flat-map (fn [g] (pred/fields g)) (get f :guards))) fields)))\n               fixed (reduce (fn [acc [k v]] (assoc acc (keyword (name-of k)) v)) {} (if (map? (declaration-hole owner :fixes)) (pairs (declaration-hole owner :fixes)) []))\n               envs (map (fn [env] (merge env fixed)) (assignments mentioned types))]\n              (flat-map\n                (fn\n                  [field]\n                  (let\n                    [shown (first (filter (fn [f] (same? (get f :name) field)) fields))]\n                    (if (nil? shown)\n                      [(diag \"E_SHOW_COVERAGE\" (str (name-of field) \" is required by rule \" (name-of rule-name) \" but the layout never shows it.\") [:name])]\n                      (let\n                        [shows (fn [env] (pred/eval (if (empty? (get shown :guards)) true [(sym \"all?\") (get shown :guards)]) env))\n                         gaps (filter (fn [env] (and (= (pred/eval when env) true) (= (shows env) false))) envs)\n                         undecided (filter (fn [env] (or (nil? (pred/eval when env)) (and (= (pred/eval when env) true) (nil? (shows env))))) envs)]\n                        (if (or (empty? gaps) one-of?)\n                          (if (or (empty? undecided) one-of?)\n                            []\n                            [(warn \"W_SHOW_COVERAGE_UNPROVEN\" (str \"Cannot prove \" (name-of field) \" is shown whenever rule \" (name-of rule-name) \" requires it: its predicates read fields that are not keyword enums.\") (get shown :at))])\n                          [(diag \"E_SHOW_COVERAGE\" (str (name-of field) \" is required when \" (render when) \" (rule \" (name-of rule-name) \"), but the layout shows it only when \" (show-text (get shown :guards)) \". Uncovered: \" (reduce (fn [acc env] (str acc (if (= acc \"\") \"\" \", \") (reduce (fn [a [k v]] (str a (if (= a \"\") \"\" \" \") (name-of k) \" = \" (render v))) \"\" (meta/entries env)))) \"\" gaps) \".\") (get shown :at))])))))\n                (if one-of? (if (some (fn [f] (some (fn [field] (same? field (get f :name))) required)) fields) [] required) required))))\n          rules)))))\n(define layout/coverage [holes]\n  (flat-map (fn [owner] (layout/coverage-one holes owner))\n    (interactions-for-layout (get holes :name))))\n(type LayoutIR {:kind \"Layout\" :name Symbol :doc (Option String) :steps (List StepIR)})\n(form\n  (layout name doc child ...)\n  \"Presentation for an interaction. It may only show and hide; evidence rules decide what is required.\"\n  :types {:name (Declares LayoutDef) :doc (Option String) :child (List layout-child)}\n  :scope {:child (fn [holes] (layout/scope holes))}\n  :check layout/coverage\n  :ir LayoutIR\n  {:kind \"Layout\" :name name :doc doc :steps child})\n\n; Interactions produce evidence and may propose writes through role fields. A role\n; field the account binds to a path (or derives) is read-only.\n(define\n  role-field-binding\n  [role field]\n  (flat-map\n    (fn\n      [entity]\n      (flat-map\n        (fn [[r bindings]] (if (same? r role) (filter (fn [[f target]] (same? f field)) (pairs bindings)) []))\n        (pairs (declaration-hole entity :implements))))\n    (declarations-of (quote entity))))\n(define\n  interaction/check\n  [{:keys [actor produces proposes]}]\n  (let\n    [component (declaration-hole produces :of)\n     inputs (pairs (declaration-hole component :inputs))\n     fields (map (fn [[k ty]] (name-of k)) (pairs (declaration-fields produces)))]\n    (flat-map\n      (fn\n        [[target source]]\n        (let\n          [root (root-of target)\n           input (first (filter (fn [[k ty]] (same? k root)) inputs))\n           role (if (nil? input) nil (ref-target (nth input 1)))\n           field (nth (split (name-of target) \".\") 1)]\n          (concat\n            (if (member? source fields) [] [(diag \"E_UNKNOWN_FIELD\" (str (name-of source) \" is not a field of \" (name-of produces) \".\") [:proposes target])])\n            (if (nil? role)\n              [(diag \"E_PROPOSES_TARGET\" (str (name-of target) \" does not name a field of an input of \" (name-of component) \".\") [:proposes target])]\n              (flat-map\n                (fn\n                  [[f bound]]\n                  (if (dotted? bound)\n                    [(diag \"E_READONLY_ROLE_WRITE\" (str (name-of target) \" writes \" (name-of role) \".\" field \", which an entity binds to the path \" (name-of bound) \". A path is read-only.\") [:proposes target])]\n                    []))\n                (role-field-binding role field))))))\n      (pairs proposes))))\n(define\n  interaction/binds-check\n  [{:keys [produces binds prefill proposes]}]\n  (let [component (declaration-hole produces :of)\n        inputs (pairs (declaration-hole component :inputs))\n        fields (declaration-fields produces)]\n    (if (or (nil? binds) (map? binds))\n      (flat-map\n        (fn [[field target]]\n          (let [parts (split (name-of target) \".\")\n                input (first (filter (fn [[k ty]] (same? k (first parts))) inputs))\n                role (if (nil? input) nil (ref-target (nth input 1)))\n                role-type (if (nil? role) nil (meta/get (declaration-fields role) (nth parts 1)))\n                field-type (meta/get fields (name-of field))\n                path [:binds field]]\n            (concat\n              (if (nil? field-type) [(diag \"E_UNKNOWN_FIELD\" \"The binding names an unknown evidence field.\" path)] [])\n              (if (or (not (symbol? target)) (not (= (count parts) 2)) (nil? role-type))\n                [(diag \"E_BINDS_TARGET\" \"A binding must name an input's role field.\" path)]\n                (if (or (nil? field-type)\n                        (types-match? field-type role-type)\n                        (and (= (name-of (widen (strip-option role-type))) \"Keyword\")\n                             (= (name-of (widen (strip-option field-type))) \"Keyword\")))\n                  [] [(diag \"E_BINDS_TYPE\" \"The evidence and role field types are incompatible.\" path)]))\n              (if (or (some (fn [[k v]] (same? k field)) (pairs prefill))\n                      (some (fn [[k v]] (same? v field)) (pairs proposes)))\n                [(diag \"E_BINDS_CONFLICT\" \"A bound field cannot also use :prefill or :proposes.\" path)] []))))\n        (pairs binds))\n      [(diag \"E_BINDS_SHAPE\" \"Bindings must be a field-to-role-fact map.\" [:binds])])))\n(type\n  InteractionIR\n  {\n    :kind \"Interaction\"\n    :name Symbol\n    :doc (Option String)\n    :actor Symbol\n    :produces Symbol\n    :binds Syntax\n    :fixes Syntax\n    :prefill Syntax\n    :proposes Syntax\n    :layout (Option Symbol)})\n(form\n  (interaction name doc {:keys [actor produces binds fixes prefill proposes layout]})\n  \"A typed exchange with a person that produces evidence.\"\n  :types\n    {\n      :name (Declares InteractionDef)\n      :doc (Option String)\n      :actor Symbol\n      :produces (Refers EvidenceDef)\n      :binds (Option Syntax)\n      :fixes (Option Syntax)\n      :prefill (Option Syntax)\n      :proposes (Option Syntax)\n      :layout (Option (Refers LayoutDef))}\n  :check (fn [holes] (concat (interaction/check holes) (interaction/binds-check holes)))\n  :ir InteractionIR\n  {\n    :kind \"Interaction\"\n    :name name\n    :doc doc\n    :actor actor\n    :produces produces\n    :binds (if (nil? binds) {} binds)\n    :fixes (if (nil? fixes) {} fixes)\n    :prefill (if (nil? prefill) {} prefill)\n    :proposes (if (nil? proposes) {} proposes)\n    :layout layout})\n\n; Collections describe source facts. Eligible work supplies concrete subjects at runtime.\n(type CollectIR\n  {:kind \"Collect\" :name Symbol :doc (Option String) :from Symbol\n   :facts Syntax :layout Symbol :confirm-after (Option Syntax)})\n(define collect/check [{:keys [from facts]}]\n  (let [role? (declared? (quote role) from)\n        names (if role? (map (fn [[field ty]] (name-of field)) (pairs (declaration-fields from))) [])]\n    (concat\n      (if role? [] [(diag \"E_COLLECT_FROM\" \"A collection's source must be a declared role.\" [:from])])\n      (if (and (list? facts) (not (empty? facts))\n               (= (count (distinct (map name-of facts))) (count facts))\n               (not (some (fn [f] (or (not (keyword? f)) (and role? (not (member? f names))))) facts)))\n        (if role?\n          (flat-map (fn [field]\n            (if (some (fn [[f bound]] (dotted? bound)) (role-field-binding from field))\n              [(diag \"E_COLLECT_READONLY\" \"Collect the referenced record's own fact instead of writing through a path.\" [:facts (index-of field facts)])]\n              [])) facts)\n          [])\n        [(diag \"E_COLLECT_FACTS\" \"Facts must be unique declared role fields in a nonempty keyword vector.\" [:facts])]))))\n(form\n  (collect name doc {:keys [from facts layout confirm-after]})\n  \"A reusable source-fact collection contract, instantiated only from eligible work.\"\n  :types {:name (Declares CollectDef) :doc (Option String) :from Symbol\n          :facts Syntax :layout Symbol :confirm-after (Option Syntax)}\n  :check collect/check\n  :ir CollectIR\n  {:kind \"Collect\" :name name :doc doc :from from :facts facts :layout layout :confirm-after confirm-after})\n\n; Bundles describe presentation only; work identity and signatures remain independent.\n(type BundleIR {:kind \"Bundle\" :name Symbol :doc (Option String) :for Symbol :label (Option String)})\n(form\n  (bundle name doc {:keys [for label]})\n  \"A named work session for one role, without an execution or signing operation.\"\n  :types {:name (Declares BundleDef) :doc (Option String) :for Symbol :label (Option String)}\n  :check (fn [{:keys [for]}]\n    (if (declared? (quote role) for) []\n      [(diag \"E_BUNDLE_ROLE\" \"A bundle must name a declared role.\" [:for])]))\n  :ir BundleIR {:kind \"Bundle\" :name name :doc doc :for for :label label})\n\n; ── Connectors and machines ──\n\n(type\n  ConnectorIR\n  {\n    :kind \"Connector\"\n    :name Symbol\n    :doc (Option String)\n    :capabilities (List Symbol)\n    :signals (List Symbol)\n    :owns (List Symbol)})\n(form\n  (connector name doc {:keys [capabilities signals owns]})\n  \"An external system: outbound capabilities and inbound signals, kept apart.\"\n  :types\n    {\n      :name (Declares ConnectorDef)\n      :doc (Option String)\n      :capabilities (List Symbol)\n      :signals (List Symbol)\n      :owns (Option (List (Refers MachineDef)))}\n  :ir ConnectorIR\n  {:kind \"Connector\" :name name :doc doc :capabilities capabilities :signals signals :owns (if (nil? owns) [] owns)})\n\n(type StateIR {:kind \"State\" :name Symbol :label String})\n(type TransitionIR {:kind \"Transition\" :from Symbol :to Symbol})\n(type machine-child (Union StateIR TransitionIR))\n(form (machine-child/state name label) :types {:name Symbol :label String} :ir StateIR {:kind \"State\" :name name :label label})\n(form\n  (machine-child/transition from to)\n  :types {:from Symbol :to Symbol}\n  :ir TransitionIR\n  {:kind \"Transition\" :from from :to to})\n(define\n  machine/check\n  [{:keys [initial final child]}]\n  (let\n    [states (map (fn [s] (get s :name)) (child-named child \"State\"))]\n    (concat\n      (if (member? initial states) [] [(diag \"E_MACHINE_STATE\" (str (name-of initial) \" is not a declared state.\") [:initial])])\n      (flat-map (fn [s] (if (member? s states) [] [(diag \"E_MACHINE_STATE\" (str (name-of s) \" is not a declared state.\") [:final])])) final)\n      (flat-map\n        (fn\n          [transition]\n          (flat-map\n            (fn [state] (if (member? state states) [] [(diag \"E_MACHINE_STATE\" (str (name-of state) \" is not a declared state.\") [:child])]))\n            [(get transition :from) (get transition :to)]))\n        (child-named child \"Transition\")))))\n(type\n  MachineIR\n  {\n    :kind \"Machine\"\n    :name Symbol\n    :doc (Option String)\n    :signal Symbol\n    :initial Symbol\n    :final (List Symbol)\n    :states (List StateIR)\n    :transitions (List TransitionIR)})\n(form\n  (machine name doc {:keys [signal initial final]} child ...)\n  \"A vendor protocol: set :signal to a name declared in a connector's :signals, and list this machine in that connector's :owns. Signal-only connectors use :capabilities [].\"\n  :types\n    {\n      :name (Declares MachineDef)\n      :doc (Option String)\n      :signal Symbol\n      :initial Symbol\n      :final (List Symbol)\n      :child (List machine-child)}\n  :check machine/check\n  :ir MachineIR\n  {\n    :kind \"Machine\"\n    :name name\n    :doc doc\n    :signal signal\n    :initial initial\n    :final final\n    :states (child-named child \"State\")\n    :transitions (child-named child \"Transition\")})\n\n; ── Entities: an account's own nouns, bound to library roles ──\n\n(define field-type [owner attr] (meta/get (declaration-fields owner) (name-of attr)))\n(define\n  path-type\n  [owner path]\n  (let\n    [parts (split (name-of path) \".\") ty (field-type owner (first parts))]\n    (if (or (nil? ty) (= (count parts) 1))\n      ty\n      (let [target (ref-target ty)] (if (nil? target) nil (path-type target (reduce (fn [acc p] (str acc (if (= acc \"\") \"\" \".\") p)) \"\" (rest parts))))))))\n(define\n  near-miss\n  [entity role-type used]\n  (first\n    (filter\n      (fn [[k ty]] (and (not (member? k used)) (= (render (resolve-alias (strip-option ty))) (render (resolve-alias (strip-option role-type))))))\n      (pairs (declaration-fields entity)))))\n(define\n  implements?\n  [entity role]\n  (some (fn [[r b]] (same? r role)) (pairs (declaration-hole entity :implements))))\n(define\n  types-match?\n  [role-type own-type]\n  (let\n    [r (strip-option role-type) o (strip-option own-type) rt (ref-target r) ot (ref-target o)]\n    (if (and (not (nil? rt)) (not (nil? ot)))\n      (or (same? rt ot) (implements? ot rt))\n      (= (render (resolve-alias r)) (render (resolve-alias o))))))\n(define\n  entity/check\n  [{:keys [name implements]}]\n  (flat-map\n    (fn\n      [[role bindings]]\n      (let\n        [role-fields (pairs (declaration-fields role)) bound (pairs bindings)]\n        (concat\n          (flat-map\n            (fn\n              [[field role-type]]\n              (if (some (fn [[f target]] (same? f field)) bound)\n                []\n                (let\n                  [guess (near-miss name role-type (map (fn [[f target]] (root-of target)) bound))]\n                  [(diag \"E_UNBOUND_ROLE_FIELD\" (str name \" does not bind \" (name-of role) \".\" (name-of field) (if (nil? guess) \".\" (str \" (did you mean \" (name-of (first guess)) \"?).\"))) [:implements role])])))\n            role-fields)\n          (flat-map\n            (fn\n              [[field target]]\n              (let\n                [role-type (meta/get (declaration-fields role) (name-of field)) own-type (path-type name target)]\n                (if (nil? role-type)\n                  [(diag \"E_UNKNOWN_FIELD\" (str (name-of role) \" has no field \" (name-of field) \".\") [:implements role field])]\n                  (if (nil? own-type)\n                    [(diag \"E_UNKNOWN_FIELD\" (str name \" has no field \" (name-of target) \".\") [:implements role field])]\n                    (if (types-match? role-type own-type)\n                      []\n                      [(diag \"E_ROLE_TYPE_MISMATCH\" (str (name-of role) \".\" (name-of field) \" is \" (render role-type) \" but \" (name-of target) \" is \" (render own-type) \".\") [:implements role field])])))))\n            bound))))\n    (pairs implements)))\n(type BindIR {:role Symbol :field String :path String})\n(type\n  EntityIR\n  {\n    :kind \"Entity\"\n    :name Symbol\n    :doc (Option String)\n    :ns String\n    :ns-declared Bool\n    :display (Option Symbol)\n    :fields (List FieldIR)\n    :files (Option Syntax) :sealed-by (Option Syntax)\n    :implements (List BindIR)})\n(form\n  (entity name doc {:keys [ns display implements files sealed-by]} fields)\n  \"An account's own record type. :ns pins its stored attribute identity.\"\n  :types\n    {\n      :name (Declares EntityDef)\n      :doc (Option String)\n      :ns (Option Keyword)\n      :display (Option Symbol)\n      :implements (Option Syntax)\n      :files (Option Syntax) :sealed-by (Option Syntax)\n      :fields (Record Type)}\n  :check\n    (fn\n      [holes]\n      (concat\n        (entity/check holes)\n        (if (nil? (get holes :ns))\n          [(warn \"W_NS_DEFAULTED\" (str \"Attributes of \" (get holes :name) \" default to :\" (lower (str (get holes :name))) \"/…; pin them with :ns so a rename is not a migration.\") [:name])]\n          [])))\n  :ir EntityIR\n  {\n    :kind \"Entity\"\n    :name name\n    :doc doc\n    :ns (if (nil? ns) (lower (str name)) (keyword/name ns))\n    :ns-declared (not (nil? ns))\n    :display display\n    :fields (fields->ir fields)\n    :files files\n    :sealed-by sealed-by\n    :implements\n      (flat-map\n        (fn [[role bindings]] (map (fn [[field target]] {:role role :field (name-of field) :path (name-of target)}) (pairs bindings)))\n        (pairs implements))})\n\n; ── Accounts: pinned packages, parameters, and the subjects they reconcile ──\n\n(type ForEachIR {:kind \"ForEach\" :role Symbol :component Symbol})\n(type PolicyIR {:kind \"AccountPolicy\" :name Symbol :doc String :of Symbol\n  :cites Syntax :when (Option RuntimeExpr) :require (Option RuntimeExpr)\n  :params (Option Syntax) :assign (Option Syntax) :effective (Option Syntax)})\n(type account-child (Union ForEachIR PolicyIR))\n(define policy/scope [holes]\n  (let [owner (get holes :of)]\n    (component/scope {:name owner :inputs (declaration-hole owner :inputs)\n                      :params (declaration-hole owner :params) :child (child-forms owner)})))\n(form\n  (account-child/policy name doc {:keys [of cites when require params assign effective]})\n  \"An account constraint over one named library component; never grants authority.\"\n  :types {:name Symbol :doc String :of (Refers ComponentDef) :cites Syntax\n          :when (Option (Expr Truth)) :require (Option (Expr Truth))\n          :params (Option Syntax) :assign (Option Syntax) :effective (Option Syntax)}\n  :scope {:when policy/scope :require policy/scope}\n  :ir PolicyIR\n  {:kind \"AccountPolicy\" :name name :doc doc :of of :cites cites :when when :require require\n   :params params :assign assign :effective effective})\n(form\n  (account-child/for-each role component)\n  :types {:role (Refers RoleDef) :component (Refers ComponentDef)}\n  :ir ForEachIR\n  {:kind \"ForEach\" :role role :component component})\n(define\n  account/check\n  [{:keys [requires]}]\n  (let\n    [libraries (declarations-of (quote library))]\n    (flat-map\n      (fn\n        [[pinned version]]\n        (let\n          [library (first (filter (fn [l] (same? l pinned)) libraries))]\n          (if (nil? library)\n            [(diag \"E_UNRESOLVED_REQUIRE\" (str \"No library \" (name-of pinned) \" is published with this account.\") [:requires pinned])]\n            (if (same? version (declaration-hole library :version))\n              []\n              [(diag \"E_UNRESOLVED_REQUIRE\" (str (name-of pinned) \" is published at \" (declaration-hole library :version) \", not \" version \".\") [:requires pinned])]))))\n      (pairs requires))))\n(type PinIR {:library String :version String})\n(type\n  AccountIR\n  {\n    :kind \"Account\"\n    :name Symbol\n    :doc (Option String)\n    :requires (List PinIR)\n    :package Symbol\n    :version (Option String)\n    :params Syntax\n    :upgrade Keyword\n    :for-each (List ForEachIR)\n    :policies (List PolicyIR)})\n(form\n  (account name doc {:keys [requires package version params upgrade]} child ...)\n  \"A customer account: pinned library releases, its package, parameters and subjects.\"\n  :types\n    {\n      :name (Declares AccountDef)\n      :doc (Option String)\n      :requires Syntax\n      :package Symbol\n      :version (Option String)\n      :params (Option Syntax)\n      :upgrade (Option (Union :open-only :review :next-cycle))\n      :child (List account-child)}\n  :check account/check\n  :ir AccountIR\n  {\n    :kind \"Account\"\n    :name name\n    :doc doc\n    :requires (map (fn [[library version]] {:library (name-of library) :version version}) (pairs requires))\n    :package package\n    :version version\n    :params (if (nil? params) {} params)\n    :upgrade (if (nil? upgrade) :open-only upgrade)\n    :for-each (child-named child \"ForEach\")\n    :policies (child-named child \"AccountPolicy\")})\n\n; ── Executable examples: authored records and assertions remain data. ──\n(type ScenarioIR {:kind \"Scenario\" :name Symbol :doc (Option String) :world Symbol :body (List Syntax)})\n(form\n  (scenario name doc {:keys [world]} body ...)\n  \"A located executable example for one account.\"\n  :types {:name (Declares ScenarioDef) :doc (Option String) :world Symbol :body (List Syntax)}\n  :ir ScenarioIR\n  {:kind \"Scenario\" :name name :doc doc :world world :body body})\n\n(type PropertyIR {:kind \"Property\" :name Symbol :doc (Option String) :world Symbol :at String :for-all Syntax :body (List Syntax)})\n(form\n  (property name doc {:keys [world at for-all]} body ...)\n  \"A located claim over finite generated entities and a supplied date.\"\n  :types {:name (Declares PropertyDef) :doc (Option String) :world Symbol :at String :for-all Syntax :body (List Syntax)}\n  :ir PropertyIR\n  {:kind \"Property\" :name name :doc doc :world world :at at :for-all for-all :body body})\n\n; Decisions are owned operations; their expressions see one component's finite scope.\n(define decision/scope [holes]\n  (let [owner (get holes :of)]\n    (component/scope {:name owner :inputs (declaration-hole owner :inputs)\n                      :params (declaration-hole owner :params) :child (child-forms owner)})))\n(type DecisionIR\n  {:kind \"Decision\" :name Symbol :doc (Option String) :of Symbol :by Syntax\n   :applies Symbol :when (Option RuntimeExpr) :effect Keyword :reason (Option Type)\n   :until (Option RuntimeExpr) :expires (Option RuntimeExpr) :cites (Option Syntax)\n   :approvals (Option RuntimeExpr) :distinct-from (Option Syntax)})\n(form\n  (decision name doc {:keys [of by applies when effect reason until expires cites approvals distinct-from]})\n  \"A human decision owned by a component and applied to one requirement.\"\n  :types {:name (Declares DecisionDef) :doc (Option String) :of (Refers ComponentDef)\n          :by Syntax :applies Symbol :when (Option (Expr Truth)) :effect Keyword\n          :reason (Option Type) :until (Option (Expr (Union Date Instant))) :expires (Option (Expr Duration))\n          :cites (Option Syntax) :approvals (Option (Expr Int)) :distinct-from (Option Syntax)}\n  :scope {:when decision/scope :until decision/scope :expires decision/scope :approvals decision/scope}\n  :ir DecisionIR\n  {:kind \"Decision\" :name name :doc doc :of of :by by :applies applies :when when\n   :effect effect :reason reason :until until :expires expires :cites cites\n   :approvals approvals :distinct-from distinct-from})\n; Vaults declare retention-scoped keys; storage encryption is a host obligation.\n(define vault/scope [holes]\n  (let [key (get holes :key) owner (nth key 1)]\n    (if (= (head-name key) \"per-occurrence\")\n      (component/scope {:name owner :inputs (declaration-hole owner :inputs)\n        :params (declaration-hole owner :params) :child (child-forms owner)})\n      (merge world/vocabulary {:subject (role-view owner 1)}))))\n(type VaultIR {:kind \"Vault\" :name Symbol :doc (Option String) :key (Option Syntax)\n :holds (Option Syntax) :retain (Option RuntimeExpr) :cites (Option Syntax)\n :erasure (Option Syntax) :dispose (Option Syntax)})\n(form (vault name doc {:keys [key holds retain cites erasure dispose]})\n \"A cited retention-scoped data-key policy with human disposal authority.\"\n :types {:name (Declares VaultDef) :doc (Option String) :key (Option Syntax)\n  :holds (Option Syntax) :retain (Option (Expr Date)) :cites (Option Syntax)\n  :erasure (Option Syntax) :dispose (Option Syntax)}\n :scope {:retain vault/scope}\n :ir VaultIR {:kind \"Vault\" :name name :doc doc :key key :holds holds :retain retain\n  :cites cites :erasure erasure :dispose dispose})\n; Static read ceilings only. Powers and execution remain separate host obligations.\n(type AgentIR {:kind \"Agent\" :name Symbol :doc (Option String) :of Syntax :reads Syntax :may-read (Option Syntax)})\n(form (agent name doc {:keys [of reads may-read]})\n \"A component-scoped static read ceiling, never a grant of current authority or execution.\"\n :types {:name (Declares AgentDef) :doc (Option String) :of Syntax :reads Syntax :may-read (Option Syntax)}\n :ir AgentIR {:kind \"Agent\" :name name :doc doc :of of :reads reads :may-read may-read})\n";

package/dist/_internal/forma/world/properties.d.ts

@@ -0,0 +1,9 @@
+import type * as IR from "../../world-ir/types.generated.js";
+/** Closed finite predicates over authored schemas; never query live entities at publish. */
+export declare const compileProperties: (ir: IR.WorldIR, files: readonly {
+    readonly id: string;
+    readonly text: string;
+}[]) => {
+    properties: IR.Property[];
+    diagnostics: IR.Diagnostic[];
+};

package/dist/_internal/forma/world/properties.js

@@ -0,0 +1,387 @@
+import { sourceSyntax } from "./source-syntax.js";
+import { compileScenarios } from "./scenarios.js";
+import { advanceTargets, isInstant, normalizeInstant } from "../../ir-checks/index.js";
+import {} from "@forma-language/forma/reader";
+const symbol = (e) => (e?._tag === "Sym" ? e.name : undefined);
+const items = (e) => (e?._tag === "List" ? e.items : []);
+const validDate = (s) => /^\d{4}-\d{2}-\d{2}$/.test(s) &&
+    Number.isFinite(Date.parse(`${s}T00:00:00Z`)) &&
+    new Date(`${s}T00:00:00Z`).toISOString().slice(0, 10) === s;
+class Invalid extends Error {
+    code;
+    at;
+    help;
+    constructor(code, message, at, help) {
+        super(message);
+        this.code = code;
+        this.at = at;
+        this.help = help;
+    }
+}
+/** Closed finite predicates over authored schemas; never query live entities at publish. */
+export const compileProperties = (ir, files) => {
+    const properties = [], diagnostics = [];
+    const aliases = new Map(ir.types.map((t) => [t.name, t.type]));
+    const resolve = (t, seen = new Set()) => {
+        if (Array.isArray(t))
+            return t[0] === "Option" || t[0] === "Brand" ? resolve(t[1], seen) : t;
+        if (typeof t !== "string" || !aliases.has(t) || seen.has(t))
+            return t;
+        seen.add(t);
+        return resolve(aliases.get(t), seen);
+    };
+    for (const file of files)
+        for (const form of sourceSyntax(file).forms) {
+            if (symbol(items(form)[0]) !== "property")
+                continue;
+            const at = (e = form) => ({
+                src: file.id,
+                from: e.loc.start,
+                to: e.loc.end,
+                line: e.loc.line,
+                col: e.loc.col,
+            });
+            const fail = (code, message, e, help) => {
+                throw new Invalid(code, message, at(e), help);
+            };
+            const shape = (e) => fail("E_PROPERTY_SHAPE", "Unsupported or malformed finite property expression.", e, "Use one :for-all (alias Entity), an explicit :world/:at, fact paths, occurrence selectors and the documented logical operators.");
+            const ref = (e) => fail("E_PROPERTY_REF", "Unknown property world, binding, field or clause.", e, "Use an entity in this account package, its declared fields, and a component requirement/output or evidence type declared in this world.");
+            const mismatch = (e) => fail("E_PROPERTY_TYPE", "Property operand does not match the declared type.", e, "Use compatible field/key types; logical predicates require booleans and status predicates require a status selector.");
+            const date = (e) => e?._tag === "Str" && (validDate(e.value) || normalizeInstant(e.value))
+                ? validDate(e.value)
+                    ? e.value
+                    : normalizeInstant(e.value)
+                : fail("E_PROPERTY_DATE", "Expected a real local date or explicitly zoned property instant.", e, "Supply YYYY-MM-DD or an explicitly zoned RFC3339 instant; property evaluation never reads the system clock.");
+            try {
+                const xs = items(form), doc = xs[2], options = new Map();
+                let i = doc?._tag === "Str" ? 3 : 2;
+                while (symbol(xs[i])?.startsWith(":")) {
+                    const key = symbol(xs[i]).slice(1);
+                    if (!["world", "at", "for-all"].includes(key) || options.has(key) || !xs[i + 1])
+                        shape(xs[i]);
+                    options.set(key, xs[i + 1]);
+                    i += 2;
+                }
+                const given = symbol(items(xs[i])[0]) === "given" ? xs[i++] : undefined;
+                if (xs.length !== i + 1)
+                    shape(form);
+                const world = ir.accounts.find((a) => a.name === symbol(options.get("world")));
+                if (!world)
+                    ref(options.get("world"));
+                const when = date(options.get("at")), binding = items(options.get("for-all")), name = symbol(binding[0]);
+                if (binding.length !== 2 || !name || !/^[A-Za-z_][\w-]*$/.test(name))
+                    shape(options.get("for-all"));
+                const entity = ir.entities.find((e) => e.name === symbol(binding[1]) && e.ns.split(".")[0] === world.package.name);
+                if (!entity)
+                    ref(binding[1]);
+                let seed;
+                if (given) {
+                    if (items(given)
+                        .slice(1)
+                        .some((e) => !["entity", "evidence", "signal"].includes(symbol(items(e)[0]) ?? "")))
+                        shape(given);
+                    // Reuse scenario validation directly on the original located syntax.
+                    const sym = (name) => ({ _tag: "Sym", name, loc: form.loc });
+                    const scenario = {
+                        _tag: "List",
+                        loc: form.loc,
+                        items: [
+                            sym("scenario"),
+                            sym("seed"),
+                            sym(":world"),
+                            options.get("world"),
+                            given,
+                            { _tag: "List", loc: form.loc, items: [sym("at"), options.get("at")] },
+                        ],
+                    };
+                    const result = compileScenarios(ir, [file], [scenario]);
+                    if (result.diagnostics.length) {
+                        diagnostics.push(...result.diagnostics);
+                        continue;
+                    }
+                    seed = result.scenarios[0];
+                    if (!seed?.given.some((e) => e.name === name && e.entity === entity.name))
+                        fail("E_PROPERTY_REF", "A property given block must declare its quantified alias with the quantified entity type.", given, "Include (entity Entity alias {fields}) using the same alias and type as :for-all.");
+                }
+                const fits = (actual, expected, expression) => {
+                    const a = resolve(actual), b = resolve(expected);
+                    if (a === b || a === "Nil" || b === "Nil")
+                        return true;
+                    if (b === "TimePoint" && (a === "Date" || a === "Instant"))
+                        return true;
+                    if ((b === "Instant" || b === "TimePoint") &&
+                        a === "String" &&
+                        expression.k === "literal" &&
+                        typeof expression.value === "string")
+                        return (isInstant(expression.value) || (b === "TimePoint" && validDate(expression.value)));
+                    if (a === "Int" && b === "Float")
+                        return true;
+                    if (a === "Bool" && b === "Truth")
+                        return true;
+                    if (a === "Status" && b === "Keyword" && expression.k === "literal")
+                        return true;
+                    if (b === "Date" &&
+                        a === "String" &&
+                        expression.k === "literal" &&
+                        typeof expression.value === "string")
+                        return validDate(expression.value);
+                    if (Array.isArray(b) &&
+                        b[0] === "Union" &&
+                        (a === "Keyword" || a === "Status") &&
+                        expression.k === "literal")
+                        return b.slice(1).includes(`:${expression.value}`);
+                    if (Array.isArray(a) && a[0] === "Union" && b === "Keyword")
+                        return true;
+                    if (Array.isArray(a) && Array.isArray(b) && a[0] === "Id" && b[0] === "Id") {
+                        if (a[1] === b[1])
+                            return true;
+                        return (ir.entities.find((e) => e.name === a[1])?.implements.some((p) => p.role === b[1]) ??
+                            false);
+                    }
+                    return false;
+                };
+                const target = (e) => {
+                    const parts = items(e), component = ir.components.find((c) => c.name === symbol(parts[0]));
+                    if (e?._tag !== "List")
+                        return shape(e);
+                    if (!component)
+                        return ref(parts[0]);
+                    const end = component.key.length + 1;
+                    let cycle, attachedTo;
+                    if ((parts.length - end) % 2 !== 0 || parts.length < end)
+                        return shape(e);
+                    for (let i = end; i < parts.length; i += 2) {
+                        const key = symbol(parts[i]), value = parts[i + 1];
+                        if (key === ":cycle" && cycle === undefined) {
+                            if (value._tag !== "Num" ||
+                                !Number.isSafeInteger(Number(value.value)) ||
+                                Number(value.value) < 1)
+                                return mismatch(value);
+                            cycle = Number(value.value);
+                        }
+                        else if (key === ":attached-to" && attachedTo === undefined) {
+                            const term = infer(value), type = resolve(term.type), entity = Array.isArray(type) && type[0] === "Id"
+                                ? ir.entities.find((e) => e.name === type[1])
+                                : undefined;
+                            if (!entity ||
+                                !world.forEach.some((root) => entity.implements.some((binding) => binding.role === root.role)))
+                                return mismatch(value);
+                            attachedTo = term.expr;
+                        }
+                        else
+                            return shape(parts[i]);
+                    }
+                    return {
+                        component: component.name,
+                        key: component.key.map((key, index) => {
+                            const term = infer(parts[index + 1]);
+                            if (term.type === "Nil" ||
+                                !fits(term.type, component.inputs.find((f) => f.name === key).type, term.expr))
+                                return mismatch(parts[index + 1]);
+                            return term.expr;
+                        }),
+                        ...(cycle === undefined ? {} : { cycle }),
+                        ...(attachedTo === undefined ? {} : { attachedTo }),
+                        at: at(e),
+                    };
+                };
+                const infer = (e) => {
+                    const literal = (value, type) => ({
+                        expr: { k: "literal", value, at: at(e) },
+                        type,
+                    });
+                    if (e._tag === "Str")
+                        return literal(e.value, "String");
+                    if (e._tag === "Bool")
+                        return literal(e.value, "Bool");
+                    if (e._tag === "Num")
+                        return Number.isFinite(Number(e.value))
+                            ? literal(Number(e.value), Number.isSafeInteger(Number(e.value)) ? "Int" : "Float")
+                            : mismatch(e);
+                    const word = symbol(e);
+                    if (word === "nil")
+                        return literal(null, "Nil");
+                    if (word?.startsWith(":"))
+                        return literal(word.slice(1), ["Unknown", "NotApplicable", "Open", "Overdue", "Satisfied", "Waived"].includes(word.slice(1))
+                            ? "Status"
+                            : "Keyword");
+                    if (word) {
+                        const path = word.split(".");
+                        if (path.shift() !== name)
+                            return ref(e);
+                        let type = ["Id", entity.name];
+                        const attrs = [];
+                        for (const field of path) {
+                            const t = resolve(type), owner = Array.isArray(t) && t[0] === "Id"
+                                ? ir.entities.find((p) => p.name === t[1])
+                                : undefined;
+                            const declared = owner?.fields.find((f) => f.name === field);
+                            if (!owner || !declared)
+                                return ref(e);
+                            attrs.push(`${owner.ns}/${declared.name}`);
+                            type = declared.type;
+                        }
+                        return { expr: { k: "read", root: name, attrs, at: at(e) }, type: resolve(type) };
+                    }
+                    const parts = items(e), written = symbol(parts[0]), op = written;
+                    if (op === "work" || op === "due" || op === "occurrence-count") {
+                        if (parts.length !== 3 && !(op === "occurrence-count" && parts.length === 5))
+                            return shape(e);
+                        const occurrence = target(parts[1]), clause = symbol(parts[2]), component = ir.components.find((c) => c.name === occurrence.component);
+                        const action = op === "work" ? component.actions.find((a) => a.name === clause) : undefined;
+                        const requirement = component.requirements.find((r) => r.name === (op === "work" ? action && advanceTargets(action)[0] : clause));
+                        if (!requirement || (op === "work" && !action))
+                            return ref(parts[2]);
+                        const filter = parts.length === 5 ? parts[4] : undefined;
+                        if (filter && symbol(parts[3]) !== ":cycle")
+                            return shape(parts[3]);
+                        if (filter && !requirement.cycle)
+                            return ref(parts[2]);
+                        const cycle = filter ? infer(filter) : undefined;
+                        if (cycle &&
+                            !["String", "Keyword", "Date", "Int", "Float", "Bool"].includes(String(cycle.type)))
+                            return mismatch(filter);
+                        // An observation retains the located requirement selector used by reference traversal.
+                        const of = {
+                            k: "status",
+                            target: occurrence,
+                            name: requirement.name,
+                            at: at(e),
+                        };
+                        return {
+                            expr: op === "work"
+                                ? { k: "observation", of, query: op, action: action.name, at: at(e) }
+                                : op === "occurrence-count"
+                                    ? {
+                                        k: "observation",
+                                        of,
+                                        query: op,
+                                        ...(cycle ? { cycle: cycle.expr } : {}),
+                                        at: at(e),
+                                    }
+                                    : { k: "observation", of, query: op, at: at(e) },
+                            type: op === "work" ? "Keyword" : op === "due" ? "TimePoint" : "Int",
+                        };
+                    }
+                    if (op === "status" || op === "attested") {
+                        if (parts.length !== 3)
+                            return shape(e);
+                        const occurrence = target(parts[1]), clause = symbol(parts[2]), component = ir.components.find((c) => c.name === occurrence.component);
+                        if (op === "status") {
+                            if (![...component.requirements, ...component.outputs].some((r) => r.name === clause))
+                                return ref(parts[2]);
+                            return {
+                                expr: { k: "status", target: occurrence, name: clause, at: at(e) },
+                                type: "Status",
+                            };
+                        }
+                        if (!ir.evidence.some((r) => r.name === clause && r.of === component.name))
+                            return ref(parts[2]);
+                        return {
+                            expr: { k: "attested", target: occurrence, evidence: clause, at: at(e) },
+                            type: "Truth",
+                        };
+                    }
+                    if (ir.components.some((c) => c.name === op)) {
+                        const occurrence = target(e);
+                        return {
+                            expr: { k: "instance", target: occurrence, at: at(e) },
+                            type: ["Id", occurrence.component],
+                        };
+                    }
+                    if (op === "met?") {
+                        // Desugars to the existing operators so the property IR keeps its schema.
+                        if (parts.length !== 2)
+                            return shape(e);
+                        const arg = infer(parts[1]);
+                        if (arg.type !== "Status")
+                            return mismatch(parts[1]);
+                        const call = (op) => ({
+                            k: "call",
+                            op,
+                            args: [arg.expr],
+                            at: at(e),
+                        });
+                        return {
+                            expr: {
+                                k: "call",
+                                op: "or",
+                                args: [call("satisfied?"), call("not-applicable?")],
+                                at: at(e),
+                            },
+                            type: "Truth",
+                        };
+                    }
+                    const binary = ["implies", "=", "!=", "<", "<=", ">", ">="], unary = ["not", "known?", "unknown?", "satisfied?", "not-applicable?"];
+                    if (!op || ![...binary, ...unary, "and", "or"].includes(op))
+                        return fail("E_PROPERTY_SHAPE", `Unknown property operator ${op ?? "(none)"}.`, parts[0] ?? e, "Properties use implies, and, or, not, =, !=, <, <=, >, >=, known?, unknown?, satisfied?, not-applicable?, (status …), (attested …), (work …), (due …) and (occurrence-count …).");
+                    const args = parts.slice(1).map(infer);
+                    if ((binary.includes(op) && args.length !== 2) ||
+                        (unary.includes(op) && args.length !== 1) ||
+                        ((op === "and" || op === "or") && !args.length))
+                        return shape(e);
+                    if (["implies", "not", "and", "or"].includes(op)) {
+                        for (const [j, arg] of args.entries())
+                            if (arg.type !== "Bool" && arg.type !== "Truth")
+                                return mismatch(parts[j + 1]);
+                    }
+                    else if (op === "satisfied?" || op === "not-applicable?") {
+                        if (args[0].type !== "Status")
+                            return mismatch(parts[1]);
+                    }
+                    else if (binary.includes(op)) {
+                        const a = args[0], b = args[1];
+                        if (["Date", "Instant", "TimePoint"].includes(String(a.type)) &&
+                            b.expr.k === "literal" &&
+                            typeof b.expr.value === "string")
+                            date(parts[2]);
+                        if (["Date", "Instant", "TimePoint"].includes(String(b.type)) &&
+                            a.expr.k === "literal" &&
+                            typeof a.expr.value === "string")
+                            date(parts[1]);
+                        if (!fits(a.type, b.type, a.expr) && !fits(b.type, a.type, b.expr))
+                            return mismatch(parts[2]);
+                        if (["<", "<=", ">", ">="].includes(op) &&
+                            !["String", "Int", "Float", "Date", "Instant", "TimePoint"].includes(String(a.type)))
+                            return mismatch(parts[1]);
+                    }
+                    return {
+                        expr: {
+                            k: "call",
+                            op: op,
+                            args: args.map((a) => a.expr),
+                            at: at(e),
+                        },
+                        type: "Truth",
+                    };
+                };
+                const predicate = infer(xs[i]);
+                if (predicate.type !== "Bool" && predicate.type !== "Truth")
+                    mismatch(xs[i]);
+                properties.push({
+                    name: symbol(xs[1]),
+                    ...(doc?._tag === "Str" ? { doc: doc.value } : {}),
+                    world: world.name,
+                    date: when,
+                    binding: { name: name, entity: entity.name, at: at(options.get("for-all")) },
+                    ...(seed
+                        ? { given: seed.given, ...(seed.records ? { records: seed.records } : {}) }
+                        : {}),
+                    predicate: predicate.expr,
+                    at: at(),
+                });
+            }
+            catch (error) {
+                if (!(error instanceof Invalid))
+                    throw error;
+                diagnostics.push({
+                    code: error.code,
+                    severity: "error",
+                    message: error.message,
+                    at: error.at,
+                    help: error.help,
+                });
+            }
+        }
+    return { properties, diagnostics };
+};

package/dist/_internal/forma/world/scenarios.d.ts

@@ -0,0 +1,10 @@
+import { type SExpr } from "@forma-language/forma/reader";
+import type * as IR from "../../world-ir/types.generated.js";
+/** Finite authored data only; resolving aliases never discovers runtime entities. */
+export declare const compileScenarios: (ir: IR.WorldIR, files: readonly {
+    readonly id: string;
+    readonly text: string;
+}[], forms?: readonly SExpr[]) => {
+    scenarios: IR.Scenario[];
+    diagnostics: IR.Diagnostic[];
+};