Move LP checks from Engineering Standards to LP skill
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s
- 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%)
This commit is contained in:
@@ -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)
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user