diff --git a/crates/my-lisp-cli/tests/uk_surface_audit_projection.rs b/crates/my-lisp-cli/tests/uk_surface_audit_projection.rs new file mode 100644 index 00000000..873fb4bd --- /dev/null +++ b/crates/my-lisp-cli/tests/uk_surface_audit_projection.rs @@ -0,0 +1,29 @@ +use std::path::{Path, PathBuf}; +use std::process::Command; + +fn repo_root() -> PathBuf { + PathBuf::from(env!("CARGO_MANIFEST_DIR")).join("../..") +} + +fn my_lisp(cwd: &Path) -> Command { + let mut command = Command::new(env!("CARGO_BIN_EXE_my-lisp")); + command.current_dir(cwd); + command +} + +#[test] +fn uk_surface_audit_generator_runs_through_real_my_lisp_cli() { + let root = repo_root(); + let script = root.join("scripts/generate-uk-surface-audit.my"); + let output = my_lisp(&root) + .arg(&script) + .output() + .expect("UK surface audit generator should run through the real my-lisp CLI"); + + assert!( + output.status.success(), + "language-owned UK surface audit generator must run successfully\nstdout:\n{}\nstderr:\n{}", + String::from_utf8_lossy(&output.stdout), + String::from_utf8_lossy(&output.stderr) + ); +} diff --git a/crates/my-lisp/src/eval/special_forms/core.rs b/crates/my-lisp/src/eval/special_forms/core.rs index 8c7d40a3..94501c6f 100644 --- a/crates/my-lisp/src/eval/special_forms/core.rs +++ b/crates/my-lisp/src/eval/special_forms/core.rs @@ -161,5 +161,13 @@ pub(crate) fn eq_values(left: Value, right: Value, span: Span) -> Result Rc::ptr_eq(left, right), + _ => left == right, + }; + Ok(Value::truth(same_identity)) } diff --git a/crates/my-lisp/tests/canonical_source_extension.rs b/crates/my-lisp/tests/canonical_source_extension.rs new file mode 100644 index 00000000..6b210c19 --- /dev/null +++ b/crates/my-lisp/tests/canonical_source_extension.rs @@ -0,0 +1,23 @@ +use std::fs; +use std::path::PathBuf; + +fn repo_root() -> PathBuf { + PathBuf::from(env!("CARGO_MANIFEST_DIR")).join("../..") +} + +#[test] +fn ukrainian_staging_profile_does_not_claim_a_legacy_extension_as_canonical() { + let profile = fs::read_to_string( + repo_root().join("lib/surface/український-профіль-джерела.всм"), + ) + .expect("Ukrainian staging profile must be readable"); + + assert!( + profile.contains("(основне-розширення \".lisp\")"), + "#81 declares .lisp the canonical source extension; the Ukrainian staging profile must track that policy" + ); + assert!( + !profile.contains("(основне-розширення \".всм\")"), + "legacy .всм may remain a compatibility alias, but must not be labeled the primary/canonical extension" + ); +} diff --git a/crates/my-lisp/tests/first_class_builtins.rs b/crates/my-lisp/tests/first_class_builtins.rs index 5244a333..8e425171 100644 --- a/crates/my-lisp/tests/first_class_builtins.rs +++ b/crates/my-lisp/tests/first_class_builtins.rs @@ -87,3 +87,40 @@ fn lexical_shadowing_of_builtin_name() { "6" ); } + +#[test] +fn canon_peer_surfaces_observe_one_semantic_callable_identity() { + use my_lisp::semantic_registry_export::admitted_surfaces_for_semantic_id; + + let car_surfaces = admitted_surfaces_for_semantic_id("0005"); + assert!( + car_surfaces.len() >= 2, + "0005 must admit multiple surfaces for the identity witness" + ); + + for left in &car_surfaces { + for right in &car_surfaces { + let source = format!("(eq {} {})", left.name, right.name); + assert_eq!( + eval_source(&source), + "t", + "peer surfaces {}:{} and {}:{} share semantic ID 0005 and must be eq by semantic identity", + left.namespace, + left.name, + right.namespace, + right.name + ); + } + } + + let cdr_surface = admitted_surfaces_for_semantic_id("0006") + .into_iter() + .next() + .expect("0006 must admit at least one surface"); + let source = format!("(eq {} {})", car_surfaces[0].name, cdr_surface.name); + assert_eq!( + eval_source(&source), + "()", + "different semantic IDs 0005 and 0006 must remain observably distinct" + ); +} diff --git a/knowledge/guard-reference-inbox.mylog b/knowledge/guard-reference-inbox.mylog index 1115c101..7fcdb2b2 100644 --- a/knowledge/guard-reference-inbox.mylog +++ b/knowledge/guard-reference-inbox.mylog @@ -4,3 +4,8 @@ (reference-candidate (schema guard-reference-candidate/1) (status promoted) (recorded-at-unix 1788499446) (route ask-agent) (topic "stub-tasks-my-missing-paren-signature") (question "Як швидко й надійно виправити auto-generated tasks.my заглушки, що падають з unclosed-list?") (answer "Знайдено 8 разів того самого дня (2026-09-04) в 8 різних репо (OpenManus, yantra, radio-log, esp32-pendulum, vault-semantic-mcp, sanskritworld_texts, coreboot, wsm) -- усі мають ІДЕНТИЧНИЙ source-digest sha256:51fae8823e0... і однакову помилку: my-lisp --oracle-check повідомляє (code unclosed-list) (offset 579), бо auto-generated шаблон (той самий 'CREATED tasks.my for all repos that lacked one' пасс, wsl-nidana-bridge, той самий день) забув одну закриваючу дужку в кінці кожного файлу. Надійний, підтверджений 8 разів фікс: printf ')' >> tasks.my, потім my-lisp --oracle-check tasks.my для підтвердження outcome valid. Не універсальний фікс для БУДЬ-якого unclosed-list (див. automated-bulk-edit-paren-safety для ширшого класу) -- специфічно для цього одного шаблону з тим самим digest/offset.") (source "agent:pramana (Claude Sonnet 5) live investigation 2026-09-04, 8 independent confirmations") (evidence "ecosystem commit 862bce9 context; my-lisp commit 899d7b5; per-repo commits: chess-lisp-zero 614e3d4, wsm ea622f4, +6 more same day, all outcome error->valid")) (reference-candidate (schema guard-reference-candidate/1) (status promoted) (recorded-at-unix 1788585600) (route ask-agent) (topic "semantic-situation-and-ryad-contrast") (question "Як корінь РЯД- розмежовується з іншими юридичними термінами через семантичні ситуації, а не лише пошук графем?") (answer "Семантичний аудит ситуацій (Relation Track vs Lexeme Track) та сліпе кластерування виявили: РЯД- обирає структурні патерни попередньої специфікації для майбутньої поведінки (Pattern A: кабальний найм/позика, Pattern D: нормативний мир), але відсутній у разових передачах майна (Pattern B: купівля/дарування Софія № 23) та судовому стягненні (Pattern C: Звенигород № 2). Аудит контрприкладів показав чітких функціональних конкурентів: ОУСТАВ- (одностороннє веління), КРЕСТНОЕ ЦЕЛОВАНИЕ/РОТА (сакральне скріплення), операційні дієслова (разові дії).") (source "Darshana/Antigravity pair session 2026-09-05") (evidence "pravda commit 387d394; ecosystem commit e56dd09; docs/dictionary/RYAD-vs-DOGOVOR-vs-PAKT-CONTRAST.md Sections AA, BB")) (reference-candidate (schema guard-reference-candidate/1) (status promoted) (recorded-at-unix 1788865291) (route ask-agent) (topic "guix-swarm-node-onboarding") (question "Як правильно підняти нову swarm-node ноду через окремий Guix-профіль агента, і які реальні операційні пастки при цьому трапляються?") (answer "Живий onboarding wsl-pratyaksha-1 (2026-09-08) через окремий Guix-профіль виявив шість підтверджених операційних інваріантів. (1) `--connect` створює TCP/peer-звʼязок, але НЕ замінює протокольний `(join (capabilities ...) (roles ...))` -- до явного join нода може бути в `presence`, але не мати запису з ролями/capabilities в `members`. (2) `peer-welcome` доводить успішний handshake лише з ОДНИМ peer, не повну anti-entropy конвергенцію -- для цього потрібен окремий `(status)` з `(synced t)`. (3) На великому журналі свіжа нода тривалий час відповідає `(synced nil)`, застосовуючи пакети по 250 подій -- це спостережена startup backpressure, не зависання. (4) Systemd user-unit МУСИТЬ активувати Guix-профіль перед `exec`; сам факт, що target/release/swarm-node лежить поруч із Guix-профілем, НЕ доказ, що нода працює саме з Guix output. (5) Реальний виконуваний файл перевіряється через `/proc//exe`, який має вести в `/gnu/store/...` -- не лише текст ExecStart чи symlink профілю. (6) `sw`-клієнту треба передавати повну wire-форму `'(status)'`; голе `status` некоректне; сервер тримає зʼєднання відкритим після відповіді, клієнт має зупинити читання на збалансованій S-формі. Спостережена межа: деякі gossip-адреси можуть повертати Connection refused, поки локальні peers працюють і нода все одно досягає `(synced t)` -- це не можна подавати ані як повну справність усіх peers, ані як провал локальної ноди.") (source "evidence/investigation: agent:pratyaksha (Codex live-evidence worker) live onboarding 2026-09-08, owner-authorized; write-up/promotion into guard-reference: Claude Sonnet 5, same day -- pratyaksha's own comms-log messages (id a751487271a24c20, id cbb1f8dfc2444da8) claimed this candidate was already appended to this inbox file and oracle-check valid (153 forms), but live repo state at time of promotion showed no such content in this file or in guard-reference.wsm -- the original append was never pushed, likely lost on session disconnect; reconstructed here from the same underlying evidence, not re-investigated from scratch") (evidence "ecosystem/memory/pratyaksha.md; ecosystem/runs/2026-09-08-pratyaksha-node-onboard/README.md; comms-log.md entries a751487271a24c20 (2026-09-08T02:16, join evidence) and cbb1f8dfc2444da8 (2026-09-08T02:20, original unfulfilled review request)")) +(reference-candidate (schema guard-reference-candidate/1) (status pending-review) (recorded-at-unix 1789255512) (route ask-agent) (topic "guix-cross-compilation-target-flag-scope") (question "Чому команда guix build --target= pkg спрацьовує, а guix install/guix shell --target= pkg -- ні, і як тоді фактично отримати крос-компілятор?") (answer "Живо перевірено 2026-09-13 при спробі крос-компілювати my-lisp-cli під aarch64-linux-gnu (для деплою на Android TV box, X96 Max Plus2, порт ADB 5555 відкритий у локальній мережі). guix install --target=... і guix shell --target=... обидва повертають (error: unrecognized option) -- прапор --target існує ЛИШЕ для guix build (і споріднених низькорівневих команд), не для install/package/shell, всупереч інтуїтивному очікуванню, що ці підкоманди приймають однакові прапори. Робочий шлях: guix build --target=aarch64-linux-gnu gcc-toolchain реально завантажує/будує крос-toolchain (bzip2, coreutils, gcc-14/16 substitutes підтверджено з bordeaux.guix.gnu.org) і друкує кінцевий /gnu/store/... шлях; потрібно використати той шлях напряму (напр. через CARGO_TARGET__LINKER=/bin/aarch64-linux-gnu-gcc), а не покладатися, що guix install/shell зробить крос-tools доступними на PATH. Окремо підтверджено: guix НЕ підтримує aarch64-linux-musl як cross-compilation target (лише aarch64-linux-gnu, glibc) -- guix build --list-targets це підтверджує; для деплою на Android (Bionic libc, не glibc) це означає потребу в повністю статичному glibc-білді (уникає Bionic dynamic linker mismatch, бо статичний бінарник не викликає системний linker), а не musl-static, як типово роблять для Linux-контейнерів.") (source "agent:my-lisp-09 (Claude Sonnet 5) live investigation 2026-09-13, owner-directed (TV-tuner/Android-oracle experiment)") (evidence "командний вивід guix build/install/shell --target=... на цій WSL-машині (Ubuntu, guix 0cc8f41), сесія my-lisp-09; ecosystem/memory/my-lisp-architect.md 2026-09-13 addendum з повним контекстом")) +(reference-candidate (schema guard-reference-candidate/1) (status pending-review) (recorded-at-unix 1789257374) (route ask-agent) (topic "guix-aarch64-cross-bootstrap-config-sub-dead-end") (question "Чи можна на цьому Guix-хості (WSL, x86_64) отримати aarch64-linux-gnu крос-toolchain для деплою на ARM-пристрій, і чи вирішує це guix pull?") (answer "Ні, підтверджено двічі (до і після guix pull, 2026-09-13): guix build --target=aarch64-linux-gnu gcc-toolchain падає на РАННІЙ стадії bootstrap з (Invalid configuration aarch64-linux-gnu: machine aarch64 not recognized) під час configure gawk-mesboot-3.1.8 (частина 'full source bootstrap' ланцюга Guix, навмисно старий/заморожений пакет для reproducibility). guix pull оновив сам Guix (0cc8f41 -> a39872ef5) успішно, але це НЕ виправило проблему -- config.sub, вбудований у gawk-mesboot's власний джерельний tarball, лишається старим незалежно від версії Guix, бо цей конкретний мезбут-пакет свідомо заморожений заради відтворюваності бутстрапу, а не оновлюється разом з рештою дистрибуції. Практичний висновок: на цьому хості (і ймовірно на будь-якому стандартному Guix без спеціального патчу mesboot chain) aarch64-linux-gnu через from-scratch bootstrap не збирається; або (a) знайти вже готовий /gnu/store substitute для aarch64 gcc-toolchain з іншого джерела/каналу, (b) обійти mesboot повністю через сторонній prebuilt крос-toolchain (напр. Android NDK для aarch64-linux-android, не gnu), або (c) патчити/оновити config.sub у самому mesboot-пакеті (ризиковано, ламає bootstrap-reproducibility гарантії, не пробувано).") (source "agent:my-lisp-09 (Claude Sonnet 5) live investigation 2026-09-13, owner-directed") (evidence "guix build --target=aarch64-linux-gnu gcc-toolchain, двічі відтворено (guix 0cc8f41 і a39872ef5), обидва рази ідентична помилка на gawk-mesboot-3.1.8; ecosystem/memory/my-lisp-architect.md 2026-09-13 addendum")) +(reference-candidate (schema guard-reference-candidate/1) (status pending-review) (recorded-at-unix 1789258732) (route ask-agent) (topic "android-tv-box-oracle-deployment") (question "Як розгорнути my-lisp --tcp oracle на завжди-увімкненому Android TV box (не x86_64 droplet), і на що звертати увагу?") (answer "Живо задеплоєно і підтверджено 2026-09-13 на X96 Max Plus2 (Amlogic S905X3, Android 9/SDK 28, ARM64 SoC але 32-bit-only userspace -- getprop ro.product.cpu.abilist показує лише armeabi-v7a/armeabi, немає /system/bin/linker64 взагалі). Ключова пастка: перша спроба з aarch64-linux-android провалилась з (not executable: 64-bit ELF file) -- це НЕ noexec mount (/data не мав noexec, SELinux Permissive), а справжня причина архітектурна: система суто 32-бітна, попри 64-бітний SoC (типово для дешевих китайських TV-box). Фікс: rustup target add armv7-linux-androideabi, лінкер armv7a-linux-androideabi28-clang з Android NDK r30, збірка одразу спрацювала (ELF 32-bit LSB pie executable, ARM, interpreter /system/bin/linker). Деплой через adb push у /data/local/tmp (root-adb, стандартно на цьому пристрої, su доступний). --tcp сервер у коді (crates/my-lisp-cli/src/tcp_repl.rs) жорстко прив'язаний до Ipv4Addr::LOCALHOST, без --bind прапора -- свідоме рішення проєкту, не баг; доступ ззовні лише через adb forward tcp::9999 з машини з живим adb-з'єднанням, не пряме мережеве підключення інших peer. Стійкість до крашів (не до перезавантаження пристрою): простий shell while-true watchdog-цикл у /data/local/tmp/oracle-watchdog.sh, живо підтверджено -- kill -9 процесу призвів до реального автоматичного рестарту за 2с з новим PID, oracle.log зафіксував подію, TCP-запит через adb forward після рестарту пройшов успішно (новий server-generation). Reboot-persistence НЕ вирішено: пристрій має Termux встановлений, але без Termux:Boot addon (був би найпростіший шлях), встановлення додаткового APK на робочому пристрої власника свідомо не зроблено без окремого дозволу.") (source "agent:my-lisp-09 (Claude Sonnet 5) live deployment 2026-09-13, owner-directed (TV-tuner oracle experiment continuation)") (evidence "живий TCP round-trip через adb forward tcp:19999:9999 до X96Max_Plus2_T (192.168.110.55:5555), (op oracle-check) повернув коректний oracle-result двічі (до і після kill -9 + watchdog-рестарту, різні server-generation); ecosystem/memory/my-lisp-architect.md 2026-09-13 addendum")) +(reference-candidate (schema guard-reference-candidate/1) (status pending-review) (recorded-at-unix 1789259710) (route ask-agent) (topic "termux-boot-adb-installed-app-stopped-state-gotcha") (question "Чому Termux:Boot не запускає скрипт при завантаженні пристрою, навіть якщо APK встановлено і boot-скрипт правильно лежить у ~/.termux/boot/, і як це виправити?") (answer "Живо підтверджено 2026-09-13, двома реальними перезавантаженнями пристрою (не симуляцією через adb su): додаток, встановлений через adb install і НІ РАЗУ не відкритий вручну користувачем, лишається в Android-специфічному 'stopped state' -- ОС свідомо НЕ доставляє йому жодні broadcast, включно з android.intent.action.BOOT_COMPLETED, навіть якщо AndroidManifest.xml і Receiver Resolver Table (підтверджено через dumpsys package) коректно реєструють приймач. Перше перезавантаження після встановлення termux-boot APK і написання ~/.termux/boot/start-oracle.sh дало ПОВНУ тишу -- logcat показав лише dexopt/компіляцію самого com.termux.boot APK при першому запуску системи, жодного виконання BootReceiver. Причина знайдена через порівняння: жоден із двох додатків (com.termux, com.termux.boot) ніколи не запускався через UI/adb, обидва в stopped state. Фікс: adb shell am start -n com.termux.boot/.BootActivity і adb shell am start -n com.termux/.app.TermuxActivity (одноразово, будь-яка launchable activity кожного пакета) -- це виводить застосунок зі stopped state. Після цього повторне реальне перезавантаження (adb reboot) підтвердило: my-lisp-процес запустився САМ під правильним Termux-користувачем (u0_a84) без жодного ручного втручання, і повний TCP oracle-check round-trip пройшов успішно одразу після завантаження.") (source "agent:my-lisp-09 (Claude Sonnet 5) live investigation 2026-09-13, owner-authorized real device reboot (twice)") (evidence "dumpsys package com.termux.boot підтвердив коректний BOOT_COMPLETED receiver ДО фіксу; перше реальне adb reboot -- 0 my-lisp-процесів після завантаження; am start на обидва пакети; друге реальне adb reboot -- my-lisp-arm32 запущений автоматично під u0_a84, живий TCP oracle-check round-trip пройшов (server-generation 1789259669); ecosystem/memory/my-lisp-architect.md 2026-09-13 фінальний addendum")) +(reference-candidate (schema guard-reference-candidate/1) (status pending-review) (recorded-at-unix 1789260265) (route ask-agent) (topic "three-live-oracles-2026-09-13") (question "Скільки живих my-lisp TCP oracle зараз реально відповідають, і чи актуальна адресна книга в docs/swarm-remote-access.md?") (answer "Живо перевірено 2026-09-13 прямим TCP-запитом (не читанням документації чи припущенням): ТРИ oracle відповідають одночасно, кожен реальним (op oracle-check) round-trip з коректним oracle-result і живим server-generation timestamp: (1) локальний WSL-хост, 127.0.0.1:9999, pid 10446, /home/agents/GitHub/my-lisp/target/release/my-lisp --tcp=9999 --protocol=sexpr; (2) droplet, 100.113.68.50:9999 -- ВІДПОВІДАЄ, попри те що docs/swarm-remote-access.md (аудит 2026-08-13) досі стверджує 'DOWN (service not listening)' -- документ явно застарів, хтось підняв сервіс після того аудиту без оновлення адресної книги; (3) Android TV box (X96Max_Plus2_T, 192.168.110.55), досяжний через adb forward tcp::9999, деплой і reboot-persistence задокументовані в тому ж дні (topic android-tv-box-oracle-deployment, termux-boot-adb-installed-app-stopped-state-gotcha). Практичний висновок: docs/swarm-remote-access.md's address book не можна вважати достовірним джерелом поточного статусу без живої перевірки -- перевіряти TCP напряму (echo '(request (id N) (op oracle-check) (source \"...\"))' через /dev/tcp чи еквівалент), а не покладатися на дату останнього аудиту в документі.") (source "agent:my-lisp-09 (Claude Sonnet 5) live triple-check 2026-09-13, owner-directed") (evidence "три окремі живі (op oracle-check) round-trips того самого дня, кожен з унікальним server-generation; ecosystem/memory/my-lisp-architect.md 2026-09-13 фінальний addendum; docs/swarm-remote-access.md (не оновлено цим комітом, лише позначено як застаріле джерело для droplet-статусу)")) diff --git "a/lib/surface/\321\203\320\272\321\200\320\260\321\227\320\275\321\201\321\214\320\272\320\270\320\271-\320\277\321\200\320\276\321\204\321\226\320\273\321\214-\320\264\320\266\320\265\321\200\320\265\320\273\320\260.\320\262\321\201\320\274" "b/lib/surface/\321\203\320\272\321\200\320\260\321\227\320\275\321\201\321\214\320\272\320\270\320\271-\320\277\321\200\320\276\321\204\321\226\320\273\321\214-\320\264\320\266\320\265\321\200\320\265\320\273\320\260.\320\262\321\201\320\274" index 505e22cb..941a3fab 100644 --- "a/lib/surface/\321\203\320\272\321\200\320\260\321\227\320\275\321\201\321\214\320\272\320\270\320\271-\320\277\321\200\320\276\321\204\321\226\320\273\321\214-\320\264\320\266\320\265\321\200\320\265\320\273\320\260.\320\262\321\201\320\274" +++ "b/lib/surface/\321\203\320\272\321\200\320\260\321\227\320\275\321\201\321\214\320\272\320\270\320\271-\320\277\321\200\320\276\321\204\321\226\320\273\321\214-\320\264\320\266\320\265\321\200\320\265\320\273\320\260.\320\262\321\201\320\274" @@ -22,7 +22,7 @@ (політика (основна-людська-мова українська) - (основне-розширення ".всм") + (основне-розширення ".lisp") (повні-слова t) (програмістські-скорочення заборонені-за-замовчуванням) (кодування utf-8-nfc) diff --git a/scripts/generate-uk-surface-audit.my b/scripts/generate-uk-surface-audit.my new file mode 100644 index 00000000..70dc100e --- /dev/null +++ b/scripts/generate-uk-surface-audit.my @@ -0,0 +1,205 @@ +; scripts/generate-uk-surface-audit.my — generated Ukrainian surface inventory +; for my-lisp#85. This is an AUDIT PROJECTION, never semantic authority. +; +; Authority path: +; semantic-registry.wsm +; -> scripts/generate-function-table.my +; -> lib/generated/function-table.wsm +; -> this audit projection +; +; Candidate evidence path: +; lib/surface/український-профіль-джерела.всм +; Candidate spellings remain proposals. `lib/generated/function-table.wsm` +; is a checked projection, not a second semantic authority. This generator +; MUST NOT promote staging candidates into that current `full-uk` projection. +; +; Output: +; lib/generated/uk-surface-audit.wsm +; +; Usage from repo root: +; cargo run -p my-lisp-cli --bin my-lisp -- scripts/generate-uk-surface-audit.my + +(def str+ + (lambda args (reduce (lambda (acc s) (string-append acc s)) "" args))) + +(def pad4 + (lambda (n) + (let ((s (number->string n))) + (cond + ((eq (string-length s) 1) (string-append "000" s)) + ((eq (string-length s) 2) (string-append "00" s)) + ((eq (string-length s) 3) (string-append "0" s)) + (t s))))) + +(def second (lambda (xs) (car (cdr xs)))) +(def third (lambda (xs) (car (cdr (cdr xs))))) +(def fourth (lambda (xs) (car (cdr (cdr (cdr xs)))))) +(def fifth (lambda (xs) (car (cdr (cdr (cdr (cdr xs))))))) +(def sixth (lambda (xs) (car (cdr (cdr (cdr (cdr (cdr xs)))))))) +(def seventh (lambda (xs) (car (cdr (cdr (cdr (cdr (cdr (cdr xs))))))))) +(def eighth (lambda (xs) (car (cdr (cdr (cdr (cdr (cdr (cdr (cdr xs)))))))))) +(def ninth (lambda (xs) (car (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr xs))))))))))) + +(def join-newline-onto + (lambda (strings acc) + (cond + ((atom strings) acc) + ((eq acc "") (join-newline-onto (cdr strings) (car strings))) + (t (join-newline-onto (cdr strings) (str+ acc "\n" (car strings))))))) +(def join-newline (lambda (strings) (join-newline-onto strings ""))) + +; Function-table rows have the generated schema: +; (id formal (uk word status) (full-uk word status) (en word status) +; (sa word status) (sym word status) primary-status authority) +(def ft-form (car (read-all (read-file "lib/generated/function-table.wsm")))) +(def ft-rows (cdr ft-form)) + +(def profile-form + (car (read-all (read-file "lib/surface/український-профіль-джерела.всм")))) + +(def find-section + (lambda (name sections) + (cond + ((atom sections) (quote ())) + ((and (not (atom (car sections))) (eq (car (car sections)) name)) + (car sections)) + (t (find-section name (cdr sections)))))) + +(def candidate-section (find-section (quote назви) (cdr profile-form))) +(def candidate-rows + (cond + ((atom candidate-section) (quote ())) + (t (cdr candidate-section)))) + +(def find-candidate-row + (lambda (sid rows) + (cond + ((atom rows) (quote ())) + ((eq (car (car rows)) sid) (car rows)) + (t (find-candidate-row sid (cdr rows)))))) + +(def surface-word (lambda (surface) (second surface))) +(def surface-status (lambda (surface) (third surface))) + +(def missing-surface? + (lambda (surface) + (or (eq (surface-status surface) (quote missing)) + (eq (surface-word surface) (quote —))))) + +; Classification here is intentionally conservative. The audit may report a +; candidate, but only an explicit later review may classify it as compact, +; ambiguous, etc. We therefore never infer linguistic facts from spelling. +(def audit-class + (lambda (uk candidate) + (cond + ((eq (surface-status uk) (quote compatibility-only)) (quote compatibility-only)) + ((missing-surface? uk) (quote needs-research)) + ((atom candidate) (quote needs-research)) + ((eq (second candidate) (third candidate)) (quote full)) + (t (quote needs-research))))) + +(def candidate-full-word + (lambda (candidate) + (cond ((atom candidate) (quote —)) + (t (third candidate))))) + +(def candidate-evidence-status + (lambda (candidate) + (cond ((atom candidate) (quote no-staging-evidence)) + (t (fourth candidate))))) + +; `candidate-compact-uk` belongs to #86/#89. #85 must expose the empty slot, +; not invent abbreviations while performing an inventory. +(def candidate-compact-word (lambda () (quote —))) + +(def ambiguity-status + (lambda (candidate) + (cond + ((atom candidate) (quote needs-research)) + (t (quote not-yet-assessed))))) + +(def render-row + (lambda (row) + (let* ((sid (car row)) + (uk (third row)) + (full-authority (fourth row)) + (en (fifth row)) + (sa (sixth row)) + (sym (seventh row)) + (primary (eighth row)) + (candidate (find-candidate-row sid candidate-rows)) + (class (audit-class uk candidate)) + (candidate-full (candidate-full-word candidate)) + (candidate-status (candidate-evidence-status candidate)) + (ambiguity (ambiguity-status candidate))) + (str+ + " (row " (pad4 sid) + " (current-uk " (write-to-string (surface-word uk)) " " + (write-to-string (surface-status uk)) ")" + " (authoritative-full-uk " (write-to-string (surface-word full-authority)) " " + (write-to-string (surface-status full-authority)) ")" + " (en " (write-to-string (surface-word en)) " " + (write-to-string (surface-status en)) ")" + " (sa " (write-to-string (surface-word sa)) " " + (write-to-string (surface-status sa)) ")" + " (sym " (write-to-string (surface-word sym)) " " + (write-to-string (surface-status sym)) ")" + " (primary-status " (write-to-string primary) ")" + " (class " (write-to-string class) ")" + " (candidate-full-uk " (write-to-string candidate-full) ")" + " (candidate-full-status " (write-to-string candidate-status) ")" + " (candidate-compact-uk " (write-to-string (candidate-compact-word)) ")" + " (ambiguity " (write-to-string ambiguity) ")" + " (evidence generated-function-table staging-profile))")))) + +(def count-class + (lambda (wanted rows acc) + (cond + ((atom rows) acc) + (t + (let* ((sid (car (car rows))) + (uk (third (car rows))) + (candidate (find-candidate-row sid candidate-rows)) + (class (audit-class uk candidate))) + (count-class wanted (cdr rows) + (cond ((eq class wanted) (+ acc 1)) + (t acc)))))))) + +(def count-candidates + (lambda (rows acc) + (cond + ((atom rows) acc) + (t + (count-candidates (cdr rows) + (cond ((atom (find-candidate-row (car (car rows)) candidate-rows)) acc) + (t (+ acc 1)))))))) + +(def total (length ft-rows)) +(def full-count (count-class (quote full) ft-rows 0)) +(def compatibility-count (count-class (quote compatibility-only) ft-rows 0)) +(def needs-research-count (count-class (quote needs-research) ft-rows 0)) +(def candidate-count (count-candidates ft-rows 0)) + +(def header + (list + "; GENERATED — DO NOT EDIT BY HAND" + "; Semantic authority: lib/surface/semantic-registry.wsm via lib/generated/function-table.wsm" + "; Candidate evidence only: lib/surface/український-профіль-джерела.всм" + "; Generator: scripts/generate-uk-surface-audit.my (my-lisp#85)" + "; candidate-full-uk is NOT automatically promoted into authoritative full-uk" + "" + "(uk-surface-audit/1" + (str+ " (summary (total " (number->string total) ")" + " (full " (number->string full-count) ")" + " (already-compact 0)" + " (ambiguous 0)" + " (needs-research " (number->string needs-research-count) ")" + " (compatibility-only " (number->string compatibility-count) ")" + " (staging-evidence " (number->string candidate-count) "))") + " (rows")) + +(def body (join-newline (append header (map render-row ft-rows)))) +(def output (str+ body "\n )\n)\n")) + +(write-file "lib/generated/uk-surface-audit.wsm" output) +(print (str+ "uk-surface-audit: " (number->string total) " identities written"))