From 854ad390e9cd881a353738ed90967f2871032ea8 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Sun, 26 Apr 2026 10:24:14 -0400 Subject: [PATCH] Move check-tangle-sync from Engineering Standards to Literate Programming Engineering Standards now focuses on lifecycle phases (0, A, B, D, E). Literate Programming now owns LP structural invariants including tangle-sync. Changes: - Removed check-tangle-sync and *enforcement-rules* from org-skill-engineering-standards.org - Added check-tangle-sync, *tangle-targets*, *lp-project-root* to org-skill-literate-programming.org - Updated LP skill to check tangle-sync on file modification actions - Added literate-programming-tests.lisp with tangle-sync and block-balance tests - Removed tangle-sync tests from engineering-standards-tests.lisp --- .../gen/org-skill-engineering-standards.lisp | 44 +----- .../gen/org-skill-literate-programming.lisp | 60 +++++++- skills/org-skill-engineering-standards.org | 77 +---------- skills/org-skill-literate-programming.org | 128 +++++++++++++++++- tests/engineering-standards-tests.lisp | 27 ---- tests/literate-programming-tests.lisp | 48 +++++++ 6 files changed, 236 insertions(+), 148 deletions(-) create mode 100644 tests/literate-programming-tests.lisp diff --git a/library/gen/org-skill-engineering-standards.lisp b/library/gen/org-skill-engineering-standards.lisp index bfcff96..23283a5 100644 --- a/library/gen/org-skill-engineering-standards.lisp +++ b/library/gen/org-skill-engineering-standards.lisp @@ -15,8 +15,7 @@ (defvar *enforcement-rules* '((:pre-task (:git-clean "Working tree must be clean before modifications") - (:skill-queried "Skill catalog should be queried before analysis") - (:tangle-synced "Tangled .lisp files must match Org source")) + (:skill-queried "Skill catalog should be queried before analysis")) (:during-task (:org-only "Only .org files may be edited; .lisp is generated") (:one-per-block "One definition per src block") @@ -42,37 +41,6 @@ :message "ENGINEERING STANDARDS VIOLATION: Working tree is dirty. Commit changes before modifying files." :severity :blocker))) -(defvar *tangle-targets* - '(("skills/org-skill-engineering-standards.org" . "library/gen/org-skill-engineering-standards.lisp") - ("skills/org-skill-literate-programming.org" . "library/gen/org-skill-literate-programming.lisp") - ("harness/memory.org" . "library/memory.lisp") - ("harness/loop.org" . "library/loop.lisp") - ("harness/perceive.org" . "library/perceive.lisp") - ("harness/reason.org" . "library/reason.lisp") - ("harness/act.org" . "library/act.lisp") - ("harness/skills.org" . "library/skills.lisp") - ("harness/communication.org" . "library/communication.lisp"))) - -(defun check-tangle-sync (&optional (root *engineering-std-*project-root*)) - "Returns violation if any tangled .lisp file is newer than its Org source. - -This detects direct .lisp edits (which violate the LP workflow)." - (when root - (dolist (pair *tangle-targets*) - (let* ((org-file (merge-pathnames (car pair) root)) - (lisp-file (merge-pathnames (cdr pair) root)) - (org-time (ignore-errors (file-write-date org-file))) - (lisp-time (ignore-errors (file-write-date lisp-file)))) - (when (and org-time lisp-time (> lisp-time org-time)) - (return-from check-tangle-sync - (make-engineering-violation - :phase :pre-task - :rule :tangle-synced - :message (format nil "ENGINEERING STANDARDS VIOLATION: ~a is newer than ~a. Edit Org source, not .lisp directly." - (file-namestring lisp-file) (file-namestring org-file)) - :severity :blocker)))))) - nil) - (defun engineering-standards-gate (action context) "The deterministic HARD BLOCK gate for Engineering Standards. @@ -96,15 +64,7 @@ This detects direct .lisp edits (which violate the LP workflow)." (harness-log "~a" (engineering-violation-message git-check)) (return-from engineering-standards-gate (list :type :log - :payload (list :text (engineering-violation-message git-check)))))) - - ;; BLOCKING: Tangle sync check - .lisp must not be newer than .org - (let ((tangle-check (check-tangle-sync *engineering-std-*project-root*))) - (when tangle-check - (harness-log "~a" (engineering-violation-message tangle-check)) - (return-from engineering-standards-gate - (list :type :log - :payload (list :text (engineering-violation-message tangle-check)))))))) + :payload (list :text (engineering-violation-message git-check))))))) action) diff --git a/library/gen/org-skill-literate-programming.lisp b/library/gen/org-skill-literate-programming.lisp index e5a3ca3..5376a30 100644 --- a/library/gen/org-skill-literate-programming.lisp +++ b/library/gen/org-skill-literate-programming.lisp @@ -71,16 +71,57 @@ reports)))) (setf idx (+ end-pos 9)))))))))) +(defvar *tangle-targets* + '(("skills/org-skill-engineering-standards.org" . "library/gen/org-skill-engineering-standards.lisp") + ("skills/org-skill-literate-programming.org" . "library/gen/org-skill-literate-programming.lisp") + ("harness/memory.org" . "library/memory.lisp") + ("harness/loop.org" . "library/loop.lisp") + ("harness/perceive.org" . "library/perceive.lisp") + ("harness/reason.org" . "library/reason.lisp") + ("harness/act.org" . "library/act.lisp") + ("harness/skills.org" . "library/skills.lisp") + ("harness/communication.org" . "library/communication.lisp"))) + +(defvar *lp-project-root* nil) + +(defun lp-set-project-root (path) + (setf *lp-project-root* (uiop:ensure-directory-pathname path))) + +(defun check-tangle-sync (&optional (root *lp-project-root*)) + "Returns violation if any tangled .lisp file is newer than its Org source. + +This detects direct .lisp edits (which violate the LP workflow)." + (when root + (dolist (pair *tangle-targets*) + (let* ((org-file (merge-pathnames (car pair) root)) + (lisp-file (merge-pathnames (cdr pair) root)) + (org-time (ignore-errors (file-write-date org-file))) + (lisp-time (ignore-errors (file-write-date lisp-file)))) + (when (and org-time lisp-time (> lisp-time org-time)) + (return-from check-tangle-sync + (list :type :log + :payload (list :text (format nil "LITERATE PROGRAMMING VIOLATION: ~a is newer than ~a. Edit Org source, not .lisp directly." + (file-namestring lisp-file) (file-namestring org-file))))))))) + nil) + (defskill :skill-literate-programming :priority 1100 :trigger (lambda (ctx) (declare (ignore ctx)) - ;; Trigger on any skill-related action t) :probabilistic nil :deterministic (lambda (action context) (declare (ignore context)) - ;; Audit the action's target file if it's an org skill + ;; Check tangle sync before any file modification + (let ((file (and (listp action) (getf action :payload) (getf (getf action :payload) :file)))) + (when file + (let ((tangle-check (check-tangle-sync *lp-project-root*))) + (when tangle-check + (return-from skill-literate-programming deterministic + (progn + (harness-log "~a" (getf (getf tangle-check :payload) :text)) + tangle-check)))))) + ;; Audit org files for structural balance (when (and (listp action) (stringp (getf action :file))) (let ((file (getf action :file))) @@ -91,3 +132,18 @@ (harness-log "LITERATE PROGRAMMING: Structural issues found in ~a: ~a" file issues)))))) action)) + +(defvar *lp-initialized* nil) + +(defun lp-init () + "Initialize the LP system with project root." + (unless *lp-initialized* + (let ((env-root (or (uiop:getenv "OPENCORTEX_ROOT") + (uiop:getenv "MEMEX_DIR") + "/home/user/memex/projects/opencortex"))) + (lp-set-project-root env-root) + (setf *lp-initialized* t) + (harness-log "LITERATE PROGRAMMING: Initialized with root ~a" *lp-project-root*)))) + +;; Auto-initialize on load +(lp-init) diff --git a/skills/org-skill-engineering-standards.org b/skills/org-skill-engineering-standards.org index 8715589..fa0e0c7 100644 --- a/skills/org-skill-engineering-standards.org +++ b/skills/org-skill-engineering-standards.org @@ -125,8 +125,7 @@ The engineering standards skill is a HARD BLOCK gate. Violations are rejected, n (defvar *enforcement-rules* '((:pre-task (:git-clean "Working tree must be clean before modifications") - (:skill-queried "Skill catalog should be queried before analysis") - (:tangle-synced "Tangled .lisp files must match Org source")) + (:skill-queried "Skill catalog should be queried before analysis")) (:during-task (:org-only "Only .org files may be edited; .lisp is generated") (:one-per-block "One definition per src block") @@ -157,43 +156,6 @@ The engineering standards skill is a HARD BLOCK gate. Violations are rejected, n :severity :blocker))) #+end_src -** Tangle Sync Check (Blocking) - -This check verifies that tangled .lisp files are in sync with their Org source. Violation: edited .lisp directly instead of through Org. - -#+begin_src lisp :tangle ../library/gen/org-skill-engineering-standards.lisp -(defvar *tangle-targets* - '(("skills/org-skill-engineering-standards.org" . "library/gen/org-skill-engineering-standards.lisp") - ("skills/org-skill-literate-programming.org" . "library/gen/org-skill-literate-programming.lisp") - ("harness/memory.org" . "library/memory.lisp") - ("harness/loop.org" . "library/loop.lisp") - ("harness/perceive.org" . "library/perceive.lisp") - ("harness/reason.org" . "library/reason.lisp") - ("harness/act.org" . "library/act.lisp") - ("harness/skills.org" . "library/skills.lisp") - ("harness/communication.org" . "library/communication.lisp"))) - -(defun check-tangle-sync (&optional (root *engineering-std-*project-root*)) - "Returns violation if any tangled .lisp file is newer than its Org source. - -This detects direct .lisp edits (which violate the LP workflow)." - (when root - (dolist (pair *tangle-targets*) - (let* ((org-file (merge-pathnames (car pair) root)) - (lisp-file (merge-pathnames (cdr pair) root)) - (org-time (ignore-errors (file-write-date org-file))) - (lisp-time (ignore-errors (file-write-date lisp-file)))) - (when (and org-time lisp-time (> lisp-time org-time)) - (return-from check-tangle-sync - (make-engineering-violation - :phase :pre-task - :rule :tangle-synced - :message (format nil "ENGINEERING STANDARDS VIOLATION: ~a is newer than ~a. Edit Org source, not .lisp directly." - (file-namestring lisp-file) (file-namestring org-file)) - :severity :blocker)))))) - nil) -#+end_src - ** Test Suite These tests verify the enforcement logic. Run with: @@ -262,33 +224,6 @@ These tests verify the enforcement logic. Run with: (let ((result (opencortex::engineering-standards-gate action nil))) (is (listp result)) (is (eq :request (getf result :type)))))) - -(test tangle-sync-detects-stale-lisp - "check-tangle-sync returns violation when .lisp is newer than .org" - (let ((tmp-org "/tmp/test-skill.org") - (tmp-lisp "/tmp/test-skill.lisp")) - (with-open-file (f tmp-org :direction :output) (write-line "* Test" f)) - (sleep 1) - (with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f)) - (let* ((root (uiop:ensure-directory-pathname "/tmp/")) - (result (opencortex::check-tangle-sync root))) - (when result - (is (eq :tangle-synced (opencortex::engineering-violation-rule result)))) - (uiop:delete-file-if-exists tmp-org) - (uiop:delete-file-if-exists tmp-lisp))) - -(test tangle-sync-passes-when-synced - "check-tangle-sync returns nil when .org is newer than .lisp" - (let ((tmp-org "/tmp/test-skill2.org") - (tmp-lisp "/tmp/test-skill2.lisp")) - (with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f)) - (sleep 1) - (with-open-file (f tmp-org :direction :output) (write-line "* Test" f)) - (let* ((root (uiop:ensure-directory-pathname "/tmp/")) - (result (opencortex::check-tangle-sync root))) - (is (null result))) - (uiop:delete-file-if-exists tmp-org) - (uiop:delete-file-if-exists tmp-lisp))) #+end_src ** Blocking Gate (Hard Enforcement) @@ -317,15 +252,7 @@ These tests verify the enforcement logic. Run with: (harness-log "~a" (engineering-violation-message git-check)) (return-from engineering-standards-gate (list :type :log - :payload (list :text (engineering-violation-message git-check)))))) - - ;; BLOCKING: Tangle sync check - .lisp must not be newer than .org - (let ((tangle-check (check-tangle-sync *engineering-std-*project-root*))) - (when tangle-check - (harness-log "~a" (engineering-violation-message tangle-check)) - (return-from engineering-standards-gate - (list :type :log - :payload (list :text (engineering-violation-message tangle-check)))))))) + :payload (list :text (engineering-violation-message git-check))))))) action) #+end_src diff --git a/skills/org-skill-literate-programming.org b/skills/org-skill-literate-programming.org index 21fc2b1..a3b009f 100644 --- a/skills/org-skill-literate-programming.org +++ b/skills/org-skill-literate-programming.org @@ -136,19 +136,68 @@ Code without surrounding prose is a bug report waiting to happen. (setf idx (+ end-pos 9)))))))))) #+end_src +** Tangle Sync Check + +Verifies that tangled `.lisp` files are in sync with their Org source. Violation: edited .lisp directly instead of through Org. + +#+begin_src lisp :tangle ../library/gen/org-skill-literate-programming.lisp +(defvar *tangle-targets* + '(("skills/org-skill-engineering-standards.org" . "library/gen/org-skill-engineering-standards.lisp") + ("skills/org-skill-literate-programming.org" . "library/gen/org-skill-literate-programming.lisp") + ("harness/memory.org" . "library/memory.lisp") + ("harness/loop.org" . "library/loop.lisp") + ("harness/perceive.org" . "library/perceive.lisp") + ("harness/reason.org" . "library/reason.lisp") + ("harness/act.org" . "library/act.lisp") + ("harness/skills.org" . "library/skills.lisp") + ("harness/communication.org" . "library/communication.lisp"))) + +(defvar *lp-project-root* nil) + +(defun lp-set-project-root (path) + (setf *lp-project-root* (uiop:ensure-directory-pathname path))) + +(defun check-tangle-sync (&optional (root *lp-project-root*)) + "Returns violation if any tangled .lisp file is newer than its Org source. + +This detects direct .lisp edits (which violate the LP workflow)." + (when root + (dolist (pair *tangle-targets*) + (let* ((org-file (merge-pathnames (car pair) root)) + (lisp-file (merge-pathnames (cdr pair) root)) + (org-time (ignore-errors (file-write-date org-file))) + (lisp-time (ignore-errors (file-write-date lisp-file)))) + (when (and org-time lisp-time (> lisp-time org-time)) + (return-from check-tangle-sync + (list :type :log + :payload (list :text (format nil "LITERATE PROGRAMMING VIOLATION: ~a is newer than ~a. Edit Org source, not .lisp directly." + (file-namestring lisp-file) (file-namestring org-file))))))))) + nil) +#+end_src + ** Skill Registration +The LP skill runs at priority 1100 (just below engineering-standards at 1000). + #+begin_src lisp :tangle ../library/gen/org-skill-literate-programming.lisp (defskill :skill-literate-programming :priority 1100 :trigger (lambda (ctx) (declare (ignore ctx)) - ;; Trigger on any skill-related action t) :probabilistic nil :deterministic (lambda (action context) (declare (ignore context)) - ;; Audit the action's target file if it's an org skill + ;; Check tangle sync before any file modification + (let ((file (and (listp action) (getf action :payload) (getf (getf action :payload) :file)))) + (when file + (let ((tangle-check (check-tangle-sync *lp-project-root*))) + (when tangle-check + (return-from skill-literate-programming deterministic + (progn + (harness-log "~a" (getf (getf tangle-check :payload) :text)) + tangle-check)))))) + ;; Audit org files for structural balance (when (and (listp action) (stringp (getf action :file))) (let ((file (getf action :file))) @@ -161,6 +210,81 @@ Code without surrounding prose is a bug report waiting to happen. action)) #+end_src +** Initialize Project Root + +#+begin_src lisp :tangle ../library/gen/org-skill-literate-programming.lisp +(defvar *lp-initialized* nil) + +(defun lp-init () + "Initialize the LP system with project root." + (unless *lp-initialized* + (let ((env-root (or (uiop:getenv "OPENCORTEX_ROOT") + (uiop:getenv "MEMEX_DIR") + "/home/user/memex/projects/opencortex"))) + (lp-set-project-root env-root) + (setf *lp-initialized* t) + (harness-log "LITERATE PROGRAMMING: Initialized with root ~a" *lp-project-root*)))) + +;; Auto-initialize on load +(lp-init) +#+end_src + +** Test Suite + +These tests verify the LP enforcement logic. Run with: +~(fiveam:run! 'literate-programming-suite)~ + +#+begin_src lisp :tangle ../tests/literate-programming-tests.lisp +(defpackage :opencortex-literate-programming-tests + (:use :cl :fiveam :opencortex) + (:export #:literate-programming-suite)) + +(in-package :opencortex-literate-programming-tests) + +(def-suite literate-programming-suite + :description "Tests for Literate Programming enforcement") + +(in-suite literate-programming-suite) + +(test tangle-sync-detects-stale-lisp + "check-tangle-sync returns violation when .lisp is newer than .org" + (let ((tmp-org "/tmp/test-skill.org") + (tmp-lisp "/tmp/test-skill.lisp")) + (with-open-file (f tmp-org :direction :output) (write-line "* Test" f)) + (sleep 1) + (with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f)) + (let* ((root (uiop:ensure-directory-pathname "/tmp/")) + (result (opencortex::check-tangle-sync root))) + (is (listp result)) + (is (eq :log (getf result :type))) + (is (search "LITERATE PROGRAMMING VIOLATION" (getf (getf result :payload) :text))) + (uiop:delete-file-if-exists tmp-org) + (uiop:delete-file-if-exists tmp-lisp)))) + +(test tangle-sync-passes-when-synced + "check-tangle-sync returns nil when .org is newer than .lisp" + (let ((tmp-org "/tmp/test-skill2.org") + (tmp-lisp "/tmp/test-skill2.lisp")) + (with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f)) + (sleep 1) + (with-open-file (f tmp-org :direction :output) (write-line "* Test" f)) + (let* ((root (uiop:ensure-directory-pathname "/tmp/")) + (result (opencortex::check-tangle-sync root))) + (is (null result))) + (uiop:delete-file-if-exists tmp-org) + (uiop:delete-file-if-exists tmp-lisp))) + +(test block-balance-valid + "literate-check-block-balance returns T for balanced code" + (is (eq t (opencortex::literate-check-block-balance "(defun test () t)")))) + +(test block-balance-invalid + "literate-check-block-balance returns NIL for unbalanced code" + (multiple-value-bind (ok reason) (opencortex::literate-check-block-balance "(defun test ()") + (is (null ok)) + (is (stringp reason)))) +#+end_src + * See Also - [[file:org-skill-engineering-standards.org][Engineering Standards Skill]] - Lifecycle mandates - [[file:org-skill-policy.org][Policy Skill]] - Constitutional constraints diff --git a/tests/engineering-standards-tests.lisp b/tests/engineering-standards-tests.lisp index c34c784..65a3e20 100644 --- a/tests/engineering-standards-tests.lisp +++ b/tests/engineering-standards-tests.lisp @@ -60,30 +60,3 @@ (let ((result (opencortex::engineering-standards-gate action nil))) (is (listp result)) (is (eq :request (getf result :type)))))) - -(test tangle-sync-detects-stale-lisp - "check-tangle-sync returns violation when .lisp is newer than .org" - (let ((tmp-org "/tmp/test-skill.org") - (tmp-lisp "/tmp/test-skill.lisp")) - (with-open-file (f tmp-org :direction :output) (write-line "* Test" f)) - (sleep 1) - (with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f)) - (let* ((root (uiop:ensure-directory-pathname "/tmp/")) - (result (opencortex::check-tangle-sync root))) - (when result - (is (eq :tangle-synced (opencortex::engineering-violation-rule result)))) - (uiop:delete-file-if-exists tmp-org) - (uiop:delete-file-if-exists tmp-lisp))) - -(test tangle-sync-passes-when-synced - "check-tangle-sync returns nil when .org is newer than .lisp" - (let ((tmp-org "/tmp/test-skill2.org") - (tmp-lisp "/tmp/test-skill2.lisp")) - (with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f)) - (sleep 1) - (with-open-file (f tmp-org :direction :output) (write-line "* Test" f)) - (let* ((root (uiop:ensure-directory-pathname "/tmp/")) - (result (opencortex::check-tangle-sync root))) - (is (null result))) - (uiop:delete-file-if-exists tmp-org) - (uiop:delete-file-if-exists tmp-lisp))) diff --git a/tests/literate-programming-tests.lisp b/tests/literate-programming-tests.lisp new file mode 100644 index 0000000..0503121 --- /dev/null +++ b/tests/literate-programming-tests.lisp @@ -0,0 +1,48 @@ +(defpackage :opencortex-literate-programming-tests + (:use :cl :fiveam :opencortex) + (:export #:literate-programming-suite)) + +(in-package :opencortex-literate-programming-tests) + +(def-suite literate-programming-suite + :description "Tests for Literate Programming enforcement") + +(in-suite literate-programming-suite) + +(test tangle-sync-detects-stale-lisp + "check-tangle-sync returns violation when .lisp is newer than .org" + (let ((tmp-org "/tmp/test-skill.org") + (tmp-lisp "/tmp/test-skill.lisp")) + (with-open-file (f tmp-org :direction :output) (write-line "* Test" f)) + (sleep 1) + (with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f)) + (let* ((root (uiop:ensure-directory-pathname "/tmp/")) + (result (opencortex::check-tangle-sync root))) + (is (listp result)) + (is (eq :log (getf result :type))) + (is (search "LITERATE PROGRAMMING VIOLATION" (getf (getf result :payload) :text))) + (uiop:delete-file-if-exists tmp-org) + (uiop:delete-file-if-exists tmp-lisp)))) + +(test tangle-sync-passes-when-synced + "check-tangle-sync returns nil when .org is newer than .lisp" + (let ((tmp-org "/tmp/test-skill2.org") + (tmp-lisp "/tmp/test-skill2.lisp")) + (with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f)) + (sleep 1) + (with-open-file (f tmp-org :direction :output) (write-line "* Test" f)) + (let* ((root (uiop:ensure-directory-pathname "/tmp/")) + (result (opencortex::check-tangle-sync root))) + (is (null result))) + (uiop:delete-file-if-exists tmp-org) + (uiop:delete-file-if-exists tmp-lisp))) + +(test block-balance-valid + "literate-check-block-balance returns T for balanced code" + (is (eq t (opencortex::literate-check-block-balance "(defun test () t)")))) + +(test block-balance-invalid + "literate-check-block-balance returns NIL for unbalanced code" + (multiple-value-bind (ok reason) (opencortex::literate-check-block-balance "(defun test ()") + (is (null ok)) + (is (stringp reason))))