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%)
2026-04-26 15:54:25 -04:00
parent fe4b80ba68
commit 1e202629ce
6 changed files with 133 additions and 184 deletions
--- 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)
-
--- 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)

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