diff --git a/fix-tui.py b/fix-tui.py new file mode 100644 index 0000000..91123d9 --- /dev/null +++ b/fix-tui.py @@ -0,0 +1,40 @@ +import sys + +filepath = "literate/tui-client.org" +with open(filepath, "r") as f: + lines = f.readlines() + +out = [] +in_block = False +for line in lines: + if ";; 3. Handle Keyboard Input" in line: + in_block = True + out.append(line) + out.append(" (let* ((event (get-wide-event input-win))\n") + out.append(" (ch (and event (typep event 'event) (event-key event))))\n") + out.append(" (when ch\n") + out.append(" (cond\n") + out.append(" ((or (eq ch #\\Newline) (eq ch #\\Return))\n") + out.append(" (let ((cmd (coerce *input-buffer* 'string)))\n") + out.append(" (setf (fill-pointer *input-buffer*) 0)\n") + out.append(" (when (> (length cmd) 0)\n") + out.append(" (let ((framed (opencortex:frame-message (format nil \"~s\" (list :type :EVENT :payload (list :sensor :chat-message :text cmd))))))\n") + out.append(" (format *stream* \"~a\" framed)\n") + out.append(" (finish-output *stream*)))\n") + out.append(" (when (string= cmd \"/exit\") (setf *is-running* nil))))\n") + out.append(" ((or (eq ch :backspace) (eq ch #\\Backspace) (eq ch #\\Rubout) (eq ch #\\Del))\n") + out.append(" (when (> (length *input-buffer*) 0)\n") + out.append(" (decf (fill-pointer *input-buffer*))))\n") + out.append(" ((characterp ch)\n") + out.append(" (vector-push-extend ch *input-buffer*))))\n") + continue + if in_block: + if "(clear input-win)" in line: + in_block = False + out.append(line) + continue + out.append(line) + +with open(filepath, "w") as f: + f.writelines(out) +print("Fix applied") diff --git a/literate/act.org b/literate/act.org index 24f19fc..fa13612 100644 --- a/literate/act.org +++ b/literate/act.org @@ -117,18 +117,22 @@ The final stage of the metabolic loop. It performs a "last-mile" safety check be ;; 2. Actuation Logic (case type (:REQUEST (dispatch-action signal signal)) + (:LOG (dispatch-action signal signal)) (:EVENT - (when approved - (let* ((target (getf approved :target)) - (result (dispatch-action approved signal))) - ;; If the actuator returns a signal (like :tool-output), it becomes the feedback. - ;; Otherwise, generate tool-output feedback for non-silent actuators. - (cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG))) - (setf feedback result)) - ((and result (not (member target *silent-actuators*))) - (setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) - :reply-stream (getf signal :reply-stream) - :payload (list :sensor :tool-output :result result :tool approved))))))))) + (if approved + (let* ((target (getf approved :target)) + (result (dispatch-action approved signal))) + ;; If the actuator returns a signal (like :tool-output), it becomes the feedback. + ;; Otherwise, generate tool-output feedback for non-silent actuators. + (cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG))) + (setf feedback result)) + ((and result (not (member target *silent-actuators*))) + (setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) + :reply-stream (getf signal :reply-stream) + :payload (list :sensor :tool-output :result result :tool approved)))))) + ;; If no approved action but we have a reply-stream, this might be a raw event/log stimulus. + (when (getf signal :reply-stream) + (dispatch-action signal signal))))) (setf (getf signal :status) :acted) feedback)) diff --git a/literate/communication.org b/literate/communication.org index 0185921..b6ea4db 100644 --- a/literate/communication.org +++ b/literate/communication.org @@ -138,10 +138,15 @@ A robust utility to read a framed message from a stream. It enforces the determi #+begin_src lisp :tangle ../src/communication.lisp (defun read-framed-message (stream) - "Reads a hex-length prefixed message from the stream securely." + "Reads a hex-length prefixed message from the stream securely. Skips leading whitespace." (let ((length-buffer (make-string 6))) (handler-case (progn + ;; 0. Skip leading whitespace (newlines, spaces, etc.) + (loop for char = (peek-char nil stream nil :eof) + while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return))) + do (read-char stream)) + ;; 1. Read the 6-char hex length (let ((count (read-sequence length-buffer stream))) (when (< count 6) (return-from read-framed-message :eof)) diff --git a/literate/loop.org b/literate/loop.org index 425b05f..04194c8 100644 --- a/literate/loop.org +++ b/literate/loop.org @@ -36,10 +36,16 @@ The `process-signal` function is the core metabolic processor. It iterates throu (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil)) (return nil)) (handler-case - (progn + (let ((parent-metadata (list :reply-stream (getf current-signal :reply-stream) + :foveal-focus (getf current-signal :foveal-focus)))) (setf current-signal (perceive-gate current-signal)) (setf current-signal (reason-gate current-signal)) - (setf current-signal (act-gate current-signal))) + (setf current-signal (act-gate current-signal)) + ;; Inherit metadata for the next metabolic cycle if feedback was generated. + (when (and current-signal (not (getf current-signal :reply-stream))) + (setf (getf current-signal :reply-stream) (getf parent-metadata :reply-stream))) + (when (and current-signal (not (getf current-signal :foveal-focus))) + (setf (getf current-signal :foveal-focus) (getf parent-metadata :foveal-focus)))) (error (c) (let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor)))) (harness-log "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c) diff --git a/literate/reason.org b/literate/reason.org index 9152991..7b7e815 100644 --- a/literate/reason.org +++ b/literate/reason.org @@ -40,10 +40,12 @@ The `probabilistic-call` function manages the cascade of neural providers. If th (result (if model (funcall backend-fn prompt system-prompt :model model) (funcall backend-fn prompt system-prompt)))) - ;; If the result is valid and doesn't contain a failure log, return it. - (unless (or (null result) - (and (stringp result) (search ":LOG" result))) - (return result)))))) + ;; If the result is valid, return it. + ;; If it is an error plist from the gateway, continue the cascade but log it. + (cond ((and (listp result) (eq (getf result :status) :success)) + (return (getf result :content))) + ((stringp result) (return result)) + (t (harness-log "PROBABILISTIC: Backend ~a failed: ~a" backend (getf result :message)))))))) ;; Final fallback if all backends in the cascade fail. (list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted."))))) #+end_src @@ -94,11 +96,16 @@ Once a proposal is generated, it MUST pass through the deterministic gates. Ever (let ((trigger (skill-trigger-fn skill)) (gate (skill-deterministic-fn skill))) (when (or (null trigger) (ignore-errors (funcall trigger context))) - (setf current-action (funcall gate current-action context)) - ;; If any gate returns a LOG or EVENT, it has intercepted the action. - (when (and (listp current-action) (member (getf current-action :type) '(:LOG :EVENT :log :event))) - (harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill)) - (return-from deterministic-verify current-action))))) + (let ((next-action (funcall gate current-action context))) + ;; Interception occurs if the gate returns a signal (LOG/EVENT) AND either: + ;; 1. The original action was NOT a signal (e.g. it was a REQUEST). + ;; 2. The gate returned a DIFFERENT signal than it was given. + (when (and (listp next-action) + (member (getf next-action :type) '(:LOG :EVENT :log :event)) + (not (eq next-action current-action))) + (harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill)) + (return-from deterministic-verify next-action)) + (setf current-action next-action))))) current-action)) #+end_src diff --git a/src/act.lisp b/src/act.lisp index 02e325e..65f24d1 100644 --- a/src/act.lisp +++ b/src/act.lisp @@ -84,18 +84,22 @@ ;; 2. Actuation Logic (case type (:REQUEST (dispatch-action signal signal)) + (:LOG (dispatch-action signal signal)) (:EVENT - (when approved - (let* ((target (getf approved :target)) - (result (dispatch-action approved signal))) - ;; If the actuator returns a signal (like :tool-output), it becomes the feedback. - ;; Otherwise, generate tool-output feedback for non-silent actuators. - (cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG))) - (setf feedback result)) - ((and result (not (member target *silent-actuators*))) - (setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) - :reply-stream (getf signal :reply-stream) - :payload (list :sensor :tool-output :result result :tool approved))))))))) + (if approved + (let* ((target (getf approved :target)) + (result (dispatch-action approved signal))) + ;; If the actuator returns a signal (like :tool-output), it becomes the feedback. + ;; Otherwise, generate tool-output feedback for non-silent actuators. + (cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG))) + (setf feedback result)) + ((and result (not (member target *silent-actuators*))) + (setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) + :reply-stream (getf signal :reply-stream) + :payload (list :sensor :tool-output :result result :tool approved)))))) + ;; If no approved action but we have a reply-stream, this might be a raw event/log stimulus. + (when (getf signal :reply-stream) + (dispatch-action signal signal))))) (setf (getf signal :status) :acted) feedback)) diff --git a/src/communication.lisp b/src/communication.lisp index f99c69b..88b59c8 100644 --- a/src/communication.lisp +++ b/src/communication.lisp @@ -67,10 +67,15 @@ :capabilities '(:auth :swank :org-ast)))) (defun read-framed-message (stream) - "Reads a hex-length prefixed message from the stream securely." + "Reads a hex-length prefixed message from the stream securely. Skips leading whitespace." (let ((length-buffer (make-string 6))) (handler-case (progn + ;; 0. Skip leading whitespace (newlines, spaces, etc.) + (loop for char = (peek-char nil stream nil :eof) + while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return))) + do (read-char stream)) + ;; 1. Read the 6-char hex length (let ((count (read-sequence length-buffer stream))) (when (< count 6) (return-from read-framed-message :eof)) diff --git a/src/loop.lisp b/src/loop.lisp index 4853733..0132c98 100644 --- a/src/loop.lisp +++ b/src/loop.lisp @@ -15,10 +15,16 @@ (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil)) (return nil)) (handler-case - (progn + (let ((parent-metadata (list :reply-stream (getf current-signal :reply-stream) + :foveal-focus (getf current-signal :foveal-focus)))) (setf current-signal (perceive-gate current-signal)) (setf current-signal (reason-gate current-signal)) - (setf current-signal (act-gate current-signal))) + (setf current-signal (act-gate current-signal)) + ;; Inherit metadata for the next metabolic cycle if feedback was generated. + (when (and current-signal (not (getf current-signal :reply-stream))) + (setf (getf current-signal :reply-stream) (getf parent-metadata :reply-stream))) + (when (and current-signal (not (getf current-signal :foveal-focus))) + (setf (getf current-signal :foveal-focus) (getf parent-metadata :foveal-focus)))) (error (c) (let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor)))) (harness-log "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c) diff --git a/src/reason.lisp b/src/reason.lisp index 306bcc5..5986727 100644 --- a/src/reason.lisp +++ b/src/reason.lisp @@ -20,10 +20,12 @@ (result (if model (funcall backend-fn prompt system-prompt :model model) (funcall backend-fn prompt system-prompt)))) - ;; If the result is valid and doesn't contain a failure log, return it. - (unless (or (null result) - (and (stringp result) (search ":LOG" result))) - (return result)))))) + ;; If the result is valid, return it. + ;; If it is an error plist from the gateway, continue the cascade but log it. + (cond ((and (listp result) (eq (getf result :status) :success)) + (return (getf result :content))) + ((stringp result) (return result)) + (t (harness-log "PROBABILISTIC: Backend ~a failed: ~a" backend (getf result :message)))))))) ;; Final fallback if all backends in the cascade fail. (list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted."))))) @@ -64,11 +66,16 @@ (let ((trigger (skill-trigger-fn skill)) (gate (skill-deterministic-fn skill))) (when (or (null trigger) (ignore-errors (funcall trigger context))) - (setf current-action (funcall gate current-action context)) - ;; If any gate returns a LOG or EVENT, it has intercepted the action. - (when (and (listp current-action) (member (getf current-action :type) '(:LOG :EVENT :log :event))) - (harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill)) - (return-from deterministic-verify current-action))))) + (let ((next-action (funcall gate current-action context))) + ;; Interception occurs if the gate returns a signal (LOG/EVENT) AND either: + ;; 1. The original action was NOT a signal (e.g. it was a REQUEST). + ;; 2. The gate returned a DIFFERENT signal than it was given. + (when (and (listp next-action) + (member (getf next-action :type) '(:LOG :EVENT :log :event)) + (not (eq next-action current-action))) + (harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill)) + (return-from deterministic-verify next-action)) + (setf current-action next-action))))) current-action)) (defun reason-gate (signal) diff --git a/test-events.lisp b/test-events.lisp new file mode 100644 index 0000000..84ecdce --- /dev/null +++ b/test-events.lisp @@ -0,0 +1,23 @@ +(require :asdf) +(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname))) +(ql:quickload :croatoan) +(in-package :cl-user) +(defun main () + (with-open-file (f "event2.log" :direction :output :if-exists :supersede) + (croatoan:with-screen (scr :input-echoing nil :input-blocking nil) + (let* ((h (croatoan:height scr)) + (w (croatoan:width scr)) + (input-win (make-instance 'croatoan:window :height 1 :width w :position (list (- h 1) 0)))) + (setf (croatoan:function-keys-enabled-p input-win) t) + (setf (croatoan:input-blocking input-win) nil) + (loop + (let* ((event (croatoan:get-wide-event input-win)) + (ch (and event (typep event 'croatoan:event) (croatoan:event-key event)))) + (when ch + (format f "Got: ~S (type: ~S)~%" ch (type-of ch)) + (finish-output f) + (when (or (eq ch #\q) (eq ch :q)) + (return)))) + (sleep 0.05)))))) +(main) +(sb-ext:exit) diff --git a/test-input.lisp b/test-input.lisp new file mode 100644 index 0000000..afaff6f --- /dev/null +++ b/test-input.lisp @@ -0,0 +1,27 @@ +(require :asdf) +(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname))) +(ql:quickload :croatoan) +(in-package :cl-user) +(defun main () + (with-open-file (f "test-input.log" :direction :output :if-exists :supersede) + (format f "Starting...~%") + (finish-output f) + (croatoan:with-screen (scr :input-echoing nil :input-blocking nil :cursor-visible t) + (let* ((h (croatoan:height scr)) + (w (croatoan:width scr)) + (input-win (make-instance 'croatoan:window :height 1 :width w :position (list (- h 1) 0))) + (buf (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))) + (setf (croatoan:input-blocking input-win) nil) + (loop + (let ((ch (croatoan:get-char input-win))) + (when ch + (format f "Got: ~S~%" ch) + (finish-output f) + (return))) + (croatoan:clear input-win) + (croatoan:add-string input-win (concatenate 'string "> " (coerce buf 'string))) + (croatoan:move input-win 0 (+ 2 (length buf))) + (croatoan:refresh input-win) + (sleep 0.05)))))) +(main) +(sb-ext:exit) diff --git a/test-keys.lisp b/test-keys.lisp new file mode 100644 index 0000000..52a5a14 --- /dev/null +++ b/test-keys.lisp @@ -0,0 +1,22 @@ +(require :asdf) +(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname))) +(ql:quickload :croatoan) +(in-package :cl-user) +(defun main () + (with-open-file (f "key.log" :direction :output :if-exists :supersede) + (croatoan:with-screen (scr :input-echoing nil :input-blocking nil) + (let* ((h (croatoan:height scr)) + (w (croatoan:width scr)) + (input-win (make-instance 'croatoan:window :height 1 :width w :position (list (- h 1) 0)))) + (setf (croatoan:function-keys-enabled-p input-win) t) + (setf (croatoan:input-blocking input-win) nil) + (loop + (let ((ch (croatoan:get-char input-win))) + (when ch + (format f "Got: ~S (type: ~S) (code: ~S)~%" ch (type-of ch) (and (characterp ch) (char-code ch))) + (finish-output f) + (when (or (eq ch #\q) (eq ch :q)) + (return)))) + (sleep 0.05)))))) +(main) +(sb-ext:exit) diff --git a/test-output.txt b/test-output.txt new file mode 100644 index 0000000..ecf259c --- /dev/null +++ b/test-output.txt @@ -0,0 +1,5 @@ +To load "croatoan": + Load 1 ASDF system: + croatoan +; Loading "croatoan" +................ \ No newline at end of file