From 1e202629ce7785b1e17d197baad364dbd1df98a8 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Sun, 26 Apr 2026 15:54:25 -0400 Subject: [PATCH] Move LP checks from Engineering Standards to LP skill - Removed *tangle-targets* and check-tangle-sync from engineering-standards.org - Fixed LP org: added (in-package), fixed block balance, fixed return-from - Fixed literate-check-block-balance to return (values nil reason) on imbalance - Updated LP tests to work with *tangle-targets* override - Regenerated all .lisp from org via emacs --batch - Added LP gen back to opencortex.asd Test results: - Engineering Standards: 9/10 (90%) - Literate Programming: 7/7 (100%) --- .../gen/org-skill-engineering-standards.lisp | 48 +--------- .../gen/org-skill-literate-programming.lisp | 52 +++++----- opencortex.asd | 1 + skills/org-skill-engineering-standards.org | 78 +-------------- skills/org-skill-literate-programming.org | 95 ++++++++++++------- tests/literate-programming-tests.lisp | 43 +++++++-- 6 files changed, 133 insertions(+), 184 deletions(-) diff --git a/library/gen/org-skill-engineering-standards.lisp b/library/gen/org-skill-engineering-standards.lisp index c492a0e..95e2b25 100644 --- a/library/gen/org-skill-engineering-standards.lisp +++ b/library/gen/org-skill-engineering-standards.lisp @@ -1,6 +1,5 @@ (in-package :opencortex) - (defvar *engineering-std-*project-root* nil "Path to the project root for enforcement checks.") @@ -16,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") @@ -43,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. @@ -97,17 +64,9 @@ 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)))))) + :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)))))))) - - action) + action)) (defskill :skill-engineering-standards :priority 1000 @@ -131,4 +90,3 @@ This detects direct .lisp edits (which violate the LP workflow)." ;; Auto-initialize on load (engineering-std-init) - diff --git a/library/gen/org-skill-literate-programming.lisp b/library/gen/org-skill-literate-programming.lisp index 5376a30..38898ae 100644 --- a/library/gen/org-skill-literate-programming.lisp +++ b/library/gen/org-skill-literate-programming.lisp @@ -1,10 +1,12 @@ +(in-package :opencortex) + (defun literate-check-block-balance (code-string) "Returns T if CODE-STRING has balanced parentheses, brackets, and strings. Ignores comments (after ;) and tracks string contents to avoid counting parens inside string literals." (let ((depth 0) (in-string nil) (escaped nil)) - (dotimes (i (length code-string) (zerop depth)) + (dotimes (i (length code-string)) (let ((ch (char code-string i))) (cond ;; Escape handling (affects next char only) @@ -24,7 +26,10 @@ (if (<= depth 0) (return-from literate-check-block-balance (values nil (format nil "Unexpected close paren at position ~a" i))) - (decf depth)))))))) + (decf depth)))))) + (if (zerop depth) + t + (values nil (format nil "Unbalanced parens: depth ~a at end of string" depth))))) (defun literate-audit-org-file (filepath) "Audits all tangled lisp blocks in an Org file for structural balance. @@ -69,7 +74,7 @@ :reason reason :code code) reports)))) - (setf idx (+ end-pos 9)))))))))) + (setf idx (+ end-pos 9))))))))))) (defvar *tangle-targets* '(("skills/org-skill-engineering-standards.org" . "library/gen/org-skill-engineering-standards.lisp") @@ -112,26 +117,27 @@ This detects direct .lisp edits (which violate the LP workflow)." :probabilistic nil :deterministic (lambda (action context) (declare (ignore context)) - ;; 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))) - (when (and (search ".org" file) - (search "skill" file :test #'string-equal)) - (let ((issues (literate-audit-org-file file))) - (when issues - (harness-log "LITERATE PROGRAMMING: Structural issues found in ~a: ~a" - file issues)))))) - action)) + (block skill-literate-programming + ;; 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 + (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))) + (when (and (search ".org" file) + (search "skill" file :test #'string-equal)) + (let ((issues (literate-audit-org-file file))) + (when issues + (harness-log "LITERATE PROGRAMMING: Structural issues found in ~a: ~a" + file issues)))))) + action))) (defvar *lp-initialized* nil) diff --git a/opencortex.asd b/opencortex.asd index 9ea91b0..8c5e66c 100644 --- a/opencortex.asd +++ b/opencortex.asd @@ -25,6 +25,7 @@ (:file "library/communication-validator") ; Schema validation (:file "library/memory") ; Org-object store, snapshots (:file "library/gen/org-skill-engineering-standards") ; Enforcement + (:file "library/gen/org-skill-literate-programming") ; LP enforcement (:file "library/context") ; Context assembly, query (:file "library/perceive") ; Stage 1: Sensory normalization (:file "library/reason") ; Stage 2: Neural + deterministic diff --git a/skills/org-skill-engineering-standards.org b/skills/org-skill-engineering-standards.org index 8715589..6da42c1 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,42 +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 @@ -262,33 +225,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,17 +253,9 @@ 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)))))) + :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)))))))) - - action) + action)) #+end_src ** Skill Registration diff --git a/skills/org-skill-literate-programming.org b/skills/org-skill-literate-programming.org index a3b009f..73ae7d8 100644 --- a/skills/org-skill-literate-programming.org +++ b/skills/org-skill-literate-programming.org @@ -58,13 +58,15 @@ Code without surrounding prose is a bug report waiting to happen. ** Block Balance Checker #+begin_src lisp :tangle ../library/gen/org-skill-literate-programming.lisp +(in-package :opencortex) + (defun literate-check-block-balance (code-string) "Returns T if CODE-STRING has balanced parentheses, brackets, and strings. Ignores comments (after ;) and tracks string contents to avoid counting parens inside string literals." (let ((depth 0) (in-string nil) (escaped nil)) - (dotimes (i (length code-string) (zerop depth)) + (dotimes (i (length code-string)) (let ((ch (char code-string i))) (cond ;; Escape handling (affects next char only) @@ -84,7 +86,10 @@ Code without surrounding prose is a bug report waiting to happen. (if (<= depth 0) (return-from literate-check-block-balance (values nil (format nil "Unexpected close paren at position ~a" i))) - (decf depth)))))))) + (decf depth)))))) + (if (zerop depth) + t + (values nil (format nil "Unbalanced parens: depth ~a at end of string" depth))))) #+end_src ** File-Level Balance Audit @@ -133,7 +138,7 @@ Code without surrounding prose is a bug report waiting to happen. :reason reason :code code) reports)))) - (setf idx (+ end-pos 9)))))))))) + (setf idx (+ end-pos 9))))))))))) #+end_src ** Tangle Sync Check @@ -188,26 +193,27 @@ The LP skill runs at priority 1100 (just below engineering-standards at 1000). :probabilistic nil :deterministic (lambda (action context) (declare (ignore context)) - ;; 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))) - (when (and (search ".org" file) - (search "skill" file :test #'string-equal)) - (let ((issues (literate-audit-org-file file))) - (when issues - (harness-log "LITERATE PROGRAMMING: Structural issues found in ~a: ~a" - file issues)))))) - action)) + (block skill-literate-programming + ;; 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 + (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))) + (when (and (search ".org" file) + (search "skill" file :test #'string-equal)) + (let ((issues (literate-audit-org-file file))) + (when issues + (harness-log "LITERATE PROGRAMMING: Structural issues found in ~a: ~a" + file issues)))))) + action))) #+end_src ** Initialize Project Root @@ -248,18 +254,43 @@ These tests verify the LP enforcement logic. Run with: (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")) + (let* ((root (uiop:ensure-directory-pathname "/tmp/lp-test/")) + (tmp-org (merge-pathnames "skills/test-skill.org" root)) + (tmp-lisp (merge-pathnames "library/gen/test-skill.lisp" root))) + (uiop:ensure-all-directories-exist (list (directory-namestring tmp-org) (directory-namestring tmp-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)))) + (let ((orig-targets opencortex::*tangle-targets*)) + (setf opencortex::*tangle-targets* + (cons '("skills/test-skill.org" . "library/gen/test-skill.lisp") orig-targets)) + (unwind-protect + (let ((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)))) + (setf opencortex::*tangle-targets* orig-targets))) + (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* ((root (uiop:ensure-directory-pathname "/tmp/lp-test2/")) + (tmp-org (merge-pathnames "skills/test-skill2.org" root)) + (tmp-lisp (merge-pathnames "library/gen/test-skill2.lisp" root))) + (uiop:ensure-all-directories-exist (list (directory-namestring tmp-org) (directory-namestring tmp-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 ((orig-targets opencortex::*tangle-targets*)) + (setf opencortex::*tangle-targets* + (cons '("skills/test-skill2.org" . "library/gen/test-skill2.lisp") orig-targets)) + (unwind-protect + (let ((result (opencortex::check-tangle-sync root))) + (is (null result))) + (setf opencortex::*tangle-targets* orig-targets))) + (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" diff --git a/tests/literate-programming-tests.lisp b/tests/literate-programming-tests.lisp index 0503121..9b0c945 100644 --- a/tests/literate-programming-tests.lisp +++ b/tests/literate-programming-tests.lisp @@ -11,18 +11,43 @@ (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")) + (let* ((root (uiop:ensure-directory-pathname "/tmp/lp-test/")) + (tmp-org (merge-pathnames "skills/test-skill.org" root)) + (tmp-lisp (merge-pathnames "library/gen/test-skill.lisp" root))) + (uiop:ensure-all-directories-exist (list (directory-namestring tmp-org) (directory-namestring tmp-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)))) + (let ((orig-targets opencortex::*tangle-targets*)) + (setf opencortex::*tangle-targets* + (cons '("skills/test-skill.org" . "library/gen/test-skill.lisp") orig-targets)) + (unwind-protect + (let ((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)))) + (setf opencortex::*tangle-targets* orig-targets))) + (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* ((root (uiop:ensure-directory-pathname "/tmp/lp-test2/")) + (tmp-org (merge-pathnames "skills/test-skill2.org" root)) + (tmp-lisp (merge-pathnames "library/gen/test-skill2.lisp" root))) + (uiop:ensure-all-directories-exist (list (directory-namestring tmp-org) (directory-namestring tmp-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 ((orig-targets opencortex::*tangle-targets*)) + (setf opencortex::*tangle-targets* + (cons '("skills/test-skill2.org" . "library/gen/test-skill2.lisp") orig-targets)) + (unwind-protect + (let ((result (opencortex::check-tangle-sync root))) + (is (null result))) + (setf opencortex::*tangle-targets* orig-targets))) + (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"