cgit.sxemacs.org Git - packages/blob - xemacs-packages/ilisp/ild.mail

   1 From @yonge.csri.toronto.edu:qobi@csri.toronto.edu Sun Jul  3 00:43:43 1994
   2 From: Jeffrey Mark Siskind <qobi@csri.toronto.edu>
   3 To: campbell@c2.net (Rick Campbell)
   4 Cc: marcoxa@cs.NYU.EDU
   5 In-Reply-To: campbell@c2.net's message of Wed, 29 Jun 1994 19:21:41 GMT
   6 Subject: ILISP
   7 Reply-To: Qobi@CS.Toronto.EDU
   8 Date:   Sun, 3 Jul 1994 00:43:19 -0400
   9
  10 I think it is great that you are willing to maintain ILisp. ILisp is the most
  11 viable Lisp development environment available. I use it many hours a day.
  12
  13 I'd like to contribute an addition to ILisp. I wrote a package that uses a
  14 standard set of single-keystroke bindings to interface with a variety of
  15 different debuggers. It is vaguely modelled after the Symbolics debugger. It
  16 provides two key advantages: single keystrokes for moving up and down the
  17 stack, and a uniform interface to different debuggers. I find that useful
  18 since I often work simultaneously with different Lisps and can never remember
  19 the particulars of each one's debugger.
  20
  21 Anyway, I think that it would be of great use to others. It shouldn't take you
  22 very long to `officially' integrate it with ILisp. It basically works already
  23 with Lucid, Allegro, CMUCL, and AKCL and is fairly reliable. I've used it for
  24 years already. Not all debugger commands are available in all implementations.
  25 Some are but I didn't know how to get them to work. These are noted in the
  26 code. If you know how to fix them that would be great.
  27
  28 I also have written an improved debugger for use with Scheme->C along with an
  29 interface between that debugger and ILD. There are still some problems that I
  30 have to iron out though before I release that code.
  31
  32 I hereby give you permission to distribute this code to anyone subject to the
  33 restrictions that it is available on an as is basis with no guarantee of its
  34 correctness of suitability for any purpose, that I am not held liable for
  35 damages resulting from its use, and that I be given credit by name for this
  36 contribution.
  37     Jeff (home page http://www.cdf.toronto.edu:/DCS/Personal/Siskind.html)
  38 -------------------------------------------------------------------------------
  39 ;;; ILD: A common Common Lisp debugger user interface for ILisp.
  40 ;;;   ---Jeffrey Mark Siskind
  41
  42 ;;; Keystroke c-u? What it does
  43 ;;; ---------------------------------------------------------
  44 ;;; m-a            Abort
  45 ;;; m-c            Continue
  46 ;;; c-m-n     *    Next stack frame
  47 ;;; c-m-p     *    Previous stack frame
  48 ;;; c-c <          Top stack frame
  49 ;;; c-c >          Bottom stack frame
  50 ;;; m-b            Backtrace
  51 ;;; c-m-d          Display all locals
  52 ;;; c-m-l     *    Display particular local
  53 ;;; c-c r          Return
  54 ;;; c-m-r          Retry
  55 ;;; c-x t          Trap on exit
  56 ;;; c-c L          Select Lisp interaction buffer
  57 ;;; c-z c-s        Sets compiler options for maximally debuggablity
  58 ;;; c-z c-f        Sets compiler options for fastest but least debuggable code
  59
  60 (require 'ilisp)
  61
  62 (deflocal ild-abort-string nil)
  63 (deflocal ild-continue-string nil)
  64 (deflocal ild-next-string nil)
  65 (deflocal ild-next-string-arg nil)
  66 (deflocal ild-previous-string nil)
  67 (deflocal ild-previous-string-arg nil)
  68 (deflocal ild-top-string nil)
  69 (deflocal ild-bottom-string nil)
  70 (deflocal ild-backtrace-string nil)
  71 (deflocal ild-locals-string nil)
  72 (deflocal ild-local-string-arg nil)
  73 (deflocal ild-return-string nil)
  74 (deflocal ild-retry-string nil)
  75 (deflocal ild-trap-on-exit-string nil)
  76
  77 (defun ild-debugger-command (string)
  78  (process-send-string (get-buffer-process (current-buffer))
  79                       (format "%s\n" string)))
  80
  81 (defun ild-prompt ()
  82  (save-excursion
  83   (beginning-of-line)
  84   (comint-skip-prompt)
  85   (eobp)))
  86
  87 (defun ild-abort ()
  88  (interactive)
  89  (if ild-abort-string
  90      (ild-debugger-command ild-abort-string)
  91      (beep)))
  92
  93 (defun ild-continue (&optional arg)
  94  (interactive "P")
  95  (if (ild-prompt)
  96      (if ild-continue-string
  97          (ild-debugger-command ild-continue-string)
  98          (beep))
  99      (if arg (capitalize-word arg) (capitalize-word 1))))
 100
 101 (defun ild-next (&optional arg)
 102  (interactive "P")
 103  (if arg
 104      (if ild-next-string-arg
 105          (ild-debugger-command (format ild-next-string-arg arg))
 106          (beep))
 107      (if ild-next-string
 108          (ild-debugger-command ild-next-string)
 109          (beep))))
 110
 111 (defun ild-previous (&optional arg)
 112  (interactive "P")
 113  (if arg
 114      (if ild-previous-string-arg
 115          (ild-debugger-command (format ild-previous-string-arg arg))
 116          (beep))
 117      (if ild-previous-string
 118          (ild-debugger-command ild-previous-string)
 119          (beep))))
 120
 121 (defun ild-top (&optional arg)
 122  (interactive "P")
 123  (if ild-top-string
 124      (ild-debugger-command ild-top-string)
 125      (beep)))
 126
 127 (defun ild-bottom (&optional arg)
 128  (interactive "P")
 129  (if ild-bottom-string
 130      (ild-debugger-command ild-bottom-string)
 131      (beep)))
 132
 133 (defun ild-backtrace (&optional arg)
 134  (interactive "P")
 135  (if (ild-prompt)
 136      (if ild-backtrace-string
 137          (ild-debugger-command ild-backtrace-string)
 138          (beep))
 139      (if arg (backward-word arg) (backward-word 1))))
 140
 141 (defun ild-locals (&optional arg)
 142  (interactive "P")
 143  (if ild-locals-string
 144      (ild-debugger-command ild-locals-string)
 145      (beep)))
 146
 147 (defun ild-local (&optional arg)
 148  (interactive "P")
 149  (if arg
 150      (if ild-local-string-arg
 151          (ild-debugger-command (format ild-local-string-arg arg))
 152          (beep))
 153      (if ild-locals-string
 154          (ild-debugger-command ild-locals-string)
 155          (beep))))
 156
 157 (defun ild-return ()
 158  (interactive)
 159  (if ild-return-string
 160      (ild-debugger-command ild-return-string)
 161      (beep)))
 162
 163 (defun ild-retry ()
 164  (interactive)
 165  (if ild-retry-string
 166      (ild-debugger-command ild-retry-string)
 167      (beep)))
 168
 169 (defun ild-trap-on-exit (&optional arg)
 170  (interactive "P")
 171  (if ild-trap-on-exit-string
 172      (ild-debugger-command ild-trap-on-exit-string)
 173      (beep)))
 174
 175 (defun fast-lisp ()
 176  "Use the production compiler."
 177  (interactive)
 178  (ilisp-send "(progn (proclaim '(optimize (speed 3) (safety 0) (space 0) (compilation-speed 0) (debug 0))) #+akcl (use-fast-links t))"))
 179
 180 (defun slow-lisp ()
 181  "Use the development compiler."
 182  (interactive)
 183  (ilisp-send "(progn (proclaim '(optimize (speed 0) (safety 3) (space 3) (compilation-speed 3) (debug 3))) #+akcl (use-fast-links nil))"))
 184
 185 (defun select-lisp ()
 186  "Select the lisp buffer in one window mode"
 187  (interactive)
 188  (cond ((and (lisp-mem ilisp-buffer
 189                        (buffer-list)
 190                        (function (lambda (x y) (equal x (buffer-name y)))))
 191              (get-buffer-process (get-buffer ilisp-buffer)))
 192         (delete-other-windows)
 193         (switch-to-buffer ilisp-buffer))
 194        (t (lucid)                       ;put your favorite Lisp here
 195           (delete-other-windows))))
 196
 197 (defun select-ilisp (arg)
 198  "Select the current ILISP buffer."
 199  (interactive "P")
 200  (if (and (not arg)
 201           (lisp-mem
 202            (buffer-name (current-buffer))
 203            ilisp-buffers
 204            (function (lambda (x y) (equal x (format "*%s*" (car y)))))))
 205      (setq ilisp-buffer (buffer-name (current-buffer)))
 206      (let ((new (completing-read
 207                  (if ilisp-buffer
 208                      (format "Buffer [%s]: "
 209                              (substring ilisp-buffer 1
 210                                         (1- (length ilisp-buffer))))
 211                      "Buffer: ")
 212                  ilisp-buffers nil t)))
 213       (if (not (zerop (length new)))
 214           (setq ilisp-buffer (format "*%s*" new))))))
 215
 216 ;;; This fixes a bug in ILISP 4.1
 217
 218 (defun defkey-ilisp (key command &optional inferior-only)
 219  "Define KEY as COMMAND in ilisp-mode-map and lisp-mode-map unless
 220 optional INFERIOR-ONLY is T.  If the maps do not exist they will be
 221 created.  This should only be called after ilisp-prefix is set to the
 222 desired prefix."
 223  (if (not ilisp-mode-map) (ilisp-bindings))
 224  (define-key ilisp-mode-map key command)
 225  (if (not inferior-only) (define-key lisp-mode-map key command)))
 226
 227 ;;; This is a convenient command since c-Z c-W doesn't default to the whole
 228 ;;; buffer if there is no region
 229
 230 (defun compile-buffer ()
 231  "Compile the current buffer"
 232  (interactive)
 233  (compile-region-and-go-lisp (point-min) (point-max)))
 234
 235 (defkey-ilisp "\M-a"    'ild-abort t)
 236 (defkey-ilisp "\M-c"    'ild-continue t)
 237 (defkey-ilisp "\C-\M-n" 'ild-next t)
 238 (defkey-ilisp "\C-\M-p" 'ild-previous t)
 239 (defkey-ilisp "\C-c<"   'ild-top t)
 240 (defkey-ilisp "\C-c>"   'ild-bottom t)
 241 (defkey-ilisp "\M-b"    'ild-backtrace t)
 242 (defkey-ilisp "\C-\M-d" 'ild-locals t)
 243 (defkey-ilisp "\C-\M-l" 'ild-local t)
 244 (defkey-ilisp "\C-cr"   'ild-return t)
 245 (defkey-ilisp "\C-\M-r" 'ild-retry t)
 246 (defkey-ilisp "\C-xt"   'ild-trap-on-exit t)
 247 (define-key   global-map     "\C-cL" 'select-lisp)
 248 (ilisp-defkey lisp-mode-map  "\C-f"  'fast-lisp)
 249 (ilisp-defkey ilisp-mode-map "\C-f"  'fast-lisp)
 250 (ilisp-defkey lisp-mode-map  "\C-s"  'slow-lisp)
 251 (ilisp-defkey ilisp-mode-map "\C-s"  'slow-lisp)
 252
 253 (defdialect clisp "Common LISP" ilisp
 254  (setq ilisp-load-or-send-command
 255        "(or (and (load \"%s\" :if-does-not-exist nil) t)
 256              (and (load \"%s\" :if-does-not-exist nil) t))")
 257  (ilisp-load-init 'clisp "clisp")
 258  (setq ilisp-package-regexp "^[ \t]*(in-package[ \t\n]*"
 259        ilisp-package-command "(let ((*package* *package*)) %s (package-name *package*))"
 260        ilisp-package-name-command "(package-name *package*)"
 261        ilisp-in-package-command "(in-package \"%s\")"
 262        ilisp-last-command "*"
 263        ilisp-save-command "(progn (ILISP:ilisp-save) %s\n)"
 264        ilisp-restore-command "(ILISP:ilisp-restore)"
 265        ilisp-block-command "(progn %s\n)"
 266        ilisp-eval-command "(ILISP:ilisp-eval \"%s\" \"%s\" \"%s\")"
 267        ilisp-defvar-regexp "(defvar[ \t\n]")
 268  (setq ilisp-defvar-command
 269        "(ILISP:ilisp-eval \"(let ((form '%s)) (progn (makunbound (second form)) (eval form)))\" \"%s\" \"%s\")")
 270  (setq ilisp-compile-command "(ILISP:ilisp-compile \"%s\" \"%s\" \"%s\")"
 271        ilisp-describe-command "(ILISP:ilisp-describe \"%s\" \"%s\")"
 272        ilisp-inspect-command "(ILISP:ilisp-inspect \"%s\" \"%s\")"
 273        ilisp-arglist-command "(ILISP:ilisp-arglist \"%s\" \"%s\")")
 274  (setq ilisp-documentation-types
 275        '(("function") ("variable")
 276          ("structure") ("type")
 277          ("setf") ("class")
 278          ("(qualifiers* (class ...))")))
 279  (setq ilisp-documentation-command
 280        "(ILISP:ilisp-documentation \"%s\" \"%s\" \"%s\")")
 281  (setq ilisp-macroexpand-1-command
 282        "(ILISP:ilisp-macroexpand-1 \"%s\" \"%s\")")
 283  (setq ilisp-macroexpand-command "(ILISP:ilisp-macroexpand \"%s\" \"%s\")")
 284  (setq ilisp-complete-command
 285        "(ILISP:ilisp-matching-symbols \"%s\" \"%s\" %s %s %s)")
 286  (setq ilisp-locator 'lisp-locate-clisp)
 287  (setq ilisp-source-types
 288        '(("function") ("macro") ("variable")
 289          ("structure") ("type")
 290          ("setf") ("class")
 291          ("(qualifiers* (class ...))")))
 292  (setq ilisp-callers-command "(ILISP:ilisp-callers \"%s\" \"%s\")"
 293        ilisp-trace-command "(ILISP:ilisp-trace \"%s\" \"%s\" \"%s\")"
 294        ilisp-untrace-command "(ILISP:ilisp-untrace \"%s\" \"%s\")")
 295  (setq ilisp-directory-command "(namestring *default-pathname-defaults*)"
 296        ilisp-set-directory-command
 297        "(setq *default-pathname-defaults* (parse-namestring \"%s\"))")
 298  (setq ilisp-load-command "(load \"%s\")")
 299  (setq ilisp-compile-file-command
 300        "(ILISP:ilisp-compile-file \"%s\" \"%s\")"))
 301
 302 (defdialect lucid "Lucid Common LISP" clisp
 303  (ilisp-load-init 'lucid "lucid")
 304  (setq comint-prompt-regexp "^\\(->\\)+ \\|^[^> ]*> "
 305        comint-fix-error ":a"
 306        ilisp-reset ":a :t"
 307        comint-continue ":c"
 308        comint-interrupt-regexp ">>Break: Keyboard interrupt"
 309        comint-prompt-status
 310        (function (lambda (old line)
 311                   (comint-prompt-status old line 'lucid-check-prompt))))
 312  (setq ilisp-error-regexp "ILISP:[^\"]*\\|>>[^\n]*")
 313  (setq ilisp-source-types (append ilisp-source-types '(("any"))))
 314  (setq ilisp-find-source-command
 315        "(ILISP:ilisp-source-files \"%s\" \"%s\" \"%s\")")
 316  (setq ilisp-binary-command
 317        "(first (last lucid::*load-binary-pathname-types*))")
 318  (setq ild-abort-string ":A"
 319        ild-continue-string ":C"
 320        ild-next-string ":N"
 321        ild-next-string-arg ":N %s"
 322        ild-previous-string ":P"
 323        ild-previous-string-arg ":P %s"
 324        ild-top-string ":<"
 325        ild-bottom-string ":>"
 326        ild-backtrace-string ":B"
 327        ild-locals-string ":V"
 328        ild-local-string-arg ":L %s"
 329        ild-return-string ":R"
 330        ild-retry-string ":F"
 331        ild-trap-on-exit-string ":X T"))
 332 (setq lucid-program "lisp")
 333
 334 (defdialect allegro "Allegro Common LISP" clisp
 335  (ilisp-load-init 'allegro "allegro")
 336  (setq comint-fix-error ":pop"
 337        ilisp-reset ":reset"
 338        comint-continue ":cont"
 339        comint-interrupt-regexp  "Error: [^\n]* interrupt\)")
 340  (setq comint-prompt-status
 341        (function (lambda (old line)
 342                   (comint-prompt-status old line 'allegro-check-prompt))))
 343  ;; <cl> or package> at top-level
 344  ;; [0-9c] <cl> or package> in error
 345  ;; (setq comint-prompt-regexp "^\\(\\[[0-9]*c*\\] \\|\\)\\(<\\|\\)[^>]*> ")
 346  (setq comint-prompt-regexp "^\\(\\[[0-9]+i?c?\\] \\|\\[step\\] \\)?\\(<?[-A-Za-z]* ?[0-9]*?>\\|[-A-Za-z0-9]+([0-9]+):\\) ")
 347  (setq ilisp-error-regexp
 348        "\\(ILISP:[^\"]*\\)\\|\\(Error:[^\n]*\\)\\|\\(Break:[^\n]*\\)")
 349
 350  (setq ilisp-binary-command "excl:*fasl-default-type*")
 351  (setq ilisp-source-types (append ilisp-source-types '(("any"))))
 352  (setq ilisp-find-source-command
 353        "(ILISP:ilisp-source-files \"%s\" \"%s\" \"%s\")")
 354  (setq ilisp-init-binary-command
 355        "(let ((ext (or #+m68k \"68fasl\"
 356                         #+sparc \"sfasl\"
 357                         #+iris4d \"ifasl\"
 358                         #+dec3100 \"pfasl\"
 359                         excl:*fasl-default-type*)))
 360            #+allegro-v4.0 (setq ext (concatenate 'string ext \"4\"))
 361            ext)")
 362  (setq ild-abort-string ":pop"
 363        ild-continue-string ":cont"
 364        ild-next-string ":dn"
 365        ild-next-string-arg ":dn %s"
 366        ild-previous-string ":up"
 367        ild-previous-string-arg ":up %s"
 368        ild-top-string ":to"
 369        ild-bottom-string ":bo"
 370        ild-backtrace-string ":bt"
 371        ild-locals-string ":local"
 372        ild-local-string-arg ":local %s"
 373        ild-return-string nil            ;needs work
 374        ild-retry-string ":rest"
 375        ild-trap-on-exit-string ":boe"))
 376 (setq allegro-program "cl")
 377
 378 (defdialect akcl "Austin Kyoto Common LISP" kcl
 379  (setq comint-prompt-regexp "^[-A-Z]*>+")
 380  (setq ild-abort-string ":q"
 381        ild-continue-string ":r"
 382        ild-next-string ":up"
 383        ild-next-string-arg ":up %s"
 384        ild-previous-string ":down"
 385        ild-previous-string-arg ":down %s"
 386        ild-top-string ":down 1000000"
 387        ild-bottom-string ":up 1000000"
 388        ild-backtrace-string ":bt"
 389        ild-locals-string ":fr"
 390        ild-local-string-arg ":loc %s"
 391        ild-return-string ":r"
 392        ild-retry-string nil             ;needs work
 393        ild-trap-on-exit-string nil))    ;needs work
 394 (setq akcl-program "akcl")
 395
 396 (defdialect cmulisp "CMU Common LISP" clisp
 397  (ilisp-load-init 'cmu "cmulisp")
 398  (if cmulisp-local-source-directory
 399      (setq ilisp-source-directory-fixup-alist
 400            (list
 401             (cons cmulisp-source-directory-regexp
 402                   cmulisp-local-source-directory)))
 403      (message "cmulisp-local-source-directory not set."))
 404  (setq comint-prompt-regexp "^\\([0-9]+\\]+\\|\\*\\) "
 405        ilisp-trace-command "(ILISP:cmulisp-trace \"%s\" \"%s\" \"%s\")"
 406        comint-prompt-status
 407        (function (lambda (old line)
 408                   (comint-prompt-status old line 'cmulisp-check-prompt)))
 409        ilisp-error-regexp "ILISP:[^\"]*\\|Error [^\n]*"
 410        ilisp-arglist-command "(ILISP:arglist \"%s\" \"%s\")"
 411        ilisp-find-source-command "(ILISP:source-file \"%s\" \"%s\" \"%s\")"
 412        comint-fix-error ":pop"
 413        comint-continue ":go"
 414        ilisp-reset ":q"
 415        comint-interrupt-regexp "Interrupted at"
 416        ilisp-binary-extension "sparcf")
 417  (setq ild-abort-string ":abort"
 418        ild-continue-string ":go"
 419        ild-next-string ":down"
 420        ild-next-string-arg nil          ;needs work
 421        ild-previous-string ":up"
 422        ild-previous-string-arg nil      ;needs work
 423        ild-top-string ":bottom"
 424        ild-bottom-string ":top"
 425        ild-backtrace-string ":backtrace"
 426        ild-locals-string ":l"
 427        ild-local-string-arg "(debug:arg %s)"
 428        ild-return-string nil            ;needs work (debug:debug-return x)
 429        ild-retry-string nil             ;needs work
 430        ild-trap-on-exit-string nil))    ;needs work
 431 (setq cmulisp-program "cmucl")
 432
 433