passepartout/org/programming-literate.org

SKILL: Literate Programming (org-skill-literate-programming.org)

• Overview
  • Contract
• Implementation
  • Package Context
  • Block Extraction
  • Synchronization Logic
  • literate-tangle-sync-check
  • Skill Registration
• Test Suite

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

(in-package :passepartout)

Block Extraction

;; REPL-VERIFIED: 2026-05-03T13:00:00

(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)))

Synchronization Logic

;; REPL-VERIFIED: 2026-05-03T13:00:00

(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)))))

literate-tangle-sync-check

;; REPL-VERIFIED: 2026-05-03T13:00:00

(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

Skill Registration

(defskill :passepartout-programming-literate
  :priority 300
  :trigger (lambda (ctx) (declare (ignore ctx)) nil))

Test Suite

(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")))