1a0419dc0c
Full SDK workspace: core, contracts, sdk, cli, browser-host, browser-kit, federation, omega-core, oracle, self-healing, strategies, tools, emacs. Clean extraction from the development monorepo. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
356 lines
13 KiB
Common Lisp
356 lines
13 KiB
Common Lisp
;; Canonical package declaration.
|
|
(define-package "self-healing"
|
|
:description "Fixpoint-based self-healing build pipelines"
|
|
:exports '(self-healing)
|
|
:effects '(build.run.op infer.op)
|
|
:requires '(oracle/core)
|
|
:version "0.1.0"
|
|
)
|
|
;;; Self-Healing Build Library
|
|
;;;
|
|
;;; Implements fixpoint-based self-healing builds using iteration that
|
|
;;; supports async effects (build.run.op, infer.op, file operations).
|
|
;;;
|
|
;;; The key insight: fixing code is an iterative process that converges.
|
|
;;; We run: build -> check errors -> fix one -> rebuild -> repeat
|
|
;;; until errors are empty or we hit max iterations.
|
|
;;;
|
|
;;; Usage:
|
|
;;; (self-healing-build 5) ; Try up to 5 fix iterations
|
|
;;; (self-healing-build-detect-cycles 5) ; With cycle detection
|
|
|
|
;; ============================================================
|
|
;; Helper Functions (not in core primitives)
|
|
;; ============================================================
|
|
|
|
;; List accessor helpers
|
|
(define (caar x) (car (car x)))
|
|
(define (cadar x) (car (cdr (car x))))
|
|
(define (cadddr x) (car (cdr (cdr (cdr x)))))
|
|
|
|
;; assoc: find pair with matching key in alist
|
|
(define (assoc key alist)
|
|
(cond
|
|
((null? alist) #f)
|
|
((equal? key (caar alist)) (car alist))
|
|
(else (assoc key (cdr alist)))))
|
|
|
|
;; record-ref: access field in a Map value (returned by build effect) or alist
|
|
;; Works with:
|
|
;; 1. Runtime Map values with entries like [[{tag: Str, s: "key"}, value], ...]
|
|
;; 2. Alist format: ((key . value) ...)
|
|
;; 3. Alist with symbol keys: ((file . "test.ts") (line . 42) ...)
|
|
;; NOTE: OmegaLLM requires if conditions to be booleans, so we use explicit checks
|
|
(define (record-ref m key)
|
|
(if (eq? m #f)
|
|
#f
|
|
;; First try assoc for alist format (most common in tests)
|
|
(let ((found (assoc key m)))
|
|
(if (pair? found)
|
|
(cdr found)
|
|
;; Try with string key for Map format
|
|
(let ((key-str (if (symbol? key) (symbol->string key) key)))
|
|
(record-ref-impl m key-str))))))
|
|
|
|
;; Implementation: iterate through map entries to find key by string
|
|
(define (record-ref-impl m key-str)
|
|
(cond
|
|
;; Handle Map tag (runtime maps have entries field)
|
|
((and (pair? m) (eq? (car m) 'Map))
|
|
(record-ref-entries (cadr m) key-str))
|
|
;; Handle raw entries list (vector of [key, val] pairs)
|
|
((pair? m)
|
|
(record-ref-entries m key-str))
|
|
;; Handle vector/list of entries
|
|
(else #f)))
|
|
|
|
;; Search entries for matching key (handles both Map entries and alists)
|
|
(define (record-ref-entries entries key-str)
|
|
(cond
|
|
((null? entries) #f)
|
|
((pair? entries)
|
|
(let ((entry (car entries)))
|
|
(cond
|
|
;; Entry is [key, val] pair from Map - check if key matches
|
|
((and (pair? entry)
|
|
(pair? (car entry))
|
|
(eq? (caar entry) 'Str)
|
|
(equal? (cadar entry) key-str))
|
|
(cadr entry)) ; Return the value
|
|
;; Entry is (key . val) alist style with string key
|
|
((and (pair? entry)
|
|
(equal? (car entry) key-str))
|
|
(cdr entry))
|
|
;; Entry is (symbol . val) alist - convert symbol to string
|
|
((and (pair? entry)
|
|
(symbol? (car entry))
|
|
(equal? (symbol->string (car entry)) key-str))
|
|
(cdr entry))
|
|
(else (record-ref-entries (cdr entries) key-str)))))
|
|
(else #f)))
|
|
|
|
;; ============================================================
|
|
;; Build State Representation
|
|
;; ============================================================
|
|
|
|
;; Build state: (build-state errors iteration cost)
|
|
(define (make-build-state errors iteration cost)
|
|
(list 'build-state errors iteration cost))
|
|
|
|
(define (build-state? x)
|
|
(and (pair? x) (eq? (car x) 'build-state)))
|
|
|
|
(define (state-errors state) (cadr state))
|
|
(define (state-iteration state) (caddr state))
|
|
(define (state-cost state) (cadddr state))
|
|
|
|
;; Update state after fix attempt
|
|
(define (state-with-errors state new-errors)
|
|
(make-build-state new-errors
|
|
(+ 1 (state-iteration state))
|
|
(+ 1 (state-cost state))))
|
|
|
|
;; State equality (for convergence detection)
|
|
(define (states-equal? s1 s2)
|
|
(equal? (state-errors s1) (state-errors s2)))
|
|
|
|
;; Error hash for cycle detection (concatenate file:line pairs)
|
|
(define (state-error-hash state)
|
|
(let ((errors (state-errors state)))
|
|
(if (null? errors)
|
|
"empty"
|
|
(fold-left
|
|
(lambda (acc e)
|
|
(string-append acc
|
|
(string-append (or (record-ref e 'file) "?") ":")
|
|
(number->string (or (record-ref e 'line) 0))
|
|
";"))
|
|
""
|
|
errors))))
|
|
|
|
;; ============================================================
|
|
;; Initial State from Build
|
|
;; ============================================================
|
|
|
|
(define (initial-build-state)
|
|
(let ((result (effect build.run.op)))
|
|
(make-build-state
|
|
(or (record-ref result 'errors) '())
|
|
0 ; iteration
|
|
0))) ; cost
|
|
|
|
;; ============================================================
|
|
;; Error Formatting
|
|
;; ============================================================
|
|
|
|
(define (format-errors errors)
|
|
(if (null? errors)
|
|
"(no errors)"
|
|
(fold-left
|
|
(lambda (acc e)
|
|
(string-append acc
|
|
"- " (or (record-ref e 'file) "unknown") ":"
|
|
(number->string (or (record-ref e 'line) 0)) ": "
|
|
(or (record-ref e 'message) "no message")
|
|
" (" (or (record-ref e 'code) "?") ")\n"))
|
|
""
|
|
errors)))
|
|
|
|
(define (format-error e)
|
|
(string-append
|
|
(or (record-ref e 'file) "unknown") ":"
|
|
(number->string (or (record-ref e 'line) 0)) ":"
|
|
(number->string (or (record-ref e 'col) 0)) ": "
|
|
(or (record-ref e 'message) "no message")))
|
|
|
|
;; ============================================================
|
|
;; LLM-Based Error Fixer
|
|
;; ============================================================
|
|
|
|
;; Fix errors using LLM reentry
|
|
;; The LLM can use omega_eval to read files, write fixes, and verify
|
|
(define (fix-errors-with-llm state)
|
|
(let ((errors (state-errors state)))
|
|
(if (null? errors)
|
|
state ; No change if no errors
|
|
|
|
;; Ask LLM to fix the first error
|
|
(let ((first-error (car errors)))
|
|
(display (string-append " Asking LLM to fix: " (format-error first-error) "\n"))
|
|
|
|
(let ((fix-result
|
|
(effect infer.op
|
|
(string-append
|
|
"Fix this TypeScript error. You have access to omega_eval for file operations.\n\n"
|
|
"Error:\n" (format-error first-error) "\n\n"
|
|
"Available commands:\n"
|
|
"1. omega_eval(\"(effect file.read.op \\\"path\\\")\") - read a file\n"
|
|
"2. omega_eval(\"(effect file.write.op \\\"path\\\" \\\"content\\\")\") - write a file\n\n"
|
|
"Steps:\n"
|
|
"1. Read the file that has the error\n"
|
|
"2. Understand the error and generate a fix\n"
|
|
"3. Write the fixed content back\n"
|
|
"4. Use omega_return with a summary of what you fixed\n"))))
|
|
|
|
;; After LLM finishes, rebuild and return new state
|
|
(let ((new-result (effect build.run.op)))
|
|
(state-with-errors state (or (record-ref new-result 'errors) '()))))))))
|
|
|
|
;; ============================================================
|
|
;; Self-Healing Loop (Manual Iteration - supports effects)
|
|
;; ============================================================
|
|
|
|
;; Internal recursive helper for the loop
|
|
(define (self-healing-loop-iter state max-attempts)
|
|
(let ((errors (state-errors state))
|
|
(iteration (state-iteration state)))
|
|
|
|
(display (string-append "Iteration " (number->string iteration)
|
|
": " (number->string (length errors)) " errors\n"))
|
|
|
|
(cond
|
|
;; Success: no errors
|
|
((null? errors)
|
|
(list 'success state iteration))
|
|
|
|
;; Max attempts reached
|
|
((>= iteration max-attempts)
|
|
(list 'partial state iteration))
|
|
|
|
;; Try to fix
|
|
(else
|
|
(let ((new-state (fix-errors-with-llm state)))
|
|
;; Check for convergence (same errors = stuck)
|
|
(if (states-equal? state new-state)
|
|
(list 'partial new-state iteration)
|
|
(self-healing-loop-iter new-state max-attempts)))))))
|
|
|
|
;; Main entry point: self-healing build
|
|
(define (self-healing-build max-attempts)
|
|
(display "=== Self-Healing Build ===\n")
|
|
(display (string-append "Max attempts: " (number->string max-attempts) "\n\n"))
|
|
|
|
(let* ((initial (initial-build-state))
|
|
(result (self-healing-loop-iter initial max-attempts)))
|
|
|
|
(let ((kind (car result))
|
|
(final-state (cadr result))
|
|
(iterations (caddr result)))
|
|
|
|
(cond
|
|
((eq? kind 'success)
|
|
(display "\n✓ Build is now clean!\n")
|
|
(list 'result
|
|
(cons 'kind 'success)
|
|
(cons 'iterations iterations)
|
|
(cons 'errors 0)))
|
|
|
|
((eq? kind 'partial)
|
|
(display (string-append "\n⚠ Reached limit with "
|
|
(number->string (length (state-errors final-state)))
|
|
" errors remaining\n"))
|
|
(list 'result
|
|
(cons 'kind 'partial)
|
|
(cons 'iterations iterations)
|
|
(cons 'errors (length (state-errors final-state)))))
|
|
|
|
(else
|
|
(display "\n✗ Self-healing failed\n")
|
|
(list 'result
|
|
(cons 'kind 'failure)
|
|
(cons 'iterations iterations)
|
|
(cons 'errors (length (state-errors final-state)))))))))
|
|
|
|
;; ============================================================
|
|
;; Self-Healing with Cycle Detection
|
|
;; ============================================================
|
|
|
|
;; Internal recursive helper with cycle detection
|
|
(define (self-healing-cycle-iter state max-attempts seen-hashes)
|
|
(let ((errors (state-errors state))
|
|
(iteration (state-iteration state))
|
|
(current-hash (state-error-hash state)))
|
|
|
|
(display (string-append "Iteration " (number->string iteration)
|
|
": " (number->string (length errors)) " errors"
|
|
" [hash: " current-hash "]\n"))
|
|
|
|
(cond
|
|
;; Success: no errors
|
|
((null? errors)
|
|
(list 'success state iteration #f))
|
|
|
|
;; Cycle detected: same error set seen before
|
|
((member current-hash seen-hashes)
|
|
(display "⚠ Cycle detected - same error set seen before\n")
|
|
(list 'cycle state iteration current-hash))
|
|
|
|
;; Max attempts reached
|
|
((>= iteration max-attempts)
|
|
(list 'partial state iteration #f))
|
|
|
|
;; Try to fix
|
|
(else
|
|
(let ((new-state (fix-errors-with-llm state)))
|
|
(self-healing-cycle-iter new-state max-attempts
|
|
(cons current-hash seen-hashes)))))))
|
|
|
|
;; Self-healing with cycle detection
|
|
(define (self-healing-build-detect-cycles max-attempts)
|
|
(display "=== Self-Healing Build (Cycle Detection) ===\n")
|
|
(display (string-append "Max attempts: " (number->string max-attempts) "\n\n"))
|
|
|
|
(let* ((initial (initial-build-state))
|
|
(result (self-healing-cycle-iter initial max-attempts '())))
|
|
|
|
(let ((kind (car result))
|
|
(final-state (cadr result))
|
|
(iterations (caddr result))
|
|
(cycle-hash (cadddr result)))
|
|
|
|
(cond
|
|
((eq? kind 'success)
|
|
(display "\n✓ Build is now clean!\n")
|
|
(list 'result
|
|
(cons 'kind 'success)
|
|
(cons 'iterations iterations)
|
|
(cons 'errors 0)))
|
|
|
|
((eq? kind 'cycle)
|
|
(display (string-append "\n⚠ Stopped due to cycle at hash: " cycle-hash "\n"))
|
|
(list 'result
|
|
(cons 'kind 'cycle)
|
|
(cons 'iterations iterations)
|
|
(cons 'errors (length (state-errors final-state)))
|
|
(cons 'cycle-hash cycle-hash)))
|
|
|
|
((eq? kind 'partial)
|
|
(display (string-append "\n⚠ Reached limit with "
|
|
(number->string (length (state-errors final-state)))
|
|
" errors remaining\n"))
|
|
(list 'result
|
|
(cons 'kind 'partial)
|
|
(cons 'iterations iterations)
|
|
(cons 'errors (length (state-errors final-state)))))
|
|
|
|
(else
|
|
(display "\n✗ Self-healing failed\n")
|
|
(list 'result
|
|
(cons 'kind 'failure)
|
|
(cons 'iterations iterations)
|
|
(cons 'errors (length (state-errors final-state)))))))))
|
|
|
|
;; ============================================================
|
|
;; Utility: Check build status without healing
|
|
;; ============================================================
|
|
|
|
(define (check-build-status)
|
|
(let ((result (effect build.run.op)))
|
|
(list
|
|
(cons 'ok (record-ref result 'ok))
|
|
(cons 'errors (length (or (record-ref result 'errors) '())))
|
|
(cons 'warnings (length (or (record-ref result 'warnings) '())))
|
|
(cons 'duration_ms (record-ref result 'duration_ms)))))
|
|
;; Manifest export anchors.
|
|
(define self-healing #t)
|