Ignore:
Timestamp:
Aug 11, 2008, 3:49:48 AM (11 years ago)
Author:
gb
Message:

Merge a lot of the CLOS/type-system changes from working-0711 branch
into trunk. Todo: compiler-macros for those changes.

Have -not- yet merged source-tracking changes, new record-source file
from working-0711, but this stuff seems to bootstrap in one swell foop.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-readloop-lds.lisp

    r8791 r10426  
    9191
    9292
     93(defun list-restarts ()
     94  (format *debug-io* "~&>   Type (:C <n>) to invoke one of the following restarts:")
     95  (display-restarts))
     96
    9397(define-toplevel-command :break pop () "exit current break loop" (abort-break))
    9498(define-toplevel-command :break a () "exit current break loop" (abort-break))
    9599(define-toplevel-command :break go () "continue" (continue))
    96100(define-toplevel-command :break q () "return to toplevel" (toplevel))
    97 (define-toplevel-command :break r () "list restarts"
    98   (format t "~&   (:C <n>) can be used to invoke one of the following restarts in this break loop:")
    99   (let* ((r (apply #'vector (compute-restarts *break-condition*))))
    100     (dotimes (i (length r) (terpri))
    101       (format *debug-io* "~&~d. ~a" i (svref r i)))))
    102 
    103 ;;; From Marco Baringer 2003/03/18
     101(define-toplevel-command :break r () "list restarts" (list-restarts))
    104102
    105103(define-toplevel-command :break set (n frame value) "Set <n>th item of frame <frame> to <value>"
     
    110108
    111109(define-toplevel-command :break nframes ()
    112                          "print the number of stack frames accessible from this break loop"
    113                          (do* ((p *break-frame* (parent-frame p nil))
    114                                (i 0 (1+ i))
    115                                (last (last-frame-ptr)))
    116                               ((eql p last) (toplevel-print (list i)))))
     110  "print the number of stack frames accessible from this break loop"
     111  (do* ((p *break-frame* (parent-frame p nil))
     112        (i 0 (1+ i))
     113        (last (last-frame-ptr)))
     114      ((eql p last) (toplevel-print (list i)))))
    117115
    118116(define-toplevel-command :global ? () "help"
     117  (format t "~&The following toplevel commands are available:")
     118  (when *default-integer-command*
     119    (format t "~& <n>  ~8Tthe same as (~s <n>)" (car *default-integer-command*)))
    119120  (dolist (g *active-toplevel-commands*)
    120121    (dolist (c (cdr g))
     
    124125        (if args
    125126          (format t "~& (~S~{ ~A~}) ~8T~A" command args doc)
    126           (format t "~& ~S  ~8T~A" command doc))))))
     127          (format t "~& ~S  ~8T~A" command doc)))))
     128  (format t "~&Any other form is evaluated and its results are printed out."))
    127129
    128130
     
    242244(%use-toplevel-commands :global)
    243245
     246(defparameter *toplevel-commands-dwim* t "If true, tries to interpret otherwise-erroneous toplevel
     247expressions as commands")
     248
     249(defvar *default-integer-command* nil
     250  "If non-nil, should be (keyword  min max)), causing integers between min and max to be
     251  interpreted as (keyword integer)")
     252
    244253(defun check-toplevel-command (form)
     254  (when (and *default-integer-command*
     255             (integerp form)
     256             (<= (cadr *default-integer-command*) form (caddr *default-integer-command*)))
     257    (setq form `(,(car *default-integer-command*) ,form)))
    245258  (let* ((cmd (if (consp form) (car form) form))
    246259         (args (if (consp form) (cdr form))))
    247     (if (keywordp cmd)
     260    (when (or (keywordp cmd)
     261              (and *toplevel-commands-dwim*
     262                   (non-nil-symbol-p cmd)
     263                   (not (if (consp form) (fboundp cmd) (boundp cmd)))
     264                   ;; Use find-symbol so don't make unneeded keywords.
     265                   (setq cmd (find-symbol (symbol-name cmd) :keyword))))
     266      (when (eq cmd :help) (setq cmd :?))
    248267      (dolist (g *active-toplevel-commands*)
    249         (when
    250             (let* ((pair (assoc cmd (cdr g))))
    251               (if pair
    252                 (progn (apply (cadr pair) args)
    253                        t)))
    254           (return t))))))
     268        (let* ((pair (assoc cmd (cdr g))))
     269          (when pair
     270            (apply (cadr pair) args)
     271            (return t)))))))
    255272
    256273(defparameter *quit-on-eof* nil)
     
    264281                       (output-stream *standard-output*)
    265282                       (break-level *break-level*)
    266                        (prompt-function #'(lambda (stream) (print-listener-prompt stream t))))
     283                       (prompt-function #'(lambda (stream)
     284                                            (when (and *show-available-restarts* *break-condition*)
     285                                              (list-restarts)
     286                                              (setf *show-available-restarts* nil))
     287                                            (print-listener-prompt stream t))))
    267288  (let* ((*break-level* break-level)
    268289         (*last-break-level* break-level)
     
    270291         *in-read-loop*
    271292         *** ** * +++ ++ + /// // / -
    272          (eof-value (cons nil nil)))
     293         (eof-value (cons nil nil))
     294         (*show-available-restarts* (and *show-restarts-on-break* *break-condition*)))
    273295    (declare (dynamic-extent eof-value))
    274296    (loop
     
    558580(defvar *break-frame* nil "frame-pointer arg to break-loop")
    559581(defvar *break-loop-when-uninterruptable* t)
     582(defvar *show-restarts-on-break* #+ccl-0711 t #-ccl-0711 nil)
     583(defvar *show-available-restarts* nil)
    560584
    561585(defvar *error-reentry-count* 0)
     
    609633                 (*print-length* *error-print-length*)
    610634                                        ;(*print-pretty* nil)
    611                  (*print-array* nil))
    612             (format t "~&> Type :GO to continue, :POP to abort, :R for a list of available restarts.")
    613             (format t "~&> If continued: ~A~%" continue))
    614           (format t "~&> Type :POP to abort, :R for a list of available restarts.~%"))
     635                   (*print-array* nil))
     636              (format t "~&> Type :GO to continue, :POP to abort, :R for a list of available restarts.")
     637              (format t "~&> If continued: ~A~%" continue))
     638            (format t "~&> Type :POP to abort, :R for a list of available restarts.~%"))
    615639        (format t "~&> Type :? for other options.")
    616640        (terpri)
     
    624648                (application-ui-operation *application*
    625649                                          :enter-backtrace-context context)
    626                   (read-loop :break-level (1+ *break-level*)
    627                              :input-stream *debug-io*
    628                              :output-stream *debug-io*))
     650                (read-loop :break-level (1+ *break-level*)
     651                           :input-stream *debug-io*
     652                           :output-stream *debug-io*))
    629653           (application-ui-operation *application* :exit-backtrace-context
    630654                                     context)))))))
     
    633657
    634658(defun display-restarts (&optional (condition *break-condition*))
    635   (let ((i 0))
    636     (format t "~&[Pretend that these are buttons.]")
    637     (dolist (r (compute-restarts condition) i)
    638       (format t "~&~a : ~A" i r)
    639       (setq i (%i+ i 1)))
    640     (fresh-line nil)))
     659  (loop
     660    for restart in (compute-restarts condition)
     661    for count upfrom 0
     662    do (format *debug-io* "~&~D. ~A" count restart)
     663    finally (fresh-line *debug-io*)))
    641664
    642665(defun select-restart (n &optional (condition *break-condition*))
Note: See TracChangeset for help on using the changeset viewer.