passepartout/lisp/programming-repl.lisp

(in-package :passepartout)

(defvar *repl-package* :passepartout
  "Default package for REPL evaluations.")

(defvar *repl-history* nil
  "History of evaluated forms for session continuity.")

(defvar *repl-variables* (make-hash-table :test #'eq)
  "Cache of bound variables for inspection.")

(defun repl-eval (code-string &key (package *repl-package*))
  "Evaluate Lisp code and return (values result output error).
   - result: the return value as string
   - output: captured stdout
   - error: error message or nil on success"
  (let ((out (make-string-output-stream))
        (err (make-string-output-stream))
        (pkg (or (find-package package) (find-package :passepartout))))
    (handler-case
        (let* ((*standard-output* out)
               (*error-output* err)
               (*package* pkg)
               (*read-eval* nil)
               (result nil))
          (with-input-from-string (s code-string)
            (loop for form = (read s nil :eof) until (eq form :eof)
                  do (setf result (eval form))))
          (push code-string *repl-history*)
          (values
           (format nil "~a" result)
           (get-output-stream-string out)
           nil))
      (error (c)
        (values
         nil
         (get-output-stream-string out)
         (format nil "~a" c))))))

(defun repl-inspect (symbol-name &key (package *repl-package*))
  "Inspect a variable's value and structure."
  (let* ((pkg (or (find-package package) (find-package :passepartout)))
         (sym (find-symbol (string-upcase symbol-name) pkg)))
    (cond
      ((null sym)
       (format nil "Symbol ~a not found in package ~a" symbol-name package))
      ((boundp sym)
       (let ((val (symbol-value sym)))
         (format nil "~a = ~a~%Type: ~a~%~%"
                 sym val (type-of val))))
      ((fboundp sym)
       (format nil "~a is a function~%Args: ~a~%"
               sym (documentation sym 'function)))
      (t
       (format nil "~a is unbound" symbol-name)))))

(defun repl-list-vars (&key (package *repl-package*))
  "List all bound variables in the package."
  (let* ((pkg (or (find-package package) (find-package :passepartout)))
         (vars nil))
    (do-symbols (sym pkg)
      (when (boundp sym)
        (push (format nil "~a" sym) vars)))
    (sort vars #'string<)))

(defun repl-load-file (filepath)
  "Load a Lisp file into the current image."
  (handler-case
      (progn
        (load filepath)
        (format nil "Loaded ~a" filepath))
    (error (c)
      (format nil "Error loading ~a: ~a" filepath c))))

(defun repl-set-package (package-name)
  "Set the default package for REPL evaluations."
  (let ((pkg (find-package (string-upcase package-name))))
    (if pkg
        (setf *repl-package* pkg)
        (format nil "Package ~a not found" package-name))))

(defun repl-help ()
  "Return available REPL commands."
  (format nil "~%
REPL Skill Commands:
-------------------
(repl-eval \"code\" :package :passepartout)
  - Evaluate Lisp code, returns (values result output error)

(repl-inspect \"symbol\" :package :passepartout)
  - Inspect a variable or function

(repl-list-vars :package :passepartout)
  - List all bound variables

(repl-load-file \"/path/to/file.lisp\")
  - Load a file into the image

(repl-set-package :package-name)
  - Switch default package

(repl-help)
  - Show this message
"))

(defun repl-handle (signal)
  "Pre-reason handler for :repl-eval sensor. Evaluates code and
writes the result back through the reply-stream."
  (let* ((payload (getf signal :payload))
         (code (getf payload :code))
         (stream (getf (getf signal :meta) :reply-stream))
         (result (multiple-value-bind (val out err)
                     (repl-eval code)
                   (if err
                       (list :status :error :message err)
                       (list :status :success :value (or val ""))))))
    (when stream
      (handler-case
          (progn
            (write-sequence (frame-message result) stream)
            (finish-output stream))
        (error (c)
          (log-message "REPL-EVAL: Failed to write response: ~a" c))))
    ;; Return T to signal the message was consumed
    t))

;; Register the handler at load time
(register-pre-reason-handler :repl-eval #'repl-handle)

(defun repl-mandate (context)
  "Returns REPL-first engineering mandate when context involves code editing."
  (let ((raw (or (proto-get (proto-get context :payload) :text) "")))
    (when (or (search "org-skill-" raw :test #'char-equal)
              (and (search ".org" raw :test #'char-equal)
                   (or (search "defun" raw :test #'char-equal)
                       (search "tangle" raw :test #'char-equal)
                       (search "write-file" raw :test #'char-equal)
                       (search "lisp" raw :test #'char-equal)))
              (search "defun " raw :test #'char-equal)
              (search "repl-eval" raw :test #'char-equal)
              (search "validate" raw :test #'char-equal))
      (format nil "~%REPL-FIRST MANDATE:~%Before writing any defun to an Org file, prototype it in the REPL first. Set :repl-verified t on the write action. On rejection, fix the error and retry.~%"))))

(defskill :passepartout-programming-repl
  :priority 200
  :trigger (lambda (ctx) (declare (ignore ctx)) nil)
  :deterministic (lambda (action ctx) (declare (ignore action ctx)) nil)
  :system-prompt-augment #'repl-mandate)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :fiveam :silent t))

(defpackage :passepartout-programming-repl-tests
  (:use :cl :fiveam :passepartout)
  (:export #:repl-suite))

(in-package :passepartout-programming-repl-tests)

(def-suite repl-suite :description "Verification of the REPL skill")
(in-suite repl-suite)

(test test-repl-eval-success
  "Contract 1: repl-eval returns result and no error for valid code."
  (multiple-value-bind (result output error) (repl-eval "(+ 1 2)")
    (is (equal "3" result))
    (is (null error))))

(test test-repl-eval-error
  "Contract 1: repl-eval returns error message for invalid code."
  (multiple-value-bind (result output error) (repl-eval "(+ 1 ")
    (is (null result))
    (is (stringp error))))

(test test-repl-inspect-found
  "Contract 2: repl-inspect returns description for a bound symbol."
  (let ((desc (repl-inspect "+" :package :cl)))
    (is (search "+" desc))
    (is (search "function" desc :test #'char-equal))))

(test test-repl-list-vars
  "Contract 3: repl-list-vars returns a list of symbols."
  (let ((vars (repl-list-vars :package :keyword)))
    (is (listp vars))
    (is (member ':repl-sensor vars))))