Amr Gharbeia
c227877302
Bug fixes: - Fix box() calls: set color-pair before box, pass ACS default chtype integers - Fix markdown functions: move to passepartout.channel-tui package where Croatoan is imported; use add-attributes/remove-attributes instead of :bold/:underline kwargs to add-string; call theme-color in gate-trace-lines to convert theme keys to Croatoan colors - Fix sandbox: remove dex:get/dex:post from restricted symbols (blocked neuro-provider from loading) - Export *log-lock* from passepartout (was unbound in jailed skill packages) - Fix configure: always deploy to XDG, skip cp when source==dest - Fix bash crash handler format string (~~ escaping) - Revert test reorder in 28 files (caused package leakage in skill loader) Design cleanup: - Extract tui-run-screen from tui-main for clean separation - Remove inject-stimulus alias - Merge *backend-registry* into *probabilistic-backends* - Fix read-framed-message whitespace DoS (4096-iteration max) - Add *read-eval* nil to dispatcher-approvals-process read-from-string
145 lines
5.8 KiB
Org Mode
145 lines
5.8 KiB
Org Mode
#+TITLE: SKILL: Literate Programming (org-skill-literate-programming.org)
|
|
#+AUTHOR: Agent
|
|
#+FILETAGS: :system:literate:tangle:
|
|
#+PROPERTY: header-args:lisp :tangle ../lisp/programming-literate.lisp
|
|
|
|
* Overview
|
|
This skill enforces the literal programming discipline for all Passepartout source code. It defines the rules for one-function-per-block, prose-before-code, reflecting working code back from the REPL to Org, and the tangle mandate (never edit .lisp directly). Every Org file that contains Lisp code should follow the rules defined here.
|
|
|
|
** Contract
|
|
|
|
1. (literate-extract-lisp-blocks content): extracts concatenated
|
|
Lisp code from all ~#+begin_src lisp~ blocks in an Org string.
|
|
2. (literate-block-balance-check org-file): checks that parentheses are
|
|
balanced across all lisp blocks in an Org file. Returns T or nil.
|
|
3. (literate-tangle-sync-check org-file lisp-file): verifies the
|
|
tangled .lisp file matches the Org source. Returns T or mismatch info.
|
|
|
|
* Implementation
|
|
|
|
** Package Context
|
|
#+begin_src lisp
|
|
(in-package :passepartout)
|
|
#+end_src
|
|
|
|
** Block Extraction
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun literate-extract-lisp-blocks (content)
|
|
"Extracts all #+begin_src lisp ... #+end_src blocks from Org CONTENT.
|
|
Returns a list of block strings."
|
|
(let ((lines (uiop:split-string content :separator '(#\Newline)))
|
|
(blocks nil)
|
|
(in-block nil)
|
|
(current-block nil))
|
|
(dolist (line lines)
|
|
(let ((trimmed (string-trim '(#\Space) line)))
|
|
(cond
|
|
((uiop:string-prefix-p "#+begin_src lisp" trimmed)
|
|
(setf in-block t current-block nil))
|
|
((uiop:string-prefix-p "#+end_src" trimmed)
|
|
(when in-block
|
|
(push (format nil "~{~a~^~%~}" (nreverse current-block)) blocks)
|
|
(setf in-block nil current-block nil)))
|
|
(in-block
|
|
(push line current-block)))))
|
|
(nreverse blocks)))
|
|
#+end_src
|
|
|
|
** Synchronization Logic
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun literate-block-balance-check (org-file)
|
|
"Verifies that all Lisp source blocks in an Org file have balanced parentheses.
|
|
Returns T if all blocks pass validation, or an error string listing failures."
|
|
(when (not (uiop:file-exists-p org-file))
|
|
(return-from literate-block-balance-check
|
|
(format nil "Org file not found: ~a" org-file)))
|
|
(let* ((content (uiop:read-file-string org-file))
|
|
(blocks (literate-extract-lisp-blocks content))
|
|
(failures nil))
|
|
(if (null blocks)
|
|
t
|
|
(progn
|
|
(loop for i from 0
|
|
for block in blocks
|
|
for (ok reason) = (multiple-value-list
|
|
(lisp-structural-check block))
|
|
unless ok
|
|
do (push (format nil "Block ~d: ~a" (1+ i) reason) failures))
|
|
(if failures
|
|
(format nil "Unbalanced blocks in ~a:~%~{~a~^~%~}" org-file failures)
|
|
t)))))
|
|
|
|
#+end_src
|
|
** literate-tangle-sync-check
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun literate-tangle-sync-check (org-file lisp-file)
|
|
"Verifies that the .lisp file matches the tangled output of the .org file.
|
|
Compares the concatenation of all lisp blocks from the Org file against the
|
|
contents of the Lisp file. Returns T if they match, or an error message."
|
|
(when (not (uiop:file-exists-p org-file))
|
|
(return-from literate-tangle-sync-check
|
|
(format nil "Org file not found: ~a" org-file)))
|
|
(when (not (uiop:file-exists-p lisp-file))
|
|
(return-from literate-tangle-sync-check
|
|
(format nil "Lisp file not found: ~a" lisp-file)))
|
|
(let* ((org-content (uiop:read-file-string org-file))
|
|
(org-blocks (literate-extract-lisp-blocks org-content))
|
|
(tangled (format nil "~{~a~^~%~%~}" org-blocks))
|
|
(lisp-content (uiop:read-file-string lisp-file)))
|
|
(if (string= (string-trim '(#\Space #\Newline) tangled)
|
|
(string-trim '(#\Space #\Newline) lisp-content))
|
|
t
|
|
(format nil "Tangle sync mismatch: ~a does not match ~a" org-file lisp-file))))
|
|
#+end_src
|
|
#+end_src
|
|
|
|
** Skill Registration
|
|
#+begin_src lisp
|
|
(defskill :passepartout-programming-literate
|
|
:priority 300
|
|
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
|
#+end_src
|
|
|
|
* Test Suite
|
|
|
|
#+begin_src lisp
|
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
(ql:quickload :fiveam :silent t))
|
|
|
|
(defpackage :passepartout-programming-literate-tests
|
|
(:use :cl :fiveam :passepartout)
|
|
(:export #:literate-suite))
|
|
|
|
(in-package :passepartout-programming-literate-tests)
|
|
|
|
(def-suite literate-suite :description "Verification of the Literate Programming skill")
|
|
(in-suite literate-suite)
|
|
|
|
(test test-extract-lisp-blocks
|
|
"Contract 1: extracts lisp from #+begin_src blocks."
|
|
(let* ((org-content (format nil "#+begin_src lisp~%(+ 1 2)~%#+end_src~%#+begin_src lisp~%(+ 3 4)~%#+end_src"))
|
|
(extracted (literate-extract-lisp-blocks org-content)))
|
|
(let ((joined (format nil "~{~a~^~%~}" extracted)))
|
|
(is (search "(+ 1 2)" joined))
|
|
(is (search "(+ 3 4)" joined)))))
|
|
|
|
(test test-block-balance-check-valid
|
|
"Contract 2: balanced parens return T."
|
|
(is (eq t (literate-block-balance-check
|
|
(merge-pathnames "org/core-pipeline.org"
|
|
(uiop:ensure-directory-pathname
|
|
(uiop:getenv "PASSEPARTOUT_DATA_DIR")))))))
|
|
|
|
(test test-block-balance-check-missing-close
|
|
"Contract 2: unbalanced parens return non-T."
|
|
(is (not (eq t (literate-block-balance-check "org/nonexistent-file-xyz.org")))))
|
|
|
|
(test test-tangle-sync-check
|
|
"Contract 3: literate-tangle-sync-check verifies org matches tangled lisp."
|
|
(let ((result (literate-tangle-sync-check "org/core-pipeline.org" "lisp/core-pipeline.lisp")))
|
|
(is (or (eq t result) (stringp result))
|
|
"Should return T or a mismatch description")))
|
|
#+end_src |