Something went wrong. Try again.
Runabout is a long-term agent harness.
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138(in-package #:runabout.repl)
(defvar *code* nil "The bundle directory this image's code last came from, or NIL.")
(defvar *code-stamp* nil "The last successful bundle stamp, or NIL before reload or after a partial failure.")
(defun bundle-dir (dir) "DIR as a directory pathname, whether or not it ends in a slash." (let ((name (namestring (pathname dir)))) (pathname (if (and (plusp (length name)) (char= #\/ (char name (1- (length name))))) name (concatenate 'string name "/")))))
(defun bundle-stamp (dir) (let ((file (merge-pathnames "build" dir))) (when (probe-file file) (let ((stamp (string-trim '(#\Space #\Tab #\Return) (with-open-file (in file) (read-line in nil ""))))) (and (plusp (length stamp)) stamp)))))
(defun bundle-files (dir) "The source paths DIR's manifest lists, in the order the build wrote them." (let ((file (merge-pathnames "manifest" dir))) (when (probe-file file) (with-open-file (in file) (loop for line = (read-line in nil nil) while line for name = (string-trim '(#\Space #\Tab #\Return) line) unless (zerop (length name)) collect name)))))
(defun bundle-path (dir area name) "DIR/AREA/NAME, the compiled copy named .fasl rather than .lisp." (let* ((cut (if (and (> (length name) 5) (string= ".lisp" name :start2 (- (length name) 5))) (- (length name) 5) (length name))) (stem (subseq name 0 cut)) (suffix (if (string= area "fasl") ".fasl" (subseq name cut)))) (merge-pathnames (format nil "~a/~a~a" area stem suffix) dir)))
(defun valid-bundle-name-p (name) "Whether NAME is a relative Lisp source path inside a bundle." (and (stringp name) (> (length name) 5) (string= ".lisp" name :start2 (- (length name) 5)) (not (find-if (lambda (c) (member c '(#\\ #\Null #\:))) name)) (not (char= #\/ (char name 0))) (loop with start = 0 for end = (or (position #\/ name :start start) (length name)) for part = (subseq name start end) always (and (plusp (length part)) (not (member part '("." "..") :test #'string=))) while (< end (length name)) do (setf start (1+ end)))))
(defun bundle-load-file (dir name) "Choose NAME's compiled copy when it is fresh, its source otherwise." (let ((fasl (bundle-path dir "fasl" name)) (source (bundle-path dir "source" name))) (cond ((and (probe-file fasl) (let ((src (probe-file source))) (or (null src) (>= (file-write-date fasl) (file-write-date src))))) fasl) ((probe-file source) source) (t (error "The bundle has neither ~a nor a compiled copy of it." name)))))
(defun bundle-load-files (dir files) "Validate the full manifest before any bundle code runs." (when (null files) (error "The bundle manifest is empty.")) (let ((seen '())) (mapcar (lambda (name) (unless (valid-bundle-name-p name) (error "Invalid bundle path ~s; entries must be relative .lisp paths." name)) (when (member name seen :test #'string=) (error "Duplicate bundle path ~s." name)) (push name seen) (cons name (bundle-load-file dir name))) files)))
(defun refresh-code (&key (dir *code*) force quiet) "Load the code bundle in DIR over this image's definitions.
Loading is sequential: a load-time error can leave definitions, variable values,and package changes in place. The result reports whether loading had begun." (let ((loading nil) (stamp nil)) (handler-case (let* ((dir (and dir (bundle-dir dir))) (found-stamp (and dir (bundle-stamp dir)))) (setf stamp found-stamp) (cond ((null dir) (list :status :no-bundle :reason "no bundle directory")) ((null found-stamp) (list :status :no-bundle :dir (namestring dir))) ((and (not force) *code-stamp* (equal found-stamp *code-stamp*)) (list :status :current :stamp *code-stamp*)) (t (let* ((files (bundle-files dir)) (loads (bundle-load-files dir files)) (primitives runabout.api::*primitives*)) (setf loading t runabout.api::*primitives* '()) (handler-case (progn (dolist (entry loads) (load (cdr entry) :verbose nil :print nil)) (when (null runabout.api::*primitives*) (error "The bundle left no primitives, so it was not complete.")) (setf *code* dir *code-stamp* found-stamp) (unless quiet (format *error-output* "; code refreshed to build ~a (~a files)~%" found-stamp (length files))) (list :status :refreshed :stamp found-stamp :files (length files))) (error (e) (setf runabout.api::*primitives* primitives) (error e))))))) (error (e) (when loading (setf *code-stamp* nil)) (unless quiet (format *error-output* "~&runabout: code refresh failed~a: ~a~%" (if loading " after loading began (image may be partially updated)" "") e)) (list :status :failed :stamp stamp :partial loading :error (princ-to-string e))))))
(defun watch-code () "Bundle upgrades are supervised by the harness before a core is published." (add-restore-hook (lambda () nil) :name "code"))
(defun runabout.api::reload (&key force dir) "Refresh code now from the active bundle or DIR. A failed load reports whetherit may have partly updated the image; loaded definitions and values can change." (refresh-code :dir (or dir *code*) :force force))
(watch-code)