diff lisp/ilisp/ild.mail @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children b82b59fe008d
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/ilisp/ild.mail	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,433 @@
+From @yonge.csri.toronto.edu:qobi@csri.toronto.edu Sun Jul  3 00:43:43 1994
+From: Jeffrey Mark Siskind <qobi@csri.toronto.edu>
+To: rfb@lehman.com (Rick Busdiecker)
+Cc: marcoxa@cs.NYU.EDU
+In-Reply-To: rfb@lehman.com's message of Wed, 29 Jun 1994 19:21:41 GMT
+Subject: ILISP
+Reply-To: Qobi@CS.Toronto.EDU
+Date: 	Sun, 3 Jul 1994 00:43:19 -0400
+
+I think it is great that you are willing to maintain ILisp. ILisp is the most
+viable Lisp development environment available. I use it many hours a day.
+
+I'd like to contribute an addition to ILisp. I wrote a package that uses a
+standard set of single-keystroke bindings to interface with a variety of
+different debuggers. It is vaguely modelled after the Symbolics debugger. It
+provides two key advantages: single keystrokes for moving up and down the
+stack, and a uniform interface to different debuggers. I find that useful
+since I often work simultaneously with different Lisps and can never remember
+the particulars of each one's debugger.
+
+Anyway, I think that it would be of great use to others. It shouldn't take you
+very long to `officially' integrate it with ILisp. It basically works already
+with Lucid, Allegro, CMUCL, and AKCL and is fairly reliable. I've used it for
+years already. Not all debugger commands are available in all implementations.
+Some are but I didn't know how to get them to work. These are noted in the
+code. If you know how to fix them that would be great.
+
+I also have written an improved debugger for use with Scheme->C along with an
+interface between that debugger and ILD. There are still some problems that I
+have to iron out though before I release that code.
+
+I hereby give you permission to distribute this code to anyone subject to the
+restrictions that it is available on an as is basis with no guarantee of its
+correctness of suitability for any purpose, that I am not held liable for
+damages resulting from its use, and that I be given credit by name for this
+contribution.
+    Jeff (home page http://www.cdf.toronto.edu:/DCS/Personal/Siskind.html)
+-------------------------------------------------------------------------------
+;;; ILD: A common Common Lisp debugger user interface for ILisp.
+;;;   ---Jeffrey Mark Siskind
+
+;;; Keystroke c-u? What it does
+;;; ---------------------------------------------------------
+;;; m-a            Abort
+;;; m-c            Continue
+;;; c-m-n     *    Next stack frame
+;;; c-m-p     *    Previous stack frame
+;;; c-c <          Top stack frame
+;;; c-c >          Bottom stack frame
+;;; m-b            Backtrace
+;;; c-m-d          Display all locals
+;;; c-m-l     *    Display particular local
+;;; c-c r          Return
+;;; c-m-r          Retry
+;;; c-x t          Trap on exit
+;;; c-c L          Select Lisp interaction buffer
+;;; c-z c-s        Sets compiler options for maximally debuggablity
+;;; c-z c-f        Sets compiler options for fastest but least debuggable code
+
+(require 'ilisp)
+
+(deflocal ild-abort-string nil)
+(deflocal ild-continue-string nil)
+(deflocal ild-next-string nil)
+(deflocal ild-next-string-arg nil)
+(deflocal ild-previous-string nil)
+(deflocal ild-previous-string-arg nil)
+(deflocal ild-top-string nil)
+(deflocal ild-bottom-string nil)
+(deflocal ild-backtrace-string nil)
+(deflocal ild-locals-string nil)
+(deflocal ild-local-string-arg nil)
+(deflocal ild-return-string nil)
+(deflocal ild-retry-string nil)
+(deflocal ild-trap-on-exit-string nil)
+
+(defun ild-debugger-command (string)
+ (process-send-string (get-buffer-process (current-buffer))
+		      (format "%s\n" string)))
+
+(defun ild-prompt ()
+ (save-excursion
+  (beginning-of-line)
+  (comint-skip-prompt)
+  (eobp)))
+
+(defun ild-abort ()
+ (interactive)
+ (if ild-abort-string
+     (ild-debugger-command ild-abort-string)
+     (beep)))
+
+(defun ild-continue (&optional arg)
+ (interactive "P")
+ (if (ild-prompt)
+     (if ild-continue-string
+	 (ild-debugger-command ild-continue-string)
+	 (beep))
+     (if arg (capitalize-word arg) (capitalize-word 1))))
+
+(defun ild-next (&optional arg)
+ (interactive "P")
+ (if arg
+     (if ild-next-string-arg
+	 (ild-debugger-command (format ild-next-string-arg arg))
+	 (beep))
+     (if ild-next-string
+	 (ild-debugger-command ild-next-string)
+	 (beep))))
+
+(defun ild-previous (&optional arg)
+ (interactive "P")
+ (if arg
+     (if ild-previous-string-arg
+	 (ild-debugger-command (format ild-previous-string-arg arg))
+	 (beep))
+     (if ild-previous-string
+	 (ild-debugger-command ild-previous-string)
+	 (beep))))
+
+(defun ild-top (&optional arg)
+ (interactive "P")
+ (if ild-top-string
+     (ild-debugger-command ild-top-string)
+     (beep)))
+
+(defun ild-bottom (&optional arg)
+ (interactive "P")
+ (if ild-bottom-string
+     (ild-debugger-command ild-bottom-string)
+     (beep)))
+
+(defun ild-backtrace (&optional arg)
+ (interactive "P")
+ (if (ild-prompt)
+     (if ild-backtrace-string
+	 (ild-debugger-command ild-backtrace-string)
+	 (beep))
+     (if arg (backward-word arg) (backward-word 1))))
+
+(defun ild-locals (&optional arg)
+ (interactive "P")
+ (if ild-locals-string
+     (ild-debugger-command ild-locals-string)
+     (beep)))
+
+(defun ild-local (&optional arg)
+ (interactive "P")
+ (if arg
+     (if ild-local-string-arg
+	 (ild-debugger-command (format ild-local-string-arg arg))
+	 (beep))
+     (if ild-locals-string
+	 (ild-debugger-command ild-locals-string)
+	 (beep))))
+
+(defun ild-return ()
+ (interactive)
+ (if ild-return-string
+     (ild-debugger-command ild-return-string)
+     (beep)))
+
+(defun ild-retry ()
+ (interactive)
+ (if ild-retry-string
+     (ild-debugger-command ild-retry-string)
+     (beep)))
+
+(defun ild-trap-on-exit (&optional arg)
+ (interactive "P")
+ (if ild-trap-on-exit-string
+     (ild-debugger-command ild-trap-on-exit-string)
+     (beep)))
+
+(defun fast-lisp ()
+ "Use the production compiler."
+ (interactive)
+ (ilisp-send "(progn (proclaim '(optimize (speed 3) (safety 0) (space 0) (compilation-speed 0) (debug 0))) #+akcl (use-fast-links t))"))
+
+(defun slow-lisp ()
+ "Use the development compiler."
+ (interactive)
+ (ilisp-send "(progn (proclaim '(optimize (speed 0) (safety 3) (space 3) (compilation-speed 3) (debug 3))) #+akcl (use-fast-links nil))"))
+
+(defun select-lisp ()
+ "Select the lisp buffer in one window mode"
+ (interactive)
+ (cond ((and (lisp-mem ilisp-buffer
+		       (buffer-list)
+		       (function (lambda (x y) (equal x (buffer-name y)))))
+	     (get-buffer-process (get-buffer ilisp-buffer)))
+	(delete-other-windows)
+	(switch-to-buffer ilisp-buffer))
+       (t (lucid)			;put your favorite Lisp here
+	  (delete-other-windows))))
+
+(defun select-ilisp (arg)
+ "Select the current ILISP buffer."
+ (interactive "P")
+ (if (and (not arg)
+          (lisp-mem
+	   (buffer-name (current-buffer))
+	   ilisp-buffers
+	   (function (lambda (x y) (equal x (format "*%s*" (car y)))))))
+     (setq ilisp-buffer (buffer-name (current-buffer)))
+     (let ((new (completing-read
+		 (if ilisp-buffer
+		     (format "Buffer [%s]: "
+			     (substring ilisp-buffer 1
+					(1- (length ilisp-buffer))))
+		     "Buffer: ")
+		 ilisp-buffers nil t)))
+      (if (not (zerop (length new)))
+	  (setq ilisp-buffer (format "*%s*" new))))))
+
+;;; This fixes a bug in ILISP 4.1
+
+(defun defkey-ilisp (key command &optional inferior-only)
+ "Define KEY as COMMAND in ilisp-mode-map and lisp-mode-map unless
+optional INFERIOR-ONLY is T.  If the maps do not exist they will be
+created.  This should only be called after ilisp-prefix is set to the
+desired prefix."
+ (if (not ilisp-mode-map) (ilisp-bindings))
+ (define-key ilisp-mode-map key command)
+ (if (not inferior-only) (define-key lisp-mode-map key command)))
+
+;;; This is a convenient command since c-Z c-W doesn't default to the whole
+;;; buffer if there is no region
+
+(defun compile-buffer ()
+ "Compile the current buffer"
+ (interactive)
+ (compile-region-and-go-lisp (point-min) (point-max)))
+
+(defkey-ilisp "\M-a"    'ild-abort t)
+(defkey-ilisp "\M-c"    'ild-continue t)
+(defkey-ilisp "\C-\M-n" 'ild-next t)
+(defkey-ilisp "\C-\M-p" 'ild-previous t)
+(defkey-ilisp "\C-c<"   'ild-top t)
+(defkey-ilisp "\C-c>"   'ild-bottom t)
+(defkey-ilisp "\M-b"    'ild-backtrace t)
+(defkey-ilisp "\C-\M-d" 'ild-locals t)
+(defkey-ilisp "\C-\M-l" 'ild-local t)
+(defkey-ilisp "\C-cr"   'ild-return t)
+(defkey-ilisp "\C-\M-r" 'ild-retry t)
+(defkey-ilisp "\C-xt"   'ild-trap-on-exit t)
+(define-key   global-map     "\C-cL" 'select-lisp)
+(ilisp-defkey lisp-mode-map  "\C-f"  'fast-lisp)
+(ilisp-defkey ilisp-mode-map "\C-f"  'fast-lisp)
+(ilisp-defkey lisp-mode-map  "\C-s"  'slow-lisp)
+(ilisp-defkey ilisp-mode-map "\C-s"  'slow-lisp)
+
+(defdialect clisp "Common LISP" ilisp
+ (setq ilisp-load-or-send-command
+       "(or (and (load \"%s\" :if-does-not-exist nil) t)
+             (and (load \"%s\" :if-does-not-exist nil) t))")
+ (ilisp-load-init 'clisp "clisp")
+ (setq ilisp-package-regexp "^[ \t]*(in-package[ \t\n]*"
+       ilisp-package-command "(let ((*package* *package*)) %s (package-name *package*))"
+       ilisp-package-name-command "(package-name *package*)"
+       ilisp-in-package-command "(in-package \"%s\")"
+       ilisp-last-command "*"
+       ilisp-save-command "(progn (ILISP:ilisp-save) %s\n)"
+       ilisp-restore-command "(ILISP:ilisp-restore)"
+       ilisp-block-command "(progn %s\n)"
+       ilisp-eval-command "(ILISP:ilisp-eval \"%s\" \"%s\" \"%s\")"
+       ilisp-defvar-regexp "(defvar[ \t\n]")
+ (setq ilisp-defvar-command
+       "(ILISP:ilisp-eval \"(let ((form '%s)) (progn (makunbound (second form)) (eval form)))\" \"%s\" \"%s\")")
+ (setq ilisp-compile-command "(ILISP:ilisp-compile \"%s\" \"%s\" \"%s\")"
+       ilisp-describe-command "(ILISP:ilisp-describe \"%s\" \"%s\")"
+       ilisp-inspect-command "(ILISP:ilisp-inspect \"%s\" \"%s\")"
+       ilisp-arglist-command "(ILISP:ilisp-arglist \"%s\" \"%s\")")
+ (setq ilisp-documentation-types
+       '(("function") ("variable")
+	 ("structure") ("type")
+	 ("setf") ("class")
+	 ("(qualifiers* (class ...))")))
+ (setq ilisp-documentation-command
+       "(ILISP:ilisp-documentation \"%s\" \"%s\" \"%s\")")
+ (setq ilisp-macroexpand-1-command
+       "(ILISP:ilisp-macroexpand-1 \"%s\" \"%s\")")
+ (setq ilisp-macroexpand-command "(ILISP:ilisp-macroexpand \"%s\" \"%s\")")
+ (setq ilisp-complete-command
+       "(ILISP:ilisp-matching-symbols \"%s\" \"%s\" %s %s %s)")
+ (setq ilisp-locator 'lisp-locate-clisp)
+ (setq ilisp-source-types
+       '(("function") ("macro") ("variable")
+	 ("structure") ("type")
+	 ("setf") ("class")
+	 ("(qualifiers* (class ...))")))
+ (setq ilisp-callers-command "(ILISP:ilisp-callers \"%s\" \"%s\")"
+       ilisp-trace-command "(ILISP:ilisp-trace \"%s\" \"%s\" \"%s\")"
+       ilisp-untrace-command "(ILISP:ilisp-untrace \"%s\" \"%s\")")
+ (setq ilisp-directory-command "(namestring *default-pathname-defaults*)"
+       ilisp-set-directory-command
+       "(setq *default-pathname-defaults* (parse-namestring \"%s\"))")
+ (setq ilisp-load-command "(load \"%s\")")
+ (setq ilisp-compile-file-command
+       "(ILISP:ilisp-compile-file \"%s\" \"%s\")"))
+
+(defdialect lucid "Lucid Common LISP" clisp
+ (ilisp-load-init 'lucid "lucid")
+ (setq comint-prompt-regexp "^\\(->\\)+ \\|^[^> ]*> "
+       comint-fix-error ":a"
+       ilisp-reset ":a :t"
+       comint-continue ":c"
+       comint-interrupt-regexp ">>Break: Keyboard interrupt"
+       comint-prompt-status
+       (function (lambda (old line)
+		  (comint-prompt-status old line 'lucid-check-prompt))))
+ (setq ilisp-error-regexp "ILISP:[^\"]*\\|>>[^\n]*")
+ (setq ilisp-source-types (append ilisp-source-types '(("any"))))
+ (setq ilisp-find-source-command
+       "(ILISP:ilisp-source-files \"%s\" \"%s\" \"%s\")")
+ (setq ilisp-binary-command
+       "(first (last lucid::*load-binary-pathname-types*))")
+ (setq ild-abort-string ":A"
+       ild-continue-string ":C"
+       ild-next-string ":N"
+       ild-next-string-arg ":N %s"
+       ild-previous-string ":P"
+       ild-previous-string-arg ":P %s"
+       ild-top-string ":<"
+       ild-bottom-string ":>"
+       ild-backtrace-string ":B"
+       ild-locals-string ":V"
+       ild-local-string-arg ":L %s"
+       ild-return-string ":R"
+       ild-retry-string ":F"
+       ild-trap-on-exit-string ":X T"))
+(setq lucid-program "lisp")
+
+(defdialect allegro "Allegro Common LISP" clisp
+ (ilisp-load-init 'allegro "allegro")
+ (setq comint-fix-error ":pop"
+       ilisp-reset ":reset"
+       comint-continue ":cont"
+       comint-interrupt-regexp  "Error: [^\n]* interrupt\)")
+ (setq comint-prompt-status
+       (function (lambda (old line)
+		  (comint-prompt-status old line 'allegro-check-prompt))))
+ ;; <cl> or package> at top-level
+ ;; [0-9c] <cl> or package> in error
+ ;; (setq comint-prompt-regexp "^\\(\\[[0-9]*c*\\] \\|\\)\\(<\\|\\)[^>]*> ")
+ (setq comint-prompt-regexp "^\\(\\[[0-9]+i?c?\\] \\|\\[step\\] \\)?\\(<?[-A-Za-z]* ?[0-9]*?>\\|[-A-Za-z0-9]+([0-9]+):\\) ")
+ (setq ilisp-error-regexp
+       "\\(ILISP:[^\"]*\\)\\|\\(Error:[^\n]*\\)\\|\\(Break:[^\n]*\\)")
+
+ (setq ilisp-binary-command "excl:*fasl-default-type*")
+ (setq ilisp-source-types (append ilisp-source-types '(("any"))))
+ (setq ilisp-find-source-command
+       "(ILISP:ilisp-source-files \"%s\" \"%s\" \"%s\")")
+ (setq ilisp-init-binary-command
+       "(let ((ext (or #+m68k \"68fasl\"
+		        #+sparc \"sfasl\"
+		        #+iris4d \"ifasl\"
+                        #+dec3100 \"pfasl\"
+                        excl:*fasl-default-type*)))
+           #+allegro-v4.0 (setq ext (concatenate 'string ext \"4\"))
+           ext)")
+ (setq ild-abort-string ":pop"
+       ild-continue-string ":cont"
+       ild-next-string ":dn"
+       ild-next-string-arg ":dn %s"
+       ild-previous-string ":up"
+       ild-previous-string-arg ":up %s"
+       ild-top-string ":to"
+       ild-bottom-string ":bo"
+       ild-backtrace-string ":bt"
+       ild-locals-string ":local"
+       ild-local-string-arg ":local %s"
+       ild-return-string nil		;needs work
+       ild-retry-string ":rest"
+       ild-trap-on-exit-string ":boe"))
+(setq allegro-program "cl")
+
+(defdialect akcl "Austin Kyoto Common LISP" kcl
+ (setq comint-prompt-regexp "^[-A-Z]*>+")
+ (setq ild-abort-string ":q"
+       ild-continue-string ":r"
+       ild-next-string ":up"
+       ild-next-string-arg ":up %s"
+       ild-previous-string ":down"
+       ild-previous-string-arg ":down %s"
+       ild-top-string ":down 1000000"
+       ild-bottom-string ":up 1000000"
+       ild-backtrace-string ":bt"
+       ild-locals-string ":fr"
+       ild-local-string-arg ":loc %s"
+       ild-return-string ":r"
+       ild-retry-string nil		;needs work
+       ild-trap-on-exit-string nil))	;needs work
+(setq akcl-program "akcl")
+
+(defdialect cmulisp "CMU Common LISP" clisp
+ (ilisp-load-init 'cmu "cmulisp")
+ (if cmulisp-local-source-directory
+     (setq ilisp-source-directory-fixup-alist
+	   (list
+	    (cons cmulisp-source-directory-regexp
+		  cmulisp-local-source-directory)))
+     (message "cmulisp-local-source-directory not set."))
+ (setq comint-prompt-regexp "^\\([0-9]+\\]+\\|\\*\\) "
+       ilisp-trace-command "(ILISP:cmulisp-trace \"%s\" \"%s\" \"%s\")"
+       comint-prompt-status
+       (function (lambda (old line)
+		  (comint-prompt-status old line 'cmulisp-check-prompt)))
+       ilisp-error-regexp "ILISP:[^\"]*\\|Error [^\n]*"
+       ilisp-arglist-command "(ILISP:arglist \"%s\" \"%s\")"
+       ilisp-find-source-command "(ILISP:source-file \"%s\" \"%s\" \"%s\")"
+       comint-fix-error ":pop"
+       comint-continue ":go"
+       ilisp-reset ":q"
+       comint-interrupt-regexp "Interrupted at"
+       ilisp-binary-extension "sparcf")
+ (setq ild-abort-string ":abort"
+       ild-continue-string ":go"
+       ild-next-string ":down"
+       ild-next-string-arg nil		;needs work
+       ild-previous-string ":up"
+       ild-previous-string-arg nil	;needs work
+       ild-top-string ":bottom"
+       ild-bottom-string ":top"
+       ild-backtrace-string ":backtrace"
+       ild-locals-string ":l"
+       ild-local-string-arg "(debug:arg %s)"
+       ild-return-string nil		;needs work (debug:debug-return x)
+       ild-retry-string nil		;needs work
+       ild-trap-on-exit-string nil))	;needs work
+(setq cmulisp-program "cmucl")
+
+