Running source

Generated from the files loaded by the live image. Click definitions to inspect their bodies.

1(require :asdf)2(require :sb-bsd-sockets)3(require :sb-posix)45(defpackage #:lisp-raindesk (:use #:cl))6(in-package #:lisp-raindesk)78(defparameter *port* (parse-integer (or (uiop:getenv "PORT") "8098")))9(defparameter *started-at* (get-universal-time))10(defparameter *request-count* 0)11(defparameter *next-request-id* 0)12(defparameter *tick* 0)13(defparameter *worker-states* (make-hash-table))14(defparameter *state-lock* (sb-thread:make-mutex :name "runtime-state"))15(defparameter *event-lock* (sb-thread:make-mutex :name "event-log"))16(defparameter *event-waitqueue* (sb-thread:make-waitqueue :name "event-stream"))17(defparameter *events* nil)18(defparameter *next-event-id* 0)19(defparameter *event-limit* 500)20(defparameter *peer-urls* nil)21(defparameter *peer-observations* (make-hash-table :test #'equal))22(defparameter *evaluation-runs* nil)23(defparameter *crdt-counters* (make-hash-table :test #'equal))24(defparameter *queue-messages* (make-hash-table :test #'equal))25(defparameter *queue-next-id* 0)26(defparameter *queue-lease-seconds* (parse-integer (or (uiop:getenv "QUEUE_LEASE_SECONDS") "30")))27(defparameter *queue-journal* (pathname (or (uiop:getenv "QUEUE_JOURNAL")28                                            (namestring (merge-pathnames "queue.journal" (uiop:getcwd))))))29(defparameter *memory-signature* nil)30(defvar *app-path* (merge-pathnames "app.lisp" (uiop:getcwd)))31(defvar *reload-lock* (sb-thread:make-mutex :name "code-reload"))32(defvar *reload-count* 0)33(defvar *reload-history* nil)34(defvar *watcher-status* "starting")35(defvar *request-body* "")36(defvar *request-id* 0)3738(defstruct (event (:constructor make-event (id type data))) id type data)39(defstruct (evaluation-run (:constructor make-evaluation-run (id candidate score confidence evidence uncertainty)))40  id candidate score confidence evidence uncertainty)41(defstruct (queue-message (:constructor make-queue-message (id body state attempts available-at lease-until consumer)))42  id body state attempts available-at lease-until consumer)43(defstruct (http-request (:constructor make-http-request (method target path last-id token body)))44  method target path last-id token body)4546(defmacro with-state (() &body body) `(sb-thread:with-mutex (*state-lock*) ,@body))4748(defun json-escape (value)49  (with-output-to-string (out)50    (loop for char across (princ-to-string value)51          do (write-string52              (case char (#\" "\\\"") (#\\ "\\\\") (#\Newline "\\n") (t (string char))) out))))5354(defun function-object-address (name)55  (let ((function (and (fboundp name) (symbol-function name))))56    (when function57      (format nil "0x~X" (sb-kernel:get-lisp-obj-address function)))))5859(defun proc-file (path &optional (limit 12000))60  (when (probe-file path)61    (with-open-file (in path :direction :input)62      (with-output-to-string (out)63        (loop with total = 064              for line = (read-line in nil)65              while (and line (< total limit))66              do (format out "~A~%" line) (incf total (length line)))))))6768(defun memory-summary ()69  (let ((text (or (proc-file "/proc/self/maps") "")))70    (values text (count #\Newline text))))7172(defun emit-event (type data)73  (sb-thread:with-mutex (*event-lock*)74    (let ((item (make-event (incf *next-event-id*) type data)))75      (push item *events*)76      (when (> (length *events*) *event-limit*) (setf *events* (butlast *events*)))77      (sb-thread:condition-notify *event-waitqueue*)78      item)))7980(defun record-evaluation-run (candidate score confidence evidence uncertainty)81  (with-state ()82    (let ((run (make-evaluation-run (1+ (length *evaluation-runs*)) candidate score confidence evidence uncertainty)))83      (push run *evaluation-runs*)84      (when (> (length *evaluation-runs*) 100) (setf *evaluation-runs* (butlast *evaluation-runs*)))85      (emit-event "moat.evaluation.recorded"86                  (format nil "{\"id\":~D,\"candidate\":\"~A\",\"score\":~A,\"confidence\":~A,\"evidence\":\"~A\",\"uncertainty\":\"~A\"}"87                          (evaluation-run-id run) (json-escape candidate)88                          (or score "null") (or confidence "null")89                          (json-escape evidence) (json-escape uncertainty)))90      run)))9192(defun evaluation-runs-json ()93  (with-state ()94    (with-output-to-string (out)95      (write-string "[" out)96      (loop for run in (reverse *evaluation-runs*) for first = t then nil97            do (unless first (write-string "," out))98               (format out "{\"id\":~D,\"candidate\":\"~A\",\"score\":~A,\"confidence\":~A,\"evidence\":\"~A\",\"uncertainty\":\"~A\"}"99                       (evaluation-run-id run) (json-escape (evaluation-run-candidate run))100                       (or (evaluation-run-score run) "null") (or (evaluation-run-confidence run) "null")101                       (json-escape (evaluation-run-evidence run)) (json-escape (evaluation-run-uncertainty run))))102      (write-string "]" out))))103104(defun event-list-after (last-id)105  (sort (remove-if-not (lambda (item) (> (event-id item) last-id)) (copy-list *events*)) #'< :key #'event-id))106107(defun snapshot-json ()108  (with-state ()109    (with-output-to-string (out)110      (format out "{\"pid\":~D,\"port\":~D,\"requests\":~D,\"request_id\":~D,\"tick\":~D,\"reloads\":~D,\"workers\":["111              (sb-posix:getpid) *port* *request-count* *next-request-id* *tick* *reload-count*)112      (loop for name being the hash-keys of *worker-states* using (hash-value state)113            for first = t then nil114            do (unless first (write-string "," out))115               (format out "{\"name\":\"~A\",\"status\":\"~A\",\"tick\":~D}"116                       name (getf state :status) (getf state :tick)))117      (write-string "]}" out))))118119(defun worker-loop (name delay)120  (loop121    (sleep delay)122    (with-state ()123      (incf *tick*)124      (setf (gethash name *worker-states*)125            (list :status "running" :tick *tick* :heartbeat (get-universal-time))))126    (emit-event "worker.heartbeat"127                (format nil "{\"name\":\"~A\",\"tick\":~D}" name *tick*))))128129(defun configured-peers ()130  (remove-if #'uiop:emptyp131             (mapcar (lambda (x) (string-trim '(#\Space #\Tab) x))132                     (uiop:split-string (or (uiop:getenv "PEERS") "") :separator ","))))133134(defun peer-hello-json ()135  (format nil "{\"node\":\"~A\",\"pid\":~D,\"port\":~D,\"protocol\":\"lisp-raindesk/1\",\"capabilities\":[\"events\",\"source\",\"state\"]}"136          (json-escape (or (uiop:getenv "NODE_ID") (format nil "pid-~D" (sb-posix:getpid))))137          (sb-posix:getpid) *port*))138139(defun local-node-id ()140  (or (uiop:getenv "NODE_ID") (format nil "pid-~D" (sb-posix:getpid))))141(defun crdt-local-counter () (gethash (local-node-id) *crdt-counters* 0))142(defun crdt-total () (loop for value being the hash-values of *crdt-counters* sum value))143(defun crdt-json ()144  (with-state ()145    (with-output-to-string (out)146      (format out "{\"node\":\"~A\",\"counter\":~D,\"total\":~D,\"components\":{"147              (json-escape (local-node-id)) (crdt-local-counter) (crdt-total))148      (loop for key being the hash-keys of *crdt-counters* using (hash-value value)149            for first = t then nil150            do (unless first (write-string "," out))151               (format out "\"~A\":~D" (json-escape key) value))152      (write-string "}}" out))))153(defun crdt-increment ()154  (with-state () (incf (gethash (local-node-id) *crdt-counters* 0)))155  (emit-event "crdt.local.incremented" (crdt-json))156  (crdt-json))157(defun json-string-field (json key)158  (let* ((needle (format nil "\"~A\":\"" key)) (start (and json (search needle json))))159    (when start160      (let* ((begin (+ start (length needle))) (end (position #\" json :start begin)))161        (and end (subseq json begin end))))))162(defun json-integer-field (json key)163  (let* ((needle (format nil "\"~A\":" key)) (start (and json (search needle json))))164    (when start165      (ignore-errors (parse-integer json :start (+ start (length needle)) :junk-allowed t)))))166(defun crdt-merge-response (json)167  (let ((node (json-string-field json "node")) (counter (json-integer-field json "counter")))168    (when (and node counter)169      (with-state ()170        (when (> counter (gethash node *crdt-counters* 0))171          (setf (gethash node *crdt-counters*) counter)172          (emit-event "crdt.merged" (crdt-json)))))))173174;;; Minimal outbound HTTP: peers use the same Lisp socket vocabulary as the175;;; listener. Plain HTTP and one response per connection are intentional: this176;;; is the small protocol substrate, not a hidden client framework.177(defun peer-url-parts (url)178  (let* ((prefix "http://")179         (start (and (uiop:string-prefix-p prefix url) (length prefix)))180         (slash (and start (position #\/ url :start start)))181         (authority (and start (subseq url start (or slash (length url)))))182         (colon (and authority (position #\: authority :from-end t)))183         (host (if colon (subseq authority 0 colon) authority))184         (port (if colon (parse-integer authority :start (1+ colon)) 80))185         (path (if slash (subseq url slash) "/")))186    (when (and (plusp (length host)) (<= 1 port 65535))187      (list host port path))))188(defun http-get (url)189  (destructuring-bind (host port path) (or (peer-url-parts url) (error "unsupported peer URL: ~A" url))190    (let* ((address (sb-bsd-sockets:host-ent-address (sb-bsd-sockets:get-host-by-name host)))191           (socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp)))192      (unwind-protect193           (progn194             (sb-bsd-sockets:socket-connect socket address port)195             (let ((stream (sb-bsd-sockets:socket-make-stream socket :input t :output t196                                                               :element-type 'character :buffering :none)))197               (unwind-protect198                    (progn199                      (format stream "GET ~A HTTP/1.1~C~CHost: ~A~C~CConnection: close~C~C~C~C"200                              path #\Return #\Linefeed host #\Return #\Linefeed201                              #\Return #\Linefeed #\Return #\Linefeed)202                      (finish-output stream)203                      (let ((status (read-line stream nil "")))204                        (unless (search " 2" status) (error "peer ~A returned ~A" url status))205                        (loop for line = (read-line stream nil)206                              until (or (null line) (string= line "") (string= line "\r")))207                        (with-output-to-string (body)208                          (loop for char = (read-char stream nil)209                                while char do (write-char char body)))))210                 (close stream))))211        (sb-bsd-sockets:socket-close socket :abort t)))))212213;;; Reliable queue: an append-only journal plus leases gives at-least-once214;;; delivery.  ACK is a separate durable transition; an expired lease returns215;;; a message to ready, so a crashed consumer can be retried.216(defun queue-record (message)217  (with-open-file (out *queue-journal* :direction :output :if-exists :append :if-does-not-exist :create)218    (format out "~S~%" (list (queue-message-id message) (queue-message-body message)219                              (queue-message-state message) (queue-message-attempts message)220                              (queue-message-available-at message) (queue-message-lease-until message)221                              (queue-message-consumer message)))))222(defun queue-load ()223  (when (probe-file *queue-journal*)224    (with-open-file (in *queue-journal*)225      (loop for record = (ignore-errors (read in nil nil)) while record226            do (destructuring-bind (id body state attempts available-at lease-until consumer) record227                 (setf (gethash id *queue-messages*)228                       (make-queue-message id body state attempts available-at lease-until consumer))229                 (setf *queue-next-id* (max *queue-next-id* (or (ignore-errors (parse-integer id :start 4)) 0))))))))230(defun queue-json (&optional message)231  (if message232      (format nil "{\"id\":\"~A\",\"body\":\"~A\",\"state\":\"~A\",\"attempts\":~D,\"consumer\":\"~A\"}"233              (json-escape (queue-message-id message)) (json-escape (queue-message-body message))234              (queue-message-state message) (queue-message-attempts message)235              (json-escape (or (queue-message-consumer message) "")))236      (let ((counts (make-hash-table)))237        (maphash (lambda (id item) (declare (ignore id))238                   (incf (gethash (queue-message-state item) counts 0))) *queue-messages*)239        (format nil "{\"technology\":\"append-only journal + lease/ACK\",\"messages\":~D,\"ready\":~D,\"leased\":~D,\"acked\":~D}"240                (hash-table-count *queue-messages*) (gethash :ready counts 0)241                (gethash :leased counts 0) (gethash :acked counts 0)))))242(defun queue-publish (body)243  (with-state ()244    (let* ((id (format nil "msg-~D" (incf *queue-next-id*)))245           (message (make-queue-message id body :ready 0 (get-universal-time) 0 nil)))246      (setf (gethash id *queue-messages*) message) (queue-record message)247      (emit-event "queue.published" (queue-json message)) message)))248(defun queue-poll (&optional (consumer (local-node-id)))249  (with-state ()250    (let ((now (get-universal-time)))251      (loop for message being the hash-values of *queue-messages*252            when (and (member (queue-message-state message) '(:ready :leased))253                      (or (eq (queue-message-state message) :ready)254                          (<= (queue-message-lease-until message) now)))255              do (setf (queue-message-state message) :leased256                       (queue-message-attempts message) (1+ (queue-message-attempts message))257                       (queue-message-lease-until message) (+ now *queue-lease-seconds*)258                       (queue-message-consumer message) consumer)259                 (queue-record message)260                 (emit-event "queue.leased" (queue-json message))261                 (return message)))))262(defun queue-ack (id)263  (with-state ()264    (let ((message (gethash id *queue-messages*)))265      (when (and message (eq (queue-message-state message) :leased))266        (setf (queue-message-state message) :acked)267        (queue-record message)268        (emit-event "queue.acked" (queue-json message)))269      message)))270271(defun peer-loop ()272  (loop273    (sleep 15)274    (dolist (peer *peer-urls*)275      (handler-case276          (progn277            (http-get (format nil "~A/network/hello" peer))278            (setf (gethash peer *peer-observations*)279                  (list :url peer :status "reachable" :time (get-universal-time)))280            (emit-event "network.peer.probed"281                        (format nil "{\"peer\":\"~A\",\"status\":\"reachable\"}" (json-escape peer)))282            (crdt-merge-response (http-get (format nil "~A/network/crdt" peer))))283        (error (condition)284          (declare (ignore condition))285          (setf (gethash peer *peer-observations*)286                (list :url peer :status "unreachable" :time (get-universal-time)))287          (emit-event "network.peer.probed"288                      (format nil "{\"peer\":\"~A\",\"status\":\"unreachable\"}" (json-escape peer))))))))289290(defun start-workers ()291  (dolist (spec '((:reader . 2) (:sampler . 3) (:renderer . 5)))292    (let ((name (car spec)) (delay (cdr spec)))293      (setf (gethash name *worker-states*) (list :status "starting" :tick 0))294      (sb-thread:make-thread (lambda () (worker-loop name delay)) :name (format nil "worker/~A" name)))))295296(defun sampler-loop ()297  (loop298    (sleep 3)299    (multiple-value-bind (text lines) (memory-summary)300      (let ((signature (sxhash text)))301        (unless (eql signature *memory-signature*)302          (setf *memory-signature* signature)303          (emit-event "memory.changed"304                      (format nil "{\"segments\":~D,\"bytes\":~D,\"signature\":~D}"305                              lines (length text) signature)))))))306307#| Historical pre-reload presentation; retained only as migration evidence.308(defun legacy-page ()309  (with-output-to-string (out)310    (write-string "<!doctype html><html><head><meta charset='utf-8'><meta name='viewport' content='width=device-width,initial-scale=1'><title>Lisp / Raindesk</title>" out)311    (write-string "<style>body{background:#10121a;color:#e8e4d8;font:14px ui-monospace,monospace;margin:2rem}main{max-width:1180px;margin:auto}h1{color:#f3b562}.grid{display:grid;grid-template-columns:repeat(auto-fit,minmax(300px,1fr));gap:1rem}section{border:1px solid #4d5366;margin:1rem 0;padding:1rem;background:#171a24}button{background:#252b3a;color:#e8e4d8;border:1px solid #69728a;padding:.45rem .7rem;cursor:pointer}button:hover{border-color:#f3b562}.label{color:#8ecae6}.ok{color:#9ee493}.warn{color:#f3b562}.bad{color:#f27676}pre{white-space:pre-wrap;overflow:auto;color:#9ee493;max-height:330px}table{width:100%;border-collapse:collapse}td,th{text-align:left;padding:.35rem;border-bottom:1px solid #303647;font-size:.8rem}.bar{height:100px;display:flex;align-items:end;gap:2px;border-bottom:1px solid #69728a}.bar i{display:block;background:#8ecae6;min-width:4px;flex:1}.minimap{height:28px;display:flex;background:#0b0d12;overflow:hidden}.minimap i{height:100%;background:#9ee493;border-right:1px solid #10121a;flex:1}.status{float:right}</style></head><body><main>" out)312    (format out "<p class='label'>;; live differential runtime · PID ~D · port ~D <span id='connection' class='status warn'>connecting</span></p><h1>(lisp-raindesk)</h1><p class='label'><span id='app-label'>~A</span> · reloads: <span id='reload-count'>~D</span> · file watcher: <span id='watcher'>~A</span> · <a href='/source'>read the running source</a></p>" (sb-posix:getpid) *port* (app-label) *reload-count* *watcher-status*)313    (write-string "<section><b>Runtime state</b><div class='grid'><p>requests: <button id='request-count'>0</button></p><p>scheduler tick: <span id='tick'>0</span></p><p>event stream: <span id='event-id'>0</span></p></div></section>" out)314    (write-string "<div class='grid'><section><b>Workers</b><pre id='workers'>waiting for stream…</pre></section><section><b>Memory minimap</b><div id='minimap' class='minimap'></div><p id='memory-summary' class='label'>waiting for memory diff…</p><button id='memory-detail'>open raw memory map</button></section></div>" out)315    (write-string "<section><b>Requests over time</b><div id='histogram' class='bar'></div><p class='label'>Each bar is a one-second bucket. Click a request below for details.</p><table><thead><tr><th>time</th><th>route</th><th>status</th><th>worker</th><th>duration</th></tr></thead><tbody id='requests'></tbody></table></section>" out)316    (format out "<section><b>Selected detail</b><pre id='detail'>Select a request or memory marker.</pre></section><section><b>Literate runtime</b><p>This page is composed by Lisp, and its reloadable application layer is visible in the running image. The source view is the program explaining itself.</p><pre id='source-note'>(load app.lisp) → redefine page behavior → preserve event log and worker state</pre></section><section><b>Assumption ledger</b><p class='label'>Every important expression depends on a world. These are the worlds this program currently believes in.</p>~A</section><footer><a href='/state'>snapshot</a> · <a href='/memory'>raw memory</a> · <a href='/stack'>backtrace</a> · <a href='/source'>source</a> · <a href='/assumptions'>assumptions</a> · <a href='/events'>event stream</a></footer>" (assumptions-html))317    (write-string "<script>(function(){const model={requests:[],buckets:{},workers:{},memory:{},last:0};const $=id=>document.getElementById(id);function text(v){return String(v??'').replace(/[&<>]/g,c=>({'&':'&amp;','<':'&lt;','>':'&gt;'}[c]))}function render(){ $('request-count').textContent=model.requests.length+' recent';$('tick').textContent=model.tick||0;$('event-id').textContent=model.last; $('workers').textContent=Object.entries(model.workers).map(([n,w])=>n+'  '+w.status+'  tick='+w.tick).join('\\n')||'waiting'; $('requests').innerHTML=model.requests.slice().reverse().map((r,i)=>'<tr data-i='+i+'><td>'+text(r.time)+'</td><td>'+text(r.route)+'</td><td>'+text(r.status)+'</td><td>'+text(r.worker)+'</td><td>'+text(r.duration_ms)+' ms</td></tr>').join('');const vals=Object.values(model.buckets);const max=Math.max(1,...vals);$('histogram').innerHTML=vals.slice(-60).map(v=>'<i style=height:'+Math.max(4,Math.round(v/max*100))+'% title='+v+'></i>').join('');$('minimap').innerHTML=Array.from({length:Math.min(120,Math.max(8,model.memory.segments||8))},()=>'<i></i>').join('');$('memory-summary').textContent=model.memory.segments?(model.memory.segments+' segments · '+model.memory.bytes+' bytes · differential updates'):'waiting for memory diff…'}function apply(e){model.last=Math.max(model.last,+e.lastEventId||0);let d;try{d=JSON.parse(e.data)}catch(_){return}if(e.type==='snapshot'){model.tick=d.tick;Object.assign(model.workers,d.workers||{})}if(e.type==='request.completed'){model.requests.push(d);if(model.requests.length>100)model.requests.shift();const b=Math.floor(Date.now()/1000);model.buckets[b]=(model.buckets[b]||0)+1}if(e.type==='worker.heartbeat'){model.workers[d.name]=d;model.tick=d.tick}if(e.type==='memory.changed')model.memory=d;if(e.type==='code.reloaded'){document.getElementById('app-label').textContent=d.label;document.getElementById('reload-count').textContent=d.count;document.getElementById('watcher').textContent='watching'}if(e.type==='code.reload.failed')document.getElementById('watcher').textContent='reload failed';render()}$('requests').onclick=e=>{const row=e.target.closest('tr');if(row)document.getElementById('detail').textContent=JSON.stringify(model.requests.slice().reverse()[row.dataset.i],null,2)};const es=new EventSource('/events');es.onopen=()=>{document.getElementById('connection').textContent='live';document.getElementById('connection').className='status ok'};es.onerror=()=>{document.getElementById('connection').textContent='reconnecting';document.getElementById('connection').className='status warn'};['snapshot','request.completed','worker.heartbeat','memory.changed','code.reloaded','code.reload.failed'].forEach(k=>es.addEventListener(k,apply));render()})()</script></main></body></html>" out)))318319|#320321(defun response (body &optional (status "200 OK") (type "text/html; charset=utf-8"))322  (format nil "HTTP/1.1 ~A~%Content-Type: ~A~%Content-Length: ~D~%Connection: close~%~%~A" status type (length body) body))323324;; The presentation boundary supplies the real dispatcher when app.lisp loads.325;; Fail closed if a request arrives before that boundary is present.326(defun dispatch (path &optional body)327  (declare (ignore path body))328  (error "presentation boundary is not loaded"))329330(defun reload-preflight ()331  ;; The source projection is bounded for HTML responses; preflight must not332  ;; inherit that presentation limit or a larger valid app becomes invalid.333  (let ((source (or (proc-file (namestring *app-path*) 200000) "")))334    (loop for form in '("(defun dispatch" "(defun app-label" "(defun page")335          always (search form source))))336337(defun reload-app ()338  (sb-thread:with-mutex (*reload-lock*)339    (emit-event "code.reload.preflight"340                (format nil "{\"ok\":~A,\"file\":\"~A\"}"341                        (if (reload-preflight) "true" "false")342                        (json-escape (namestring *app-path*))))343    (if (not (reload-preflight))344        (progn345          (emit-event "code.reload.failed" "{\"phase\":\"preflight\",\"error\":\"required presentation definitions are missing\"}")346          (values nil "reload rejected by preflight"))347        (handler-case348            (let* ((fasl "/tmp/lisp-raindesk-app.fasl")349               (compiled (compile-file *app-path* :output-file fasl)))350              (load compiled)351              (incf *reload-count*)352              (push (list :time (get-universal-time) :file (namestring *app-path*) :status "succeeded") *reload-history*)353              (emit-event "code.reloaded"354                          (format nil "{\"count\":~D,\"label\":\"~A\"}" *reload-count* (json-escape (app-label))))355              (values t (format nil "reloaded ~A" (app-label))))356          (error (condition)357            (push (list :time (get-universal-time) :file (namestring *app-path*) :status "failed") *reload-history*)358            (emit-event "code.reload.failed" (format nil "{\"phase\":\"compile-or-load\",\"error\":\"~A\"}" (json-escape condition)))359            (values nil (format nil "reload failed: ~A" condition)))))))360361(defun header-value (line)362  (let ((colon (position #\: line)))363    (when colon364      (cons (string-downcase (string-trim '(#\Space #\Tab) (subseq line 0 colon)))365            (string-trim '(#\Space #\Tab #\Return #\Linefeed) (subseq line (1+ colon)))))))366367(defun parse-request (stream)368  (let* ((first (read-line stream nil))369         (parts (and first (uiop:split-string first)))370         (method (or (first parts) "GET"))371         (target (or (second parts) "/"))372         (headers nil))373    (loop for line = (read-line stream nil)374          while (and line (plusp (length (string-trim '(#\Return #\Linefeed #\Space #\Tab) line))))375          for header = (header-value line)376          when header do (push header headers)377          finally378             (let* ((last-id (or (ignore-errors (parse-integer (or (cdr (assoc "last-event-id" headers :test #'string=)) ""))) 0))379                    (token (cdr (assoc "x-reload-token" headers :test #'string=)))380                    (requested-length (or (ignore-errors (parse-integer (or (cdr (assoc "content-length" headers :test #'string=)) ""))) 0))381                    (content-length (min (max requested-length 0) (* 1024 1024)))382                    (body (make-string content-length)))383               (when (plusp content-length) (read-sequence body stream))384               (return (make-http-request method target385                                          (subseq target 0 (or (position #\? target) (length target)))386                                          last-id token body))))))387388(defun send-event (stream item)389  (format stream "id: ~D~%event: ~A~%data: ~A~%~%" (event-id item) (event-type item) (event-data item))390  (finish-output stream))391392(defun serve-events (stream last-id)393  (write-string "HTTP/1.1 200 OK\r\nContent-Type: text/event-stream\r\nCache-Control: no-cache\r\nConnection: keep-alive\r\n\r\n" stream)394  (finish-output stream)395  (send-event stream (make-event 0 "snapshot" (snapshot-json)))396  (loop for cycles below 240397        do (let ((items nil))398             (sb-thread:with-mutex (*event-lock*)399               (setf items (event-list-after last-id))400               (unless items (sb-thread:condition-wait *event-waitqueue* *event-lock* :timeout 15)))401             (if items402                 (dolist (item items) (send-event stream item))403                 (progn (write-string ": keepalive\n\n" stream) (finish-output stream)))404             (when items (setf last-id (event-id (car (last items))))))))405406#| Historical pre-reload router; app.lisp is the only active route table.407(defun legacy-dispatch (path &optional body)408  (cond ((string= path "/queue") (values (queue-json) "application/json"))409        ((string= path "/queue/publish") (values (queue-json (queue-publish (or body ""))) "application/json"))410        ((string= path "/queue/poll") (let ((message (queue-poll (or body (local-node-id)))))411                                         (values (if message (queue-json message) "null") "application/json")))412        ((string= path "/queue/ack") (let ((message (queue-ack (string-trim '(#\Space #\Tab #\Return #\Linefeed) (or body "")))))413                                       (values (if message (queue-json message) "null") "application/json")))414        ((string= path "/network/crdt") (values (crdt-json) "application/json"))415        ((string= path "/crdt/increment") (values (crdt-increment) "application/json"))416        ((string= path "/network/hello") (values (peer-hello-json) "application/json"))417        ((string= path "/network/peers")418         (values (with-output-to-string (out)419                   (write-string "[" out)420                   (loop for peer being the hash-values of *peer-observations* for first = t then nil421                         do (unless first (write-string "," out))422                            (format out "{\"url\":\"~A\",\"status\":\"~A\",\"time\":~D}"423                                    (json-escape (getf peer :url)) (getf peer :status) (getf peer :time)))424                   (write-string "]" out)) "application/json"))425        ((string= path "/network/state")426         (values (with-output-to-string (out)427                   (format out "{\"listener\":{\"address\":\"0.0.0.0\",\"port\":~D,\"transport\":\"TCP\"},\"configured_peers\":[" *port*)428                   (loop for peer in *peer-urls* for first = t then nil429                         do (unless first (write-string "," out))430                            (format out "\"~A\"" (json-escape peer)))431                   (write-string "],\"observations\":" out)432                   (multiple-value-bind (json type) (dispatch "/network/peers")433                     (declare (ignore type))434                     (write-string json out))435                   (write-string ",\"note\":\"observed server facts; no packet capture\"}" out)) "application/json"))436        ((string= path "/state") (values (snapshot-json) "application/json"))437        ((string= path "/memory") (values (or (proc-file "/proc/self/maps") "unavailable") "text/plain"))438        ((string= path "/source") (values (source-text) "text/plain; charset=utf-8"))439        ((string= path "/assumptions") (values (assumptions-text) "text/plain; charset=utf-8"))440        ((string= path "/stack") (values (with-output-to-string (out) (format out "SBCL backtrace requested at tick ~D~%" *tick*) (dolist (frame (sb-debug:backtrace-as-list)) (format out "~S~%" frame))) "text/plain"))441        (t (values (page) "text/html; charset=utf-8"))))442443|#444445(defun serve-normal-request (stream path request-id body)446  (let ((started (get-internal-real-time)))447    (emit-event "request.started"448                (format nil "{\"request_id\":~D,\"route\":\"~A\",\"worker\":\"~A\"}"449                        request-id (json-escape path) (sb-thread:thread-name sb-thread:*current-thread*)))450    (let ((*request-body* body) (*request-id* request-id))451      (emit-event "network.request.parsed"452                  (format nil "{\"request_id\":~D,\"route\":\"~A\",\"body_bytes\":~D}" request-id (json-escape path) (length body)))453      (multiple-value-bind (payload type) (dispatch path body)454        (write-string (response payload "200 OK" type) stream)455        (emit-event "network.response.written"456                    (format nil "{\"request_id\":~D,\"route\":\"~A\",\"response_bytes\":~D}" request-id (json-escape path) (length payload)))457        (emit-event "request.completed"458                    (format nil "{\"time\":\"~D\",\"request_id\":~D,\"route\":\"~A\",\"status\":200,\"worker\":\"~A\",\"duration_ms\":~,2F}"459                            (get-universal-time) request-id (json-escape path)460                            (sb-thread:thread-name sb-thread:*current-thread*)461                            (* 1000 (/ (- (get-internal-real-time) started) internal-time-units-per-second))))))))462463(defun app-watcher-loop ()464  (let ((last-write (file-write-date *app-path*)))465    (setf *watcher-status* "watching")466    (loop467      (sleep 2)468      (let ((current-write (file-write-date *app-path*)))469        (when (> current-write last-write)470          (setf last-write current-write471                *watcher-status* "reloading")472          (reload-app)473          (setf *watcher-status* "watching"))))))474475(defun handle-client (socket)476  (unwind-protect477       (handler-case478           (let ((stream (sb-bsd-sockets:socket-make-stream socket :input t :output t :element-type 'character :buffering :none)))479             (let ((request (parse-request stream)))480               (let ((path (http-request-path request))481                     (method (http-request-method request))482                     (last-id (http-request-last-id request))483                     (token (http-request-token request))484                     (body (http-request-body request)))485               (let ((request-id (with-state () (incf *next-request-id*) (incf *request-count*) *next-request-id*)))486                 (if (string= path "/events")487                     (serve-events stream last-id)488                     (progn489                       (if (and (member path '("/queue/publish" "/queue/poll" "/queue/ack") :test #'string=)490                                (not (string= method "POST")))491                           (write-string (response "queue routes require POST" "405 Method Not Allowed" "text/plain") stream)492                           (if (member path '("/reload" "/queue/publish" "/queue/poll" "/queue/ack") :test #'string=)493                           (if (and (uiop:getenv "RELOAD_TOKEN") (string= token (uiop:getenv "RELOAD_TOKEN")))494                               (if (string= path "/reload")495                                   (multiple-value-bind (ok message) (reload-app)496                                     (write-string (response message (if ok "200 OK" "500 Internal Server Error") "text/plain") stream))497                                   (serve-normal-request stream path request-id body))498                               (write-string (response "operator token required" "403 Forbidden" "text/plain") stream))499                           (serve-normal-request stream path request-id body)))500                       (finish-output stream)501                       (emit-event "network.connection.closed"502                                   (format nil "{\"request_id\":~D,\"route\":\"~A\"}" request-id (json-escape path)))))))))503         (sb-int:broken-pipe () nil)504         (error (condition)505           (declare (ignore condition))506           ;; Client disconnects are ordinary network events, never debugger input.507           nil))508    ;; Abort the stream close: a client may have gone away while buffered509    ;; response bytes were pending. Closing normally can flush and re-signal510    ;; the broken pipe outside the request handler.511    (sb-bsd-sockets:socket-close socket :abort t)))512513(defun start ()514  (load (merge-pathnames "ai.lisp" (uiop:getcwd)))515  (load *app-path*)516  (queue-load)517  (sb-thread:make-thread #'app-watcher-loop :name "code/watcher")518  (start-workers)519  (sb-thread:make-thread #'sampler-loop :name "memory/sampler")520  (setf *peer-urls* (configured-peers))521  (when *peer-urls* (sb-thread:make-thread #'peer-loop :name "network/peers"))522  (emit-event "memory.changed" "{\"segments\":0,\"bytes\":0,\"signature\":0}")523  (record-evaluation-run "live-image-startup" "1.0000" "0.5000"524                         "listener initialized; worker threads started; app loaded"525                         "startup check is not isolated branch execution")526  (let ((server (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp)))527    (setf (sb-bsd-sockets:sockopt-reuse-address server) t)528    (sb-bsd-sockets:socket-bind server #(0 0 0 0) *port*)529    (sb-bsd-sockets:socket-listen server 32)530    (format t "lisp-raindesk listening on port ~D~%" *port*)531    (loop (let ((socket (sb-bsd-sockets:socket-accept server))) (sb-thread:make-thread (lambda () (handle-client socket)) :name "http/request")))))532533(start)

1(in-package #:lisp-raindesk)23;;; Reload-safety candidate: every presentation reload is preflighted by server.lisp.45;;; Reloadable presentation boundary.  It owns no sockets, workers, or event6;;; history: load this file to replace the UI while the image keeps running.78(defparameter *event-kinds*9  '("snapshot" "request.started" "request.completed" "worker.heartbeat"10    "memory.changed" "code.reload.preflight" "code.reloaded" "code.reload.failed"11    "ai.pipeline.started" "ai.pipeline.stage" "ai.pipeline.completed"12    "ai.expression.evaluated" "network.request.parsed"13    "network.response.written" "network.connection.closed"14    "network.peer.probed" "crdt.local.incremented" "crdt.merged"15    "queue.published" "queue.leased" "queue.acked"16    "moat.evaluation.recorded"))1718(defun app-label () "transparent app.lisp · one reloadable UI boundary")19(defun html-escape (value)20  (with-output-to-string (out)21    (loop for c across (princ-to-string value)22          do (write-string (case c (#\& "&amp;") (#\< "&lt;") (#\> "&gt;")23                                  (#\" "&quot;") (t (string c))) out))))24(defun event-kinds-js () (format nil "[~{\"~A\"~^,~}]" *event-kinds*))25(defun site-nav ()26  "<nav class='nav'><a href='/'>dashboard</a><a href='/guide'>guide</a><a href='/network'>network</a><a href='/queue'>queue</a><a href='/manifest'>manifest</a><a href='/moat'>moat</a><a href='/forest'>forest</a><a href='/source-map'>objects</a><a href='/explore'>explorer</a><a href='/memory'>memory</a><a href='/source'>source</a><a href='/events-ui'>events</a><a href='/assumptions'>assumptions</a><a href='/ai'>ai</a></nav>")27(defun document-page (title body)28  (format nil "<!doctype html><html><head><meta charset='utf-8'><meta name='viewport' content='width=device-width,initial-scale=1'><title>~A · Lisp Raindesk</title><style>body{background:#0d1018;color:#e8e4d8;font:14px ui-monospace,monospace;margin:2rem}main{max-width:1200px;margin:auto}a{color:#8ecae6}.nav{display:flex;gap:.8rem;flex-wrap:wrap;padding:.8rem 0}.nav a{border:1px solid #4d5366;padding:.3rem .5rem}.card,.file,.assumption{border:1px solid #4d5366;background:#171a24;padding:1rem;margin:1rem 0}.label{color:#8ecae6}pre{white-space:pre-wrap;overflow:auto;color:#9ee493;max-height:500px}.event{border-left:3px solid #70d6a3;background:#171a24;margin:.45rem 0;padding:.7rem}.loop{border-left-color:#8ecae6}.type{color:#f3b562}</style></head><body><main>~A~A</main></body></html>" (html-escape title) (site-nav) body))2930(defun program-assumptions ()31  '((:expression "socket + HTTP parser" :assumption "The host provides POSIX TCP streams." :because "The transport stays inspectable." :invalidated-by "Non-POSIX hosts or richer protocol requirements.")32    (:expression "event log / SSE" :assumption "Clients can reconnect from monotonic IDs." :because "The UI consumes differential updates." :invalidated-by "Bidirectional control or extreme fan-out.")33    (:expression "compile-file + load" :assumption "app.lisp is a compatible reload boundary." :because "Workers and sockets survive UI reloads." :invalidated-by "State schema changes or load-time side effects.")34    (:expression "/proc/self/maps" :assumption "Linux procfs exposes this process map." :because "Memory is observed from the running image." :invalidated-by "Other OSes or restricted procfs.")35    (:expression "AI prompt context" :assumption "Selected source, state, memory, trace, and assumptions are useful evidence." :because "The model should explain observations, not invent a runtime." :invalidated-by "Stale, oversized, or unlabelled context.")36    (:expression "generated Lisp" :assumption "Model output is untrusted input." :because "Parsing and capability inspection precede any execution." :invalidated-by "Treating static inspection as a complete proof of safety.")37    (:expression "pure subprocess" :assumption "A scrubbed, time-bounded process is an adequate first execution rung." :because "It keeps ordinary experiments outside the live image." :invalidated-by "Adversarial code, missing OS isolation, or required stateful effects.")38    (:expression "queue journal + lease/ACK" :assumption "At-least-once delivery is acceptable and duplicate handling belongs to consumers." :because "A crashed consumer can retry after its lease expires." :invalidated-by "Exactly-once requirements, concurrent journal writers, corruption, or multi-host durability.")39    (:expression "expression forecast" :assumption "Observed intervals can suggest a future evaluation." :because "Age and frequency help exploration." :invalidated-by "Irregular workloads, sparse observations, or causal changes.")))40(defun assumptions-text ()41  (with-output-to-string (out)42    (dolist (x (program-assumptions))43      (format out "~A~%  assumes: ~A~%  because: ~A~%  invalidated by: ~A~%~%"44              (getf x :expression) (getf x :assumption) (getf x :because) (getf x :invalidated-by)))))45(defun assumptions-html ()46  (with-output-to-string (out)47    (dolist (x (program-assumptions))48      (format out "<article class='assumption'><b>~A</b><p><span class='label'>assumes</span> ~A</p><p><span class='label'>because</span> ~A</p><p><span class='label'>invalidated by</span> ~A</p></article>"49              (html-escape (getf x :expression)) (html-escape (getf x :assumption))50              (html-escape (getf x :because)) (html-escape (getf x :invalidated-by))))))5152(defun memory-segments ()53  (let ((segments nil))54    (with-input-from-string (in (or (proc-file "/proc/self/maps" 60000) ""))55      (loop for line = (read-line in nil) while line56            for words = (uiop:split-string line) for range = (first words)57            when (and range (position #\- range))58              do (let* ((cut (position #\- range))59                        (start (ignore-errors (parse-integer range :end cut :radix 16)))60                        (end (ignore-errors (parse-integer range :start (1+ cut) :radix 16))))61                   (when (and start end (> end start))62                     (push (list :start start :end end :size (- end start)63                                 :permissions (or (second words) "")64                                 :source (or (nth 5 words) "anonymous")) segments)))))65    (nreverse segments)))66(defun memory-kind (segment)67  (let ((source (string-downcase (or (getf segment :source) "anonymous"))))68    (cond ((search "[heap]" source) "heap")69          ((search "[stack" source) "stack")70          ((search ".so" source) "shared library")71          ((search "[vdso]" source) "kernel view")72          ((string= source "anonymous") "anonymous")73          (t "file-backed"))))74(defun memory-groups (segments)75  (let ((totals (make-hash-table :test #'equal)))76    (dolist (segment segments totals)77      (incf (gethash (memory-kind segment) totals 0) (getf segment :size)))))78(defun memory-page ()79  (let* ((segments (memory-segments))80         (max-size (reduce #'max segments :key (lambda (x) (getf x :size)) :initial-value 1))81         (groups (memory-groups segments)))82    (with-output-to-string (out)83      (write-string "<style>.memory-map{display:flex;gap:2px;min-height:170px;align-items:stretch;background:#080a10;padding:1rem;overflow:auto}.seg{min-width:4px;border:1px solid #e8e4d8;cursor:pointer}.seg:hover{filter:brightness(1.5);transform:translateY(-4px)}.heap{background:#f3b562}.stack{background:#f27676}.shared-library{background:#8ecae6}.anonymous{background:#9ee493}.file-backed{background:#b8a1ff}.kernel-view{background:#fff}.gap{background:#303647;min-width:2px}.legend{display:flex;gap:.5rem;flex-wrap:wrap}.legend span{padding:.25rem .5rem;border:1px solid #4d5366}.metric{display:inline-block;margin:.3rem;padding:.5rem;background:#171a24;border:1px solid #4d5366}</style>" out)84      (format out "<h1>Memory map</h1><p class='label'>PID ~D · ~D virtual mappings · sampled from /proc/self/maps</p><p>This answers <b>where</b> memory is mapped, its permissions, backing, and relative size. It does not identify individual Lisp objects.</p><div class='legend'><span>heap</span><span>stack</span><span>shared library</span><span>anonymous</span><span>file-backed</span></div><section class='card'><b>Totals by interpretation</b><div>" (sb-posix:getpid) (length segments))85      (maphash (lambda (kind bytes) (format out "<span class='metric'><b>~A</b><br>~D bytes</span>" kind bytes)) groups)86      (write-string "</div></section><div class='memory-map' id='map'>" out)87      (loop with previous = 0 for s in segments for i from 088            do (when (> (getf s :start) previous) (format out "<i class='gap' title='unmapped gap'></i>"))89               (format out "<button class='seg ~A' style='flex:~D' data-detail='~A' title='~A · segment ~D'></button>"90                       (substitute #\- #\Space (memory-kind s))91                       (max 1 (ceiling (* 80 (/ (getf s :size) max-size))))92                       (html-escape (format nil "~A · 0x~X–0x~X · ~D bytes · permissions ~A · backing ~A" (memory-kind s) (getf s :start) (getf s :end) (getf s :size) (getf s :permissions) (getf s :source)))93                       (memory-kind s) i)94               (setf previous (getf s :end)))95      (format out "</div><section id='detail' class='card'><b>Select a mapping</b><p class='label'>Use the exact detail here to interpret the colored segment.</p></section><h2>Raw map</h2><pre>~A</pre><p class='label'>Confidence: addresses and permissions are observed; semantic categories are inferred from mapping names.</p><script>document.querySelectorAll('.seg').forEach((b,i)=>b.onclick=()=>document.getElementById('detail').innerHTML='<b>mapping '+i+'</b><p>'+b.dataset.detail+'</p>')</script>" (html-escape (or (proc-file "/proc/self/maps" 60000) "unavailable"))))))9697(defun guide-page ()98  (document-page "Runtime guide" "<h1>Living Lisp guide</h1><p class='label'>Marginalia for the image you are observing: facts are marked observed; explanations are models.</p><section class='card'><h2>Values in memory</h2><p><b>Observed:</b> <code>/proc/self/maps</code> reports virtual regions and permissions. It does not identify Lisp objects.</p><p><b>Model:</b> SBCL commonly represents small integers and simple values immediately, while conses, strings, vectors, closures, symbols, and larger numbers occupy heap objects with headers and pointers. Exact layout depends on SBCL, architecture, GC state, and object type.</p><p><b>Therefore:</b> a large anonymous mapping is evidence of address-space reservation or heap/stack/runtime storage, not proof that one source form owns it.</p></section><section class='card'><h2>Function calls</h2><p><b>Observed:</b> a request thread enters <code>handle-client</code>, parses a path, calls <code>dispatch</code>, writes a response, and emits completion.</p><p><b>Model:</b> compiled Lisp functions pass arguments in registers and/or stack slots according to compiler decisions. Closures may carry environment objects. Exact frames are not shown here; <code>/stack</code> is the available backtrace.</p></section><section class='card'><h2>Asynchrony</h2><p>This server has threads and blocking waits, not server-side promises: listener -> request thread -> dispatch -> response; worker -> sleep -> state update -> event; SSE client -> condition-wait -> send event; browser fetch() -> JavaScript Promise -> render.</p><p><b>Marginal note:</b> <code>condition-wait</code> is synchronization, not magic parallel evaluation. Events expose order; request IDs expose causal boundaries.</p></section><section class='card'><h2>Evaluation path</h2><pre>HTTP request -> parse body -> select model -> assemble context -> validate -> provider request -> normalize -> redacted completion</pre><p>Generated Lisp follows: read with <code>*read-eval* = NIL</code> -> inspect capabilities -> refuse live-image evaluation -> optionally run a narrow pure expression in a separate subprocess.</p></section><section class='card'><h2>Inspect next</h2><p>Use <a href='/memory'>memory</a> for address-space geography, <a href='/source'>source</a> for definitions, <a href='/events-ui'>events</a> for behavior, <a href='/stack'>stack</a> for backtraces, and <a href='/state'>state</a> for the raw snapshot.</p></section>"))99100(defun network-page ()101  (document-page "Network" "<h1>Network</h1><p class='label'>This page describes the server that is running, using its own state and event stream. It is not a packet viewer.</p><section class='card'><h2>What this process actually does</h2><pre>TCP listener on 0.0.0.0:$PORT102accept one socket103read an HTTP request104dispatch a path105write one response and close106107/events is different: it keeps the socket open and sends event-stream records.</pre><pre id='facts'>loading /network/state…</pre></section><section class='card'><h2>Observed request lifecycle</h2><p>These are application events emitted around the socket operations. They are evidence about this process, not a capture of every TCP packet.</p><div id='trace'></div></section><section class='card'><h2>Optional peer checks</h2><p>If the process starts with <code>PEERS=http://host:8098,...</code>, a background thread calls each peer's <code>/network/hello</code> every 15 seconds. An entry appears only after a real HTTP result; with no configured peers, there is nothing to discover.</p><div id='peers'>loading…</div></section><script>const trace=document.getElementById('trace'),rows=[],esc=v=>String(v).replace(/[&<>]/g,c=>({'&':'&amp;','<':'&lt;','>':'&gt;'}[c]));function add(e){if(!['request.started','network.request.parsed','network.response.written','request.completed','network.connection.closed','network.peer.probed'].includes(e.type))return;rows.unshift({t:e.type,d:e.data,id:e.lastEventId});trace.innerHTML=rows.slice(0,80).map(x=>'<article class=\'event\'><span class=\'type\'>#'+x.id+' '+esc(x.t)+'</span><pre>'+esc(x.d)+'</pre></article>').join('')}const es=new EventSource('/events');['request.started','network.request.parsed','network.response.written','request.completed','network.connection.closed','network.peer.probed'].forEach(k=>es.addEventListener(k,add));fetch('/network/state').then(r=>r.text()).then(x=>document.getElementById('facts').textContent=x);fetch('/network/peers').then(r=>r.json()).then(xs=>document.getElementById('peers').innerHTML=xs.length?xs.map(x=>'<p><b>'+esc(x.status)+'</b> '+esc(x.url)+' · '+new Date(x.time*1000).toISOString()+'</p>').join(''):'No peers are configured or observed.');</script>"))108109(defun moat-page ()110  (document-page "Moat" "<h1>Evaluation moat</h1><p class='label'>One Lisp-owned ledger, three projections. Scores are evidence summaries, not truth claims.</p><section class='card'><button data-view='ledger'>ledger</button> <button data-view='frontier'>frontier</button> <button data-view='uncertainty'>uncertainty</button></section><section class='card'><pre id='runs'>loading evaluation ledger…</pre></section><section class='card'><h2>Control loop</h2><pre>proposal → isolated evaluation → evidence → record-evaluation-run → event → projection → promotion decision</pre><p class='label'>No projection promotes code. Promotion remains a Git and operator decision.</p></section><script>const box=document.getElementById('runs'),views={current:'ledger',data:[]},esc=x=>String(x).replace(/[&<>]/g,c=>({'&':'&amp;','<':'&lt;','>':'&gt;'}[c]));function draw(){let xs=views.data;if(views.current==='ledger')box.textContent=xs.length?xs.map(x=>'#'+x.id+' '+x.candidate+' score='+x.score+' confidence='+x.confidence+'\\n  evidence: '+x.evidence+'\\n  uncertainty: '+x.uncertainty).join('\\n\\n'):'No evaluation records have been recorded in this image.';if(views.current==='frontier')box.innerHTML=xs.length?xs.map(x=>'<p><b>'+esc(x.candidate)+'</b> <span style=\'display:inline-block;width:'+Math.round((+x.score||0)*100)+'px;height:12px;background:#9ee493\'></span> score '+x.score+' · confidence '+x.confidence+'</p>').join(''):'No candidates';if(views.current==='uncertainty')box.innerHTML=xs.length?xs.map(x=>'<article class=\'event\'><b>'+esc(x.candidate)+'</b><p>'+esc(x.uncertainty)+'</p><p class=\'label\'>Evidence: '+esc(x.evidence)+'</p></article>').join(''):'No uncertainties recorded'}document.querySelectorAll('[data-view]').forEach(b=>b.onclick=()=>{views.current=b.dataset.view;draw()});fetch('/moat/state').then(r=>r.json()).then(xs=>{views.data=xs;draw()});const es=new EventSource('/events');es.addEventListener('moat.evaluation.recorded',e=>fetch('/moat/state').then(r=>r.json()).then(xs=>{views.data=xs;draw()}));</script>"))111112(defparameter *hypothetical-spines*113  '(("native-peer-crdt" "two copies exchange state over native Lisp sockets" "observed in isolated run" "both copies reached total 2" "repeat after a partition")114    ("adapter-critique" "interrogations expose evidence and jurisdiction" "observed" "static inspection, pure result 12, and explicit limits" "persist critique records")115    ("queue-replication" "durable work crosses the peer protocol" "hypothetical" "queue is local and at-least-once" "define message IDs and deduplication")116    ("moat/reload-safety" "transactional reload boundary" "selected roadmap" "app reload preserves runtime state" "verify rollback after a failed load")117    ("moat/source-object" "source-to-object evidence" "hypothetical" "function objects have observed addresses" "correlate without claiming ownership")118    ("moat/branch-evaluation" "isolated branch ranking" "hypothetical" "evaluation ledger exists" "run candidate branches in shadow images")))119(defun forest-page ()120  (with-output-to-string (out)121    (write-string "<h1>Forest of hypothetical spines</h1><p class='label'>The trunk is this running image. Spines are declared candidate histories; their presence is not evidence that their code is running here.</p><section class='card'><svg viewBox='0 0 900 300' width='100%' role='img' aria-label='candidate branch forest'><path d='M450 280 C450 210 450 150 450 40' stroke='#f3b562' stroke-width='12' fill='none'/><text x='465' y='285' fill='#e8e4d8'>live trunk</text>" out)122    (loop for spine in *hypothetical-spines* for y from 60 by 36 for x = (+ 120 (* y 2))123          do (format out "<path d='M450 ~D C400 ~D 280 ~D ~D ~D' stroke='#8ecae6' stroke-width='5' fill='none'/><circle cx='~D' cy='~D' r='8' fill='#8ecae6'/><text x='~D' y='~D' fill='#e8e4d8'>~A</text>" 240 (- 240 y) y x y x y (+ x 14) (+ y 5) (html-escape (first spine))))124    (write-string "</svg></section><section class='card'><h2>Evidence frontier</h2><p class='label'>Observed means a bounded experiment produced evidence. It does not mean the spine is production-complete.</p>" out)125    (dolist (spine *hypothetical-spines*)126      (format out "<article class='event'><b>~A</b><p>~A</p><p class='label'>status: ~A</p><p><b>evidence:</b> ~A</p><p><b>next test:</b> ~A</p></article>"127              (html-escape (first spine)) (html-escape (second spine)) (html-escape (third spine))128              (html-escape (fourth spine)) (html-escape (fifth spine))))129    (write-string "</section><section class='card'><h2>Runtime evidence ledger</h2><pre id='evidence'>loading moat evidence…</pre></section><script>fetch('/moat/state').then(r=>r.json()).then(xs=>document.getElementById('evidence').textContent=xs.length?xs.map(x=>x.candidate+' · score '+x.score+' · confidence '+x.confidence+'\n'+x.evidence+'\nuncertainty: '+x.uncertainty).join('\n\n'):'No live evidence is attached to a spine yet.');</script>" out)))130131(defun source-files ()132  (remove-if-not #'probe-file (mapcar (lambda (x) (merge-pathnames x (uiop:getcwd))) '("server.lisp" "app.lisp" "ai.lisp"))))133(defun definition-line-p (line)134  (some (lambda (prefix) (search prefix line))135        '("(defun " "(defmacro " "(defvar " "(defparameter " "(defstruct ")))136137(defparameter *source-map-functions*138  '("START" "HANDLE-CLIENT" "PARSE-REQUEST" "SERVE-EVENTS"139    "DISPATCH" "SERVE-NORMAL-REQUEST" "RELOAD-APP" "EMIT-EVENT"140    "PAGE" "NETWORK-PAGE" "AI-CHAT-JSON" "AI-PURE-EVALUATE-JSON"))141142(defun source-line-for (name)143  (loop for file in (source-files)144        for path = (file-namestring file)145        do (with-open-file (in file)146             (loop for line = (read-line in nil) for n from 1 while line147                   when (search (format nil "(defun ~A" (string-downcase name))148                                 (string-downcase line))149                     do (return-from source-line-for (list path n)))))150  nil)151152(defun source-map-page ()153  (with-output-to-string (out)154    (write-string "<h1>Live source/object view</h1><p class='label'>This is an inventory of live function objects, not a disassembler. Addresses identify Lisp objects in this SBCL image; they are not promised machine-code addresses or stable identities across reloads.</p><div class='card'><p>Reload generation: <b>" out)155    (format out "~D" *reload-count*)156    (write-string "</b>. Source anchors are found by scanning the files currently on disk. A missing anchor or address is shown as missing, not inferred.</p></div><table><thead><tr><th>name</th><th>object address</th><th>source anchor</th><th>confidence</th></tr></thead><tbody>" out)157    (dolist (name *source-map-functions*)158      (let* ((symbol (find-symbol name :lisp-raindesk))159             (address (and symbol (function-object-address symbol)))160             (source (and symbol (source-line-for name))))161        (format out "<tr><td>~A</td><td><code>~A</code></td><td>~A</td><td>~A</td></tr>"162                (html-escape name) (html-escape (or address "missing"))163                (if source (format nil "<a href='/source#~A-L~D'>~A:~D</a>" (first source) (second source) (first source) (second source)) "missing")164                (cond ((and address source) "observed object + source anchor")165                      (address "observed object only")166                      (source "source anchor only")167                      (t "missing")))))168    (write-string "</tbody></table><p id='reload-status' class='label'>The table is a snapshot from this image generation.</p><script>const status=document.getElementById('reload-status'),es=new EventSource('/events');es.addEventListener('code.reloaded',e=>{status.textContent='app.lisp reloaded; refreshing this object/source snapshot…';setTimeout(()=>location.reload(),80)});es.addEventListener('code.reload.failed',e=>{status.textContent='app.lisp reload failed; this snapshot remains unchanged.'});</script>" out)))169170(defun runtime-manifest-json ()171  (with-output-to-string (out)172    (format out "{\"pid\":~D,\"port\":~D,\"reload_generation\":~D,\"app_path\":\"~A\",\"event_kinds\":[" (sb-posix:getpid) *port* *reload-count* (json-escape (namestring *app-path*)))173    (loop for kind in *event-kinds* for first = t then nil174          do (unless first (write-string "," out)) (format out "\"~A\"" (json-escape kind)))175    (write-string "],\"workers\":[" out)176    (loop for name being the hash-keys of *worker-states* for first = t then nil177          do (unless first (write-string "," out)) (format out "\"~A\"" name))178    (write-string "],\"function_objects\":[" out)179    (loop for name in *source-map-functions* for first = t then nil180          do (unless first (write-string "," out))181             (format out "{\"name\":\"~A\",\"address\":\"~A\"}"182                     (json-escape name) (json-escape (or (function-object-address (find-symbol name :lisp-raindesk)) "missing"))))183    (write-string "],\"claims\":{\"observed\":[\"pid\",\"port\",\"reload_generation\",\"workers\",\"function object addresses\"],\"not_observed\":[\"all TCP packets\",\"stable machine-code addresses\",\"complete compiler line tables\"]}}" out)))184(defun source-page ()185  (with-output-to-string (out)186    (write-string "<h1>Running source</h1><p class='label'>Generated from the files loaded by the live image. Click definitions to inspect their bodies.</p><div class='card'><b>Files</b><ul>" out)187    (dolist (file (source-files)) (format out "<li><a href='#~A'>~A</a></li>" (file-namestring file) (html-escape (file-namestring file))))188    (write-string "</ul></div>" out)189    (dolist (file (source-files))190      (let ((name (file-namestring file)))191        (format out "<article class='file' id='~A'><h2>~A</h2><pre>" name (html-escape name))192        (with-open-file (in file)193          (loop for line = (read-line in nil) for n from 1 while line194                do (format out "<a id='~A-L~D' href='#~A-L~D' style='display:block;color:~A'><span style='color:#69728a;width:4rem;display:inline-block'>~D</span>~A</a>" name n name n (if (definition-line-p line) "#f3b562" "#9ee493") n (html-escape line))))195        (write-string "</pre></article>" out)))))196(defun events-page ()197  (format nil "<h1>Event stream</h1><p class='label'>Adjacent heartbeats and memory samples fold into loops; every member remains inspectable.</p><div id='events'></div><script>const box=document.getElementById('events'),groups=[],es=new EventSource('/events');const esc=v=>String(v).replace(/[&<>]/g,c=>({'&':'&amp;','<':'&lt;','>':'&gt;'}[c]));function add(e){let g=groups[0],fold=['worker.heartbeat','memory.changed'].includes(e.type);if(g&&fold&&g.type===e.type&&+e.lastEventId===g.last+1){g.last=+e.lastEventId;g.n++;g.items.push(e.data)}else groups.unshift({type:e.type,first:+e.lastEventId,last:+e.lastEventId,n:1,items:[e.data]});box.innerHTML=groups.slice(0,80).map(g=>`<article class='event ${g.n>1?'loop':''}'><details ${g.n===1?'open':''}><summary><span class='type'>${esc(g.type)}</span> · ids ${g.first}–${g.last}${g.n>1?' · loop ×'+g.n:''}</summary><pre>${g.items.map(esc).join('\\n')}</pre></details></article>`).join('')}['snapshot',...~A].forEach(t=>es.addEventListener(t,add))</script>" (event-kinds-js)))198(defun explorer-page ()199  (format nil "<h1>Runtime explorer</h1><p class='label'>One EventSource connection, a bounded client buffer, and a pause switch. Rows are observed events, not reconstructed history.</p><section class='card'><button id='pause'>pause</button> <button id='clear'>clear</button> <span id='mode'>live</span> · <span id='connection'>connecting</span></section><div id='timeline'></div><script>const es=new EventSource('/events'),rows=[],box=document.getElementById('timeline'),wanted=['snapshot','request.started','network.request.parsed','network.response.written','request.completed','network.connection.closed','worker.heartbeat','memory.changed','code.reloaded','code.reload.failed','ai.pipeline.started','ai.pipeline.stage','ai.pipeline.completed','ai.expression.evaluated','network.peer.probed'];let paused=false;const esc=x=>String(x).replace(/[&<>]/g,c=>({'&':'&amp;','<':'&lt;','>':'&gt;'}[c])),draw=()=>box.innerHTML=rows.slice(-160).reverse().map(x=>`<article class='event'><span class='type'>#${x.id} ${esc(x.type)}</span><pre>${esc(x.data)}</pre></article>`).join('')||'<p class=\'label\'>No events received.</p>';wanted.forEach(k=>es.addEventListener(k,e=>{rows.push({id:e.lastEventId,type:e.type,data:e.data});if(!paused)draw()}));es.onopen=()=>document.getElementById('connection').textContent='live';es.onerror=()=>document.getElementById('connection').textContent='reconnecting';document.getElementById('pause').onclick=()=>{paused=!paused;document.getElementById('mode').textContent=paused?'paused':'live';draw()};document.getElementById('clear').onclick=()=>{rows.length=0;draw()};draw();</script>"))200(defun page ()201  (format nil "<h1>(lisp-raindesk)</h1><p>~A</p><p class='label'>PID ~D · reloads ~D · watcher ~A</p><section class='card'><b>Live differential runtime</b><p>Requests, workers, memory, source, assumptions, and reloads are observable through the shared event stream.</p></section><section class='card'><a href='/explore'>explorer</a> · <a href='/memory'>memory</a> · <a href='/source'>source</a> · <a href='/events-ui'>events</a> · <a href='/ai'>AI boundary</a></section>" (app-label) (sb-posix:getpid) *reload-count* *watcher-status*))202203(defun dispatch (path &optional body)204  (cond ((string= path "/guide") (values (guide-page) "text/html; charset=utf-8"))205        ((string= path "/network") (values (network-page) "text/html; charset=utf-8"))206        ((string= path "/queue") (values (document-page "queue" (format nil "<h1>durable queue</h1><p>Append-only journal; lease and ACK; at-least-once delivery.</p><pre>~A</pre>" (html-escape (queue-json))) ) "text/html; charset=utf-8"))207        ((string= path "/queue/publish") (values (queue-json (queue-publish (or body ""))) "application/json"))208        ((string= path "/queue/poll") (let ((message (queue-poll (or body (local-node-id))))) (values (if message (queue-json message) "null") "application/json")))209        ((string= path "/queue/ack") (let ((message (queue-ack (string-trim '(#\Space #\Tab #\Return #\Linefeed) (or body ""))))) (values (if message (queue-json message) "null") "application/json")))210        ((string= path "/network/hello") (values (peer-hello-json) "application/json"))211        ((string= path "/network/crdt") (values (crdt-json) "application/json"))212        ((string= path "/crdt/increment") (values (crdt-increment) "application/json"))213        ((string= path "/network/peers")214         (values (with-output-to-string (out)215                   (write-string "[" out)216                   (loop for peer being the hash-values of *peer-observations* for first = t then nil217                         do (unless first (write-string "," out))218                            (format out "{\"url\":\"~A\",\"status\":\"~A\",\"time\":~D}"219                                    (json-escape (getf peer :url)) (getf peer :status) (getf peer :time)))220                   (write-string "]" out)) "application/json"))221        ((string= path "/network/state")222         (values (with-output-to-string (out)223                   (format out "{\"listener\":{\"address\":\"0.0.0.0\",\"port\":~D,\"transport\":\"TCP\"},\"configured_peers\":[" *port*)224                   (loop for peer in *peer-urls* for first = t then nil225                         do (unless first (write-string "," out))226                            (format out "\"~A\"" (json-escape peer)))227                   (write-string "],\"observations\":[" out)228                   (loop for peer being the hash-values of *peer-observations* for first = t then nil229                         do (unless first (write-string "," out))230                            (format out "{\"url\":\"~A\",\"status\":\"~A\",\"time\":~D}"231                                    (json-escape (getf peer :url)) (getf peer :status) (getf peer :time)))232                   (write-string "],\"note\":\"observed server facts; no packet capture\"}" out)) "application/json"))233        ((string= path "/source-map") (values (document-page "Live source/object view" (source-map-page)) "text/html; charset=utf-8"))234        ((string= path "/moat") (values (moat-page) "text/html; charset=utf-8"))235        ((string= path "/moat/state") (values (evaluation-runs-json) "application/json"))236        ((string= path "/forest") (values (document-page "Forest" (forest-page)) "text/html; charset=utf-8"))237        ((string= path "/manifest") (values (runtime-manifest-json) "application/json"))238        ((string= path "/explore") (values (document-page "Explorer" (explorer-page)) "text/html; charset=utf-8"))239        ((string= path "/memory") (values (document-page "Memory" (memory-page)) "text/html; charset=utf-8"))240        ((string= path "/source") (values (document-page "Source" (source-page)) "text/html; charset=utf-8"))241        ((string= path "/events-ui") (values (document-page "Events" (events-page)) "text/html; charset=utf-8"))242        ((string= path "/assumptions") (values (document-page "Assumptions" (format nil "<h1>Assumptions</h1>~A" (assumptions-html))) "text/html; charset=utf-8"))243        ((string= path "/ai") (values (ai-page) "text/html; charset=utf-8"))244        ((string= path "/ai/source") (values (ai-source-page) "text/html; charset=utf-8"))245        ((string= path "/ai/source/live") (values (ai-source-live-page) "text/html; charset=utf-8"))246        ((string= path "/ai/validate") (values (ai-validation-json *request-body*) "application/json"))247        ((string= path "/ai/source/inspect") (values (ai-source-inspect-json *request-body*) "application/json"))248        ((string= path "/ai/source/evaluate") (values (ai-pure-evaluate-json *request-body*) "application/json"))249        ((string= path "/ai/chat") (values (ai-chat-json *request-body*) "application/json"))250        ((string= path "/state") (values (snapshot-json) "application/json"))251        ((string= path "/stack") (values (with-output-to-string (out) (format out "tick ~D~%" *tick*) (dolist (x (sb-debug:backtrace-as-list)) (format out "~S~%" x))) "text/plain"))252        (t (values (document-page "Lisp / Raindesk" (page)) "text/html; charset=utf-8"))))

1(in-package #:lisp-raindesk)23;;; AI boundary: transient credentials in, normalized text out.  This file4;;; never evaluates model output or mutates runtime state.5(defparameter *ai-models*6  '(("openrouter" . (("openrouter/auto" . "automatic routing")7                     ("openai/gpt-5" . "strong general reasoning")8                     ("anthropic/claude-opus-5" . "deep analysis and code")9                     ("x-ai/grok-4.5" . "long-context reasoning")))10    ("gemini" . (("gemini-3.6-flash" . "fast general reasoning")11                 ("gemini-3.5-flash" . "strong coding and analysis")12                 ("gemini-3.5-flash-lite" . "fast and economical")))))1314(defun ai-body-field (body field)15  "Read one JSON string field with whitespace and escaped characters tolerated."16  (let ((start (and body (search (format nil "\"~A\"" field) body))))17    (when start18      (let ((colon (position #\: body :start (+ start (length field) 2))))19        (when colon20          (let ((quote (position #\" body :start (1+ colon))))21            (when quote22              (with-output-to-string (out)23                (loop for i from (1+ quote) below (length body)24                      for c = (char body i)25                      do (cond ((char= c #\") (return))26                               ((char= c #\\)27                                (when (< (1+ i) (length body))28                                  (incf i)29                                  (write-char (case (char body i)30                                                (#\n #\Newline) (#\r #\Return) (#\t #\Tab)31                                                (t (char body i))) out)))32                               (t (write-char c out))))))))))))3334(defun ai-enabled-p (body name)35  (and body (search (format nil "\"~A\":true" name) body)))36(defun ai-secret-file-value (name)37  (let ((path (merge-pathnames ".config/lisp-raindesk/secrets.env" (user-homedir-pathname))))38    (when (probe-file path)39      (with-open-file (in path)40        (loop for line = (read-line in nil) while line41              when (uiop:string-prefix-p (format nil "~A=" name) line)42                do (return (string-trim '(#\Space #\Tab #\Return) (subseq line (1+ (length name))))))))))43(defun ai-resolve-key (provider browser-key)44  (let ((name (if (string= provider "gemini") "GEMINI_API_KEY" "OPENROUTER_API_KEY")))45    (cond ((and browser-key (plusp (length browser-key))) (values browser-key "browser-ephemeral"))46          ((uiop:getenv name) (values (uiop:getenv name) "environment"))47          ((ai-secret-file-value name) (values (ai-secret-file-value name) "secret-file"))48          (t (values nil "missing")))))49(defun ai-key-shape (provider key)50  (and key (plusp (length key))51       (or (and (string= provider "openrouter") (uiop:string-prefix-p "sk-or-" key))52           (and (string= provider "gemini") (uiop:string-prefix-p "AIza" key))53           (> (length key) 12))))5455(defun ai-model-known-p (provider model)56  (or (null model) (assoc model (cdr (assoc provider *ai-models* :test #'string=)) :test #'string=)))57(defun ai-curl (provider key model request-json &optional probe)58  (let* ((gemini (string= provider "gemini"))59         (base (if gemini "https://generativelanguage.googleapis.com/v1beta/models"60                   "https://openrouter.ai/api/v1"))61         (url (if probe (if gemini base (format nil "~A/key" base))62                  (if gemini (format nil "~A/~A:generateContent" base model)63                      (format nil "~A/chat/completions" base))))64         (header (if gemini (format nil "x-goog-api-key: ~A" key)65                     (format nil "Authorization: Bearer ~A" key)))66         (header-file (format nil "/tmp/lisp-ai-header-~D-~D" (sb-posix:getpid) (random 1000000000)))67         (command (format nil "curl -sS --max-time ~D --config ~A -w '\\nHTTP_STATUS:%{http_code}' ~A ~A"68                          (if probe 20 60) header-file69                          (if probe "" "-H 'Content-Type: application/json' -X POST --data-binary @-")70                          (format nil "\"~A\"" url))))71    (unwind-protect72         (progn73           (with-open-file (out header-file :direction :output :if-exists :supersede)74             (format out "header = \"~A\"~%" header))75           (uiop:run-program (list "/bin/sh" "-c" command)76                             :input (and (not probe) (make-string-input-stream request-json))77                             :output :string :error-output :string :ignore-error-status t78                             :environment '("PATH=/usr/bin:/bin")))79      (ignore-errors (delete-file header-file)))))80(defun ai-status (output)81  (let ((marker (search "HTTP_STATUS:" output)))82    (if marker (parse-integer output :start (+ marker 12) :junk-allowed t) 0)))83(defun ai-error (output)84  (or (ai-body-field output "message") (ai-body-field output "error")85      "provider returned no readable response"))86(defun ai-stage (provider source stage status ok message)87  (format nil "{\"provider\":\"~A\",\"source\":\"~A\",\"stage\":\"~A\",\"status\":~D,\"ok\":~A,\"message\":\"~A\"}"88          provider source stage status (if ok "true" "false") (json-escape message)))89(defun ai-pipeline-event (type phase ok message)90  (emit-event type (format nil "{\"request_id\":~D,\"phase\":\"~A\",\"ok\":~A,\"message\":\"~A\"}"91                            *request-id* phase (if ok "true" "false") (json-escape message))))92(defun ai-expression-event (phase form ok)93  (emit-event "ai.expression.evaluated"94              (format nil "{\"request_id\":~D,\"phase\":\"~A\",\"expression\":\"~A\",\"fingerprint\":~D,\"ok\":~A,\"time\":~D}"95                      *request-id* phase (json-escape (princ-to-string form)) (sxhash form)96                      (if ok "true" "false") (get-universal-time))))9798(defun ai-selected-context (body)99  (remove nil (list (and (ai-enabled-p body "include_source") "source")100                    (and (ai-enabled-p body "include_state") "state")101                    (and (ai-enabled-p body "include_memory") "memory")102                    (and (ai-enabled-p body "include_trace") "trace")103                    (and (ai-enabled-p body "include_assumptions") "assumptions")104                    (and (ai-enabled-p body "include_manifest") "manifest"))))105(defun ai-context (body)106  (with-output-to-string (out)107    (format out "\n\n[SYSTEM SUMMARY]\nThis is a live SBCL image. server.lisp owns sockets, workers, bounded events, request IDs, and reload. app.lisp owns reloadable presentation and routing. ai.lisp is an adapter only; model output is never evaluated in the live image. Evidence is sampled, bounded, and labelled with uncertainty.\n\n[Inspectable runtime context]\n")108    (when (ai-enabled-p body "include_source")109      (format out "\n[SOURCE]\n~A\n" (format nil "[server.lisp]\n~A\n[app.lisp]\n~A\n[ai.lisp]\n~A"110                                                   (proc-file (namestring (merge-pathnames "server.lisp" (uiop:getcwd))) 14000)111                                                   (proc-file (namestring (merge-pathnames "app.lisp" (uiop:getcwd))) 14000)112                                                   (proc-file (namestring (merge-pathnames "ai.lisp" (uiop:getcwd))) 12000))))113    (when (ai-enabled-p body "include_state") (format out "\n[STATE]\n~A\n" (snapshot-json)))114    (when (ai-enabled-p body "include_memory") (format out "\n[MEMORY MAP]\n~A\n" (proc-file "/proc/self/maps" 12000)))115    (when (ai-enabled-p body "include_trace")116      (format out "\n[TRACE]\n~A\n" (with-output-to-string (trace) (dolist (e (event-list-after (max 0 (- *next-event-id* 30)))) (format trace "~D ~A ~A~%" (event-id e) (event-type e) (event-data e))))))117    (when (ai-enabled-p body "include_assumptions") (format out "\n[ASSUMPTIONS]\n~A\n" (assumptions-text)))118    (when (ai-enabled-p body "include_manifest") (format out "\n[RUNTIME MANIFEST]\n~A\n" (runtime-manifest-json)))))119120(defparameter *ai-forbidden-forms*121  '("eval" "load" "compile" "compile-file" "require" "asdf" "run-program"122    "open" "with-open-file" "delete-file" "rename-file" "socket" "sb-posix"123    "sb-bsd-sockets" "uiop" "setf" "defparameter" "defvar" "in-package"))124(defun ai-source-forms (source)125  (let ((eof (gensym "EOF")) (forms nil))126    (handler-case127        (with-input-from-string (in (or source ""))128          (let ((*read-eval* nil))129            (loop for form = (read in nil eof) until (eq form eof) do (push form forms))))130      (error (condition) (return-from ai-source-forms (values nil (princ-to-string condition)))))131    (values (nreverse forms) nil)))132(defun ai-source-findings (forms)133  (let ((found nil))134    (labels ((walk (x)135               (when (consp x) (walk (car x)) (walk (cdr x)))136               (when (symbolp x)137                 (let ((name (string-downcase (symbol-name x))))138                   (when (member name *ai-forbidden-forms* :test #'string=)139                     (pushnew name found :test #'string=))))))140      (walk forms))141    (sort found #'string<)))142(defun ai-source-inspect-json (body)143  (ai-pipeline-event "ai.pipeline.started" "source.inspect" t "source inspection requested")144  (let ((source (ai-body-field body "source")))145    (ai-pipeline-event "ai.pipeline.stage" "parse" t "reader has *read-eval* disabled")146    (multiple-value-bind (forms error) (ai-source-forms source)147      (if error148          (progn (ai-pipeline-event "ai.pipeline.completed" "parse" nil error)149                 (format nil "{\"ok\":false,\"phase\":\"parse\",\"error\":\"~A\"}" (json-escape error)))150          (let ((findings (ai-source-findings forms)))151            (ai-pipeline-event "ai.pipeline.stage" "capability.inspect" t (format nil "~D forms; ~D findings" (length forms) (length findings)))152            (ai-pipeline-event "ai.pipeline.completed" "source.inspect" t "evaluation not requested")153            (record-evaluation-run "ai-source-inspection" "1.0000" "0.9000"154                                   (format nil "~D forms parsed; ~D capability findings; no live evaluation" (length forms) (length findings))155                                   "static inspection does not prove runtime safety")156            (format nil "{\"ok\":true,\"phase\":\"static-inspection\",\"forms\":[~{\"~A\"~^,~}],\"findings\":[~{\"~A\"~^,~}],\"evaluation\":\"not-run: live-image evaluation is prohibited\"}"157                    (mapcar (lambda (form) (json-escape (princ-to-string form))) forms) findings))))))158(defparameter *ai-pure-heads*159  '(+ - * / = < > <= >= 1+ 1- abs floor ceiling round mod rem min max160    if and or not list list* cons car cdr cadr caddr length append reverse161    quote))162(defun ai-pure-form-p (form)163  (cond ((or (numberp form) (stringp form) (characterp form) (null form) (eq form t)) t)164        ((symbolp form) nil)165        ((consp form)166         (or (and (eq (car form) 'quote) (= (length form) 2))167             (and (symbolp (car form))168                  (member (car form) *ai-pure-heads*)169                  (every #'ai-pure-form-p (cdr form)))))170        (t nil)))171(defun ai-pure-evaluate-json (body)172  (multiple-value-bind (forms parse-error) (ai-source-forms (ai-body-field body "source"))173    (cond (parse-error (format nil "{\"ok\":false,\"phase\":\"parse\",\"error\":\"~A\"}" (json-escape parse-error)))174          ((or (null forms) (some (lambda (form) (not (ai-pure-form-p form))) forms))175           "{\"ok\":false,\"phase\":\"safety\",\"error\":\"only pure expressions are executable; definitions and effects are refused\"}")176          (t (handler-case177                 (progn178                   (dolist (form forms) (ai-expression-event "scheduled" form t))179                   (let* ((expression (format nil "(format t \"~~S\" (progn ~{~S~^ ~}))" forms))180                          (result (uiop:run-program (list "timeout" "4" "sbcl" "--noinform" "--non-interactive" "--eval" expression)181                                                    :output :string :error-output :string :ignore-error-status t182                                                    :environment '("PATH=/usr/bin:/bin"))))183                     (dolist (form forms) (ai-expression-event "evaluated" form t))184                     (record-evaluation-run "ai-pure-evaluation" "1.0000" "0.8000"185                                            "pure expression completed in scrubbed timeout subprocess"186                                            "subprocess isolation is not a complete adversarial sandbox")187                     (format nil "{\"ok\":true,\"phase\":\"isolated-pure-evaluation\",\"result\":\"~A\",\"note\":\"subprocess; no live image handles or secrets\"}" (json-escape result))))188               (error (condition) (format nil "{\"ok\":false,\"phase\":\"evaluation\",\"error\":\"~A\"}" (json-escape condition))))))))189(defun ai-source-page ()190  "<!doctype html><html><head><meta charset='utf-8'><title>Lisp source gate</title><style>body{background:#0d1018;color:#e8e4d8;font:14px ui-monospace,monospace;margin:2rem}main{max-width:1000px;margin:auto}a{color:#8ecae6}h1{color:#f3b562}.card{border:1px solid #4d5366;background:#171a24;padding:1rem;margin:1rem 0}textarea,button{background:#10121a;color:#e8e4d8;border:1px solid #69728a;padding:.6rem;font:inherit;width:100%;box-sizing:border-box}button{cursor:pointer;margin-top:.6rem}pre{white-space:pre-wrap}</style></head><body><main><p><a href='/ai'>← AI boundary</a> · <a href='/source'>running source</a></p><h1>Generated Lisp source gate</h1><p>Paste or fetch generated source here. Parsing and capability inspection are visible; evaluation in the live image is refused.</p><section class='card'><textarea id='source' rows='16'>(defun candidate (x) (+ x 1))</textarea><button id='inspect'>parse and inspect</button></section><pre id='result'>Awaiting inspection.</pre><script>document.getElementById('inspect').onclick=async()=>{let r=await fetch('/ai/source/inspect',{method:'POST',headers:{'Content-Type':'application/json'},body:JSON.stringify({source:document.getElementById('source').value})});document.getElementById('result').textContent=JSON.stringify(await r.json(),null,2)}</script></main></body></html>")191(defun ai-source-live-page ()192  "<!doctype html><html><head><meta charset='utf-8'><title>Live Lisp evaluations</title><style>body{background:#0d1018;color:#e8e4d8;font:14px ui-monospace,monospace;margin:1.5rem}main{max-width:1400px;margin:auto}a{color:#8ecae6}h1{color:#f3b562}.layout{display:grid;grid-template-columns:minmax(420px,1fr) minmax(360px,1fr);gap:1rem}.card{border:1px solid #4d5366;background:#171a24;padding:1rem;margin:1rem 0}pre{white-space:pre-wrap;overflow:auto}.expr{padding:.5rem;border-left:4px solid #69728a;margin:.3rem 0}.scheduled{border-color:#f3b562}.evaluated{border-color:#9ee493}.rejected{border-color:#f27676}.meta{color:#8ecae6;font-size:.85rem}</style></head><body><main><p><a href='/ai/source'>← source gate</a> · <a href='/source'>running source</a> · <a href='/events-ui'>all events</a></p><h1>Source-first evaluation timeline</h1><p class='meta'>Each expression records first observation, latest observation, frequency, age, and forecast. Forecasts are heuristics from observed intervals, not promises.</p><div class='layout'><section><div class='card'><h2>Source</h2><pre id='source'>connecting…</pre></div></section><section><div class='card'><h2>Expression ledger</h2><div id='ledger'>waiting for expression events…</div></div><div class='card'><h2>Evaluation sequence</h2><div id='sequence'>waiting…</div></div></section></div><script>const ledger=new Map(),seq=[],source=document.getElementById('source'),esc=x=>String(x).replace(/[&<>]/g,c=>({'&':'&amp;','<':'&lt;','>':'&gt;'}[c]));fetch('/source').then(r=>r.text()).then(t=>source.textContent=t);function draw(){document.getElementById('ledger').innerHTML=[...ledger.values()].sort((a,b)=>b.last-a.last).map(x=>{let age=Math.max(0,Date.now()/1000-x.last),interval=x.prev?x.last-x.prev:null,forecast=interval?new Date((x.last+interval)*1000).toISOString():'not enough observations';return `<article class='expr ${x.phase}'><b>${esc(x.expression)}</b><br><span class='meta'>count ${x.count} · first ${new Date(x.first*1000).toISOString()} · last ${new Date(x.last*1000).toISOString()} · age ${age.toFixed(1)}s · next estimate ${forecast}</span></article>`}).join('')||'none';document.getElementById('sequence').innerHTML=seq.slice(-80).reverse().map(x=>`<div class='expr ${x.phase}'><b>${x.phase}</b> · ${esc(x.expression)} · request ${x.request_id}</div>`).join('')||'waiting'}const es=new EventSource('/events');es.addEventListener('ai.expression.evaluated',e=>{let x=JSON.parse(e.data),k=x.fingerprint,l=ledger.get(k)||{count:0,first:x.time};l.prev=l.last;l.last=x.time;l.count++;l.expression=x.expression;l.phase=x.phase;ledger.set(k,l);seq.push(x);draw()});draw()</script></main></body></html>")193194(defun ai-validation-json (body)195  (let ((provider (or (ai-body-field body "provider") "openrouter")) (browser-key (ai-body-field body "key"))196        (model (ai-body-field body "model")))197    (multiple-value-bind (key source) (ai-resolve-key provider browser-key)198      (let ((stages (list (ai-stage provider source "input" 200 (and (ai-model-known-p provider model))199                                          (if (ai-model-known-p provider model) "provider and model accepted" "unknown model")))))200        (cond ((not (ai-key-shape provider key))201               (push (ai-stage provider source "credential" 0 nil "missing or unrecognized key") stages))202              ((not (ai-model-known-p provider model))203               (push (ai-stage provider source "model" 0 nil "choose a listed model or verify a custom model") stages))204              (t (let* ((raw (ai-curl provider key model nil t)) (status (ai-status raw)) (ok (and (>= status 200) (< status 300))))205                   (push (ai-stage provider source "credential" 200 t "key shape recognized; value redacted") stages)206                   (push (ai-stage provider source "authentication" status ok (if ok "provider accepted credential" (ai-error raw))) stages))))207        (record-evaluation-run "ai-validation"208                               (if (and (ai-key-shape provider key) (ai-model-known-p provider model)) "1.0000" "0.0000")209                               "0.9000"210                               (format nil "provider ~A; source ~A; validation stages recorded" provider source)211                               "credential authentication and provider availability may remain untested")212        (emit-event "ai.validation.completed" (format nil "{\"provider\":\"~A\",\"source\":\"~A\",\"ok\":~A}" provider source (if (every (lambda (x) (search "\"ok\":true" x)) stages) "true" "false")))213        (format nil "{\"ok\":~A,\"stages\":[~{~A~^,~}]}" (if (and (ai-key-shape provider key) (ai-model-known-p provider model)) "true" "false") (nreverse stages))))))214215(defun ai-chat-json-inner (body)216  (let* ((provider (or (ai-body-field body "provider") "openrouter"))217         (browser-key (ai-body-field body "key"))218         (prompt (or (ai-body-field body "prompt") ""))219         (models (cdr (assoc provider *ai-models* :test #'string=)))220         (model (or (ai-body-field body "model") (car (car models))) )221         (full-prompt (concatenate 'string prompt (ai-context body))))222    (multiple-value-bind (key source) (ai-resolve-key provider browser-key)223      (cond ((not (ai-key-shape provider key)) "{\"ok\":false,\"error\":\"credential or prompt missing\"}")224            ((zerop (length prompt)) "{\"ok\":false,\"error\":\"prompt is empty\"}")225            ((not (ai-model-known-p provider model)) "{\"ok\":false,\"error\":\"model is not in the selected provider catalog\"}")226            (t227             (let* ((request-json (if (string= provider "gemini")228                                      (format nil "{\"contents\":[{\"role\":\"user\",\"parts\":[{\"text\":\"~A\"}]}]}" (json-escape full-prompt))229                                      (format nil "{\"model\":\"~A\",\"messages\":[{\"role\":\"user\",\"content\":\"~A\"}],\"max_tokens\":600}" (json-escape model) (json-escape full-prompt))))230                    (raw (ai-curl provider key model request-json))231                    (status (ai-status raw))232                    (ok (and (>= status 200) (< status 300)))233                    (answer (or (ai-body-field raw "content") (ai-body-field raw "text") (ai-error raw))))234               (emit-event "ai.chat.completed" (format nil "{\"provider\":\"~A\",\"source\":\"~A\",\"model\":\"~A\",\"status\":~D,\"ok\":~A}" provider source (json-escape model) status (if ok "true" "false")))235               (format nil "{\"ok\":~A,\"request_id\":~D,\"provider\":\"~A\",\"model\":\"~A\",\"status\":~D,\"context\":[~{\"~A\"~^,~}],\"answer\":\"~A\"}" (if ok "true" "false") *request-id* provider (json-escape model) status (mapcar #'json-escape (ai-selected-context body)) (json-escape answer))))))))236237(defun ai-chat-json (body)238  (handler-case (ai-chat-json-inner body)239    (error (condition)240      (format nil "{\"ok\":false,\"error\":\"chat adapter error: ~A\"}" (json-escape condition)))))241242(defun ai-page ()243  "Interactive provider/model chooser with explicit runtime-context toggles."244  "<!doctype html><html><head><meta charset='utf-8'><meta name='viewport' content='width=device-width,initial-scale=1'><title>AI · Lisp Raindesk</title><style>body{background:#0d1018;color:#e8e4d8;font:14px ui-monospace,monospace;margin:2rem}main{max-width:1000px;margin:auto}a{color:#8ecae6}h1{color:#f3b562}.card{border:1px solid #4d5366;background:#171a24;padding:1rem;margin:1rem 0}label{display:block;margin:.7rem 0}.label{color:#8ecae6}input,select,textarea,button{background:#10121a;color:#e8e4d8;border:1px solid #69728a;padding:.55rem;font:inherit;width:100%;box-sizing:border-box}button{cursor:pointer;margin-top:.5rem}.checks{display:grid;grid-template-columns:repeat(auto-fit,minmax(180px,1fr));gap:.3rem}.checks label{border:1px solid #303647;padding:.45rem}.checks input{width:auto}.stage{padding:.35rem;border-left:3px solid #f3b562;margin:.3rem 0}.pass{border-color:#9ee493}.bad{color:#f27676}pre{white-space:pre-wrap;overflow:auto}</style></head><body><main><p><a href='/'>&lt;- dashboard</a> · <a href='/explore'>explorer</a> · <a href='/source'>source</a></p><h1>AI boundary</h1><p class='label'>The prompt is explicit; selected representations are appended as labelled context. Keys remain transient.</p><section class='card'><label>Provider<select id='provider'><option value='openrouter'>OpenRouter</option><option value='gemini'>Gemini</option></select></label><label>Model<select id='model'></select></label><label>API key <span class='label'>(optional when a server credential exists)</span><input id='key' type='password' autocomplete='off'></label><div class='checks'><label><input type='checkbox' id='include_source' checked> source</label><label><input type='checkbox' id='include_state' checked> state</label><label><input type='checkbox' id='include_memory'> memory map</label><label><input type='checkbox' id='include_trace' checked> recent trace</label><label><input type='checkbox' id='include_assumptions'> assumptions</label></div><button id='validate'>run validation gestures</button><div id='stages'></div></section><section class='card'><label>Prompt<textarea id='prompt' rows='6'>Explain the current Lisp runtime and identify one uncertainty.</textarea></label><button id='chat'>send chat</button><pre id='answer'>No response yet.</pre></section><script>const q=id=>document.getElementById(id),provider=q('provider'),model=q('model'),catalog={openrouter:[['openrouter/auto','automatic routing'],['openai/gpt-5','strong general reasoning'],['anthropic/claude-opus-5','deep analysis and code'],['x-ai/grok-4.5','long-context reasoning']],gemini:[['gemini-3.6-flash','fast general reasoning'],['gemini-3.5-flash','strong coding and analysis'],['gemini-3.5-flash-lite','fast and economical']]};function models(){model.innerHTML=catalog[provider.value].map(([id,desc])=>`<option value='${id}'>${id} · ${desc}</option>`).join('')}provider.onchange=models;models();function payload(){let x={provider:provider.value,model:model.value,key:q('key').value,prompt:q('prompt').value};['source','state','memory','trace','assumptions'].forEach(k=>x['include_'+k]=q('include_'+k).checked);return JSON.stringify(x)}async function call(url){let r=await fetch(url,{method:'POST',headers:{'Content-Type':'application/json'},body:payload()});let x=await r.json();if(!r.ok)throw Error('HTTP '+r.status);return x}q('validate').onclick=async()=>{q('stages').textContent='validating…';try{let x=await call('/ai/validate');q('stages').innerHTML=(x.stages||[]).map(s=>`<div class='stage ${s.ok?'pass':'bad'}'>${s.stage} · ${s.message} · ${s.status}</div>`).join('')}catch(e){q('stages').textContent='validation transport error: '+e}};q('chat').onclick=async()=>{q('answer').textContent='sending…';try{let x=await call('/ai/chat');q('answer').textContent=x.ok?x.answer:JSON.stringify(x,null,2)}catch(e){q('answer').textContent='chat transport error: '+e}}&