On Wed, 2 May 2012 20:43:49 +0000, Taylor R Campbell <campb...@mumble.net> 
wrote:
>    Date: Wed, 02 May 2012 09:28:31 +0200
>    From: <cra...@gmx.net>
> 
>    Yesterday I've tried to get current SLIME (2012-03-06 here) to work with
>    MIT/GNU Scheme, and fixed a few things. Find attached my patches. How
>    should I best prepare them so they get a chance at getting accepted into
>    GIT?
> 
> It looks like you made some changes against an earlier version of
> swank.scm, from before some of the bugs you fixed were already fixed
> in HEAD, such as some fiddly details with t and nil, and then rather
> than merge the changes you just replaced the new swank.scm with your
> modified one.  Can you separate these changes, if nobody else steps
> forward to integrate the patch?

I have now separated them all out and included more detailed
commentary. These are against GIT as of 2 hours ago. They do not
completely implement everything, but are an improvement over the
existing swank.scm (which does not work at all for me).

Please don't hesitate to tell me if they still are not in an acceptable
format (git-wise or code-wise), so I can further improve them.

Greetings,
Peter
From affd45958f1ce5366440991630a1d9d86c42f75c Mon Sep 17 00:00:00 2001
From: Peter Feigl <cra...@gmx.net>
Date: Thu, 3 May 2012 09:28:43 +0200
Subject: [PATCH 1/6] Updating swank.scm to work with current slime-cvs

* Startup Problems [when using Emacs setting (slime-setup '(slime-fancy))]
- M-x slime raises condition "Unbound variable: swank:swank-require"
  => fixed by defining swank:swank-require to return '()
- M-x slime shows "error in process filter: Can't find suitable coding-system"
  => fixed by adding :encoding (:coding-systems ("utf-8-unix" "iso-latin-1-unix")) to the connection info
- M-x slime raises condition "Unbound variable :conding-system" (which is due to all parameters being evaluated)
  => fixed by adding QUOTE-SPECIAL and mapping it over the parameters (quoting all keywords [symbols that start with a colon] and T and NIL)
- Typing an expression raises condition "Unbound variable: swank:autodoc"
  => fixed by defining swank:autodoc to return (list ':not-available 't)
- Slime complains about mismatched versions
  => fixed by changing :version in swank:connection-info to "2012-05-02" which matches slime-cvs

Now we have a working SLIME REPL again.
---
 src/runtime/swank.scm |   35 +++++++++++++++++++++++++++++------
 1 file changed, 29 insertions(+), 6 deletions(-)

diff --git a/src/runtime/swank.scm b/src/runtime/swank.scm
index eab8a55..ddfeee3 100644
--- a/src/runtime/swank.scm
+++ b/src/runtime/swank.scm
@@ -211,7 +211,7 @@ USA.
 
 (define (emacs-rex socket sexp pstring)
   (fluid-let ((*buffer-pstring* pstring))
-    (eval (cons* (car sexp) socket (cdr sexp))
+    (eval (cons* (car sexp) socket (map quote-special (cdr sexp)))
 	  swank-env)))
 
 (define *buffer-pstring*)
@@ -420,7 +420,19 @@ USA.
       :lisp-implementation
       (:type "MIT/GNU Scheme"
        :version ,(get-subsystem-version-string "release"))
-      :version "20100404")))
+      :version "2012-05-02"
+      :encoding
+      (:coding-systems
+       ("utf-8-unix" "iso-latin-1-unix")))))
+
+(define (swank:swank-require socket packages)
+  socket
+  packages
+  '())
+
+(define (swank:autodoc socket expr . params)
+  socket params
+  (list ':not-available 't))
 
 (define (swank:quit-lisp socket)
   socket
@@ -952,9 +964,6 @@ swank:xref
 (define (elisp-false? o) (or (null? o) (eq? o 'NIL)))
 (define (elisp-true? o) (not (elisp-false? o)))
 
-(define nil '())
-(define t 'T)
-
 (define (->line o)
   (let ((r (write-to-string o 100)))
     (if (car r)
@@ -970,4 +979,18 @@ swank:xref
       (fluid-let ((*unparser-list-breadth-limit* 10)
 		  (*unparser-list-depth-limit* 4)
 		  (*unparser-string-length-limit* 100))
-	(pp o p)))))
\ No newline at end of file
+	(pp o p)))))
+
+;; quote keywords, t and nil
+(define (quote-special x)
+  (cond ((and (symbol? x)
+	      (or
+	       (and (> (string-length (symbol->string x)) 0)
+		    (char=? #\: (string-ref (symbol->string x) 0)))
+	       (eq? x 't)))
+	 `(quote ,x))
+	((and (symbol? x)
+	      (eq? x 'nil))
+	 '())
+	(else
+	 x)))
-- 
1.7.10

From 4e0136780094e42840f3714077cc660c141dae11 Mon Sep 17 00:00:00 2001
From: Peter Feigl <cra...@gmx.net>
Date: Thu, 3 May 2012 09:31:24 +0200
Subject: [PATCH 2/6] Add autodoc for procedures

* Autodoc
Actually implement swank:autodoc. It is called with a list form that contains the special symbol swank::%cursor-marker% somewhere to show the position of the cursor.
The new procedure FIND-STRING-BEFORE-SWANK-CURSOR-MARKER returns the symbol that starts the expression which contains the cursor as a string.
The new procedure PROCEDURE-PARAMETERS returns a list containing the function name and the list of parameters (as printed by PA) if symbol is bound to a function.
The new variable SWANK-EXTRA-DOCUMENTATION contains an (incomplete) list of "parameters" to special forms and macros.

Now we have working autodoc in the REPL and in Scheme buffers.
---
 src/runtime/swank.scm |   48 +++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 47 insertions(+), 1 deletion(-)

diff --git a/src/runtime/swank.scm b/src/runtime/swank.scm
index ddfeee3..02ff0b9 100644
--- a/src/runtime/swank.scm
+++ b/src/runtime/swank.scm
@@ -430,9 +430,55 @@ USA.
   packages
   '())
 
+(define swank-extra-documentation
+  '((let bindings . body)
+    (let* bindings . body)
+    (letrec bindings . body)
+    (receive bindings expression . body)
+    (define name . body)
+    (quote expression)
+    (quasiquote expression)
+    (unquote expression)
+    (unquote-splicing expression)
+    (if test then else)
+    (set! name value)))
+
+(define (procedure-parameters symbol env)
+  (let ((type (environment-reference-type env symbol)))
+    (let ((ans (if (eq? type 'normal)
+		   (let ((binding (environment-lookup env symbol)))
+		     (if (and binding
+			      (procedure? binding))
+			 (cons symbol (read-from-string (string-trim (with-output-to-string
+								       (lambda () (pa binding))))))
+			 #f))
+		   (let ((extra (assq symbol swank-extra-documentation)))
+		     (if extra
+			 extra
+			 #f)))))
+      ans)))
+
+(define (find-string-before-swank-cursor-marker expr)
+  (if (list? expr)
+      (if (member 'swank::%cursor-marker% expr)
+	  (if (string? (car expr))
+	      (car expr)
+	      #f)
+	  (any (lambda (ex)
+		 (find-string-before-swank-cursor-marker ex))
+	       expr))
+      #f))
+
 (define (swank:autodoc socket expr . params)
   socket params
-  (list ':not-available 't))
+  (let* ((op-string (find-string-before-swank-cursor-marker expr)))
+    (if op-string
+	(let* ((op (string->symbol op-string))
+	       (type (environment-reference-type (buffer-env) op)))
+	  (let ((ans (procedure-parameters op (buffer-env))))
+	    (let ((answer (if ans (with-output-to-string (lambda () (write ans))) ':not-available)))
+	      (list answer 't))))
+	(list ':not-available 't))))
 
 (define (swank:quit-lisp socket)
   socket
-- 
1.7.10

From 50b8fc12ab7346928cfca91b2754ffe5e9dad370 Mon Sep 17 00:00:00 2001
From: Peter Feigl <cra...@gmx.net>
Date: Thu, 3 May 2012 09:32:00 +0200
Subject: [PATCH 3/6] Adding completion function swank:completions as an alias
 for swank:simple-completions.

* Completion
Trying to auto-complete in the REPL raises condition "Unbound variable:
swank:completions". It seems swank added swank:completions in addition
(or instead of?) swank:simple-completions.
---
 src/runtime/swank.scm |    2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/runtime/swank.scm b/src/runtime/swank.scm
index 02ff0b9..cd59077 100644
--- a/src/runtime/swank.scm
+++ b/src/runtime/swank.scm
@@ -1040,3 +1040,5 @@ swank:xref
 	 '())
 	(else
 	 x)))
+
+(define swank:completions swank:simple-completions)
-- 
1.7.10

From 77e782870a49aba82ec3ca0087ebe32a50dfc170 Mon Sep 17 00:00:00 2001
From: Peter Feigl <cra...@gmx.net>
Date: Thu, 3 May 2012 09:36:24 +0200
Subject: [PATCH 4/6] Adding directory support to swank.scm.

* Directories
Added directory functions SWANK:DEFAULT-DIRECTORY and
SWANK:SET-DEFAULT-DIRECTORY for slime commands ,!d ,cd ,+d ,-d
,change-directory ,push-directory ,pop-directory ,pushd ,popd ,pwd
---
 src/runtime/swank.scm |    7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/src/runtime/swank.scm b/src/runtime/swank.scm
index cd59077..39d0e2c 100644
--- a/src/runtime/swank.scm
+++ b/src/runtime/swank.scm
@@ -371,6 +371,13 @@ USA.
        (eval (read-from-string string)
 	     (buffer-env))))))

+;;;; Directory Functions
+(define (swank:default-directory socket)
+  (->namestring (working-directory-pathname)))
+
+(define (swank:set-default-directory socket directory)
+  (->namestring (set-working-directory-pathname! directory)))
+
 ;;;; Miscellaneous
 
 (define (swank:set-package socket pstring)
-- 
1.7.10

From 8f2b4d378de9e5d67303ef2b85748f1c12d907aa Mon Sep 17 00:00:00 2001
From: Peter Feigl <cra...@gmx.net>
Date: Thu, 3 May 2012 09:45:45 +0200
Subject: [PATCH 5/6] Fix basic debugging problems.

* Debugging
There are numerous problems, including no replies sent to messages and
incorrect replies.
- Added condition/report-string to the abort message.
- Added a DYNAMIC-WIND in the condition handler in the message handler
  for emacs-rex to ensure that the :abort message is always written,
  even when a restart is called.
- Added a global (fluid) binding *index* that is used to send the
  correct message index in the :debug message.

There are many problems remaining, to be tackled in a later commit.
---
 src/runtime/swank.scm |   21 ++++++++++++++-------
 1 file changed, 14 insertions(+), 7 deletions(-)

diff --git a/src/runtime/swank.scm b/src/runtime/swank.scm
index 39d0e2c..191ebae 100644
--- a/src/runtime/swank.scm
+++ b/src/runtime/swank.scm
@@ -201,16 +201,22 @@ USA.
      (lambda (k)
        (bind-condition-handler (list condition-type:serious-condition)
 	   (lambda (condition)
-	     (invoke-sldb socket (+ level 1) condition)
-	     (write-message `(:return (:abort) ,id) socket)
-	     (k unspecific))
+	     (dynamic-wind
+		 (lambda ()
+		   #f)
+		 (lambda ()
+		   (invoke-sldb socket (+ level 1) condition))
+		 (lambda ()
+		   (write-message `(:return (:abort ,(condition/report-string condition)) ,id) socket))))
 	 (lambda ()
-	   (write-message `(:return (:ok ,(emacs-rex socket sexp pstring))
+	   (write-message `(:return (:ok ,(emacs-rex socket sexp pstring id))
 				    ,id)
 			  socket)))))))
+(define *index*)
 
-(define (emacs-rex socket sexp pstring)
-  (fluid-let ((*buffer-pstring* pstring))
+(define (emacs-rex socket sexp pstring id)
+  (fluid-let ((*buffer-pstring* pstring)
+	      (*index* id))
     (eval (cons* (car sexp) socket (map quote-special (cdr sexp)))
 	  swank-env)))
 
@@ -600,7 +606,7 @@ swank:xref
 	  (sldb-restarts rs)
 	  (sldb-backtrace c start end)
 	  ;;'((0 "dummy frame"))
-	  '())))
+	  (list *index*))))
 
 (define (sldb-restarts restarts)
   (map (lambda (r)
@@ -623,6 +629,7 @@ swank:xref
 
 (define (swank:invoke-nth-restart-for-emacs socket sldb-level n)
   socket sldb-level
+  (write-message `(:return (:abort "NIL") ,*index*) socket)
   (invoke-restart (list-ref (sldb-state.restarts *sldb-state*) n)))

 (define (swank:debugger-info-for-emacs socket from to)
-- 
1.7.10

From 27048154e42befdf680be5411d11353fcd343785 Mon Sep 17 00:00:00 2001
From: Peter Feigl <cra...@gmx.net>
Date: Thu, 3 May 2012 09:58:44 +0200
Subject: [PATCH 6/6] Basic support for describing things in swank.

* Describing
Adding basic support for SWANK:DESCRIBE-FUNCTION and
SWANK:DESCRIBE-SYMBOL.
---
 src/runtime/swank.scm |   59 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 59 insertions(+)

diff --git a/src/runtime/swank.scm b/src/runtime/swank.scm
index 191ebae..e3512ec 100644
--- a/src/runtime/swank.scm
+++ b/src/runtime/swank.scm
@@ -384,6 +384,65 @@ USA.
 (define (swank:set-default-directory socket directory)
   (->namestring (set-working-directory-pathname! directory)))

+;;;; Describe
+(define (swank:describe-symbol socket symbol)
+  (let* ((env (buffer-env))
+	 (package (env->pstring env))
+	 (symbol (string->symbol symbol))
+	 (type (environment-reference-type env symbol))
+	 (binding (if (eq? type 'normal) (environment-lookup env symbol) #f))
+	 (binding-type (if binding (get-object-type-name binding) #f))
+	 (params (if (and binding (procedure? binding)) (procedure-parameters symbol env) #f)))
+    (string-append
+     (format #f "~a in package ~a~a of type ~a.~%~%" (string-upcase (symbol->string symbol))
+	     package
+	     (if (and binding
+		      (procedure? binding))
+		 (format #f " [originally defined in package ~a]" (env->pstring (procedure-environment binding)))
+		 "")
+	     (if binding-type binding-type type))
+     (if binding
+	 (format #f "Bound to ~a.~%" binding)
+	 "")
+     (if params
+	 (format #f "~%Signature: ~a.~%~%" params)
+	 "")
+     (if binding
+	 (format #f "It is:~%~%~a~%" (with-output-to-string (lambda () (pp binding))))
+	 ""))))
+
+(define (swank:describe-function socket function)
+  (swank:describe-symbol socket function))
+
+(define (swank:describe-definition-for-emacs socket name type)
+  type
+  (swank:describe-symbol socket name))
+
+(define (get-object-type-name obj)
+  (cond ((boolean? obj) "boolean")
+	((string? obj) "string")
+	((char? obj) "char")
+	((fixnum? obj) "fixnum")
+	((integer? obj) "integer")
+	((rational? obj) "rational")
+	((real? obj) "real")
+	((complex? obj) "complex")
+	((vector? obj) "vector")
+	((pair? obj) "pair")
+	((null? obj) "empty list")
+	((bit-string? obj) "bit-string")
+	((cell? obj) "cell")
+	((condition? obj) "condition")
+	((environment? obj) "environment")
+	((port? obj) "port")
+	((procedure? obj) "procedure")
+	((promise? obj) "promise")
+	((symbol? obj) "symbol")
+	((weak-pair? obj) "weak-pair")
+	((record-type? obj) "record-type")
+	((wide-string? obj) "wide-string")
+	(else (user-object-type obj))))
+
 ;;;; Miscellaneous
 
 (define (swank:set-package socket pstring)
-- 
1.7.10

Attachment: pgpl0c9kFJPSE.pgp
Description: PGP signature

_______________________________________________
MIT-Scheme-devel mailing list
MIT-Scheme-devel@gnu.org
https://lists.gnu.org/mailman/listinfo/mit-scheme-devel

Reply via email to