- (macrolet
- ((do-sexprs (((sexpr index) stream) &body body)
- (aver (symbolp sexpr))
- (with-unique-names (source-info)
- (once-only ((stream stream))
- `(if (handler-case (pathname stream)
- (error () nil))
- (let* ((,source-info (sb!c::make-file-source-info
- (pathname ,stream)
- (stream-external-format ,stream)))
- (sb!c::*source-info* ,source-info)
- (sb!c::*source-paths* (make-hash-table :test 'eq)))
- (setf (sb!c::source-info-stream ,source-info) ,stream)
- (sb!c::do-forms-from-info ((,sexpr current-index)
- ,source-info)
- (sb!c::find-source-paths ,sexpr current-index)
- (let ((,index current-index))
- ,@body)))
- (let ((sb!c::*source-info* nil)
- (,index nil))
- (do ((,sexpr (read ,stream nil *eof-object*)
- (read ,stream nil *eof-object*)))
- ((eq ,sexpr *eof-object*))
- ,@body)))))))
- (do-sexprs ((sexpr tlf-index) stream)
- (if print
- (let ((results (multiple-value-list (eval-tlf sexpr tlf-index))))
- (load-fresh-line)
- (format t "~{~S~^, ~}~%" results))
- (eval-tlf sexpr tlf-index)))
- t))
+ (let* ((pathname (ignore-errors (translate-logical-pathname stream)))
+ (native (when pathname (native-namestring pathname))))
+ (with-simple-restart (abort "Abort ~A file ~S." context native)
+ (flet ((eval-form (form index)
+ (with-simple-restart (continue "Ignore error and continue ~A file ~S."
+ context native)
+ (loop
+ (with-simple-restart (retry "Retry EVAL of current toplevel form.")
+ (if print
+ (let ((results (multiple-value-list (eval-tlf form index))))
+ (load-fresh-line)
+ (format t "~{~S~^, ~}~%" results))
+ (eval-tlf form index)))
+ (return)))))
+ (if pathname
+ (let* ((info (sb!c::make-file-source-info
+ pathname (stream-external-format stream)))
+ (sb!c::*source-info* info))
+ (setf (sb!c::source-info-stream info) stream)
+ (sb!c::do-forms-from-info ((form current-index) info)
+ (sb!c::with-source-paths
+ (sb!c::find-source-paths form current-index)
+ (eval-form form current-index))))
+ (let ((sb!c::*source-info* nil))
+ (do ((form (read stream nil *eof-object*)
+ (read stream nil *eof-object*)))
+ ((eq form *eof-object*))
+ (sb!c::with-source-paths
+ (eval-form form nil))))))))
+ t)