[slime-cvs] CVS slime/contrib

[CVS User heller]

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv2464/contrib

Modified Files:
	ChangeLog swank-kawa.scm 
Log Message:
* swank-kawa.scm (mif): Avoid assignments because that triggers a
bug/regression in the compiler.
(getpid): Don't use the -n option with echo.  It's not standard
and also not needed here.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/11/29 11:12:39	1.142
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/12/09 18:29:06	1.143
@@ -1,3 +1,10 @@
+2008-12-09  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-kawa.scm (mif): Avoid assignments because that triggers a
+	bug/regression in the compiler.
+	(getpid): Don't use the -n with echo.  It's not standard and also
+	not needed here.
+
 2008-11-29  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime-package-fu.el (slime-goto-package-source-definition):
--- /project/slime/cvsroot/slime/contrib/swank-kawa.scm	2008/10/19 20:03:55	1.10
+++ /project/slime/cvsroot/slime/contrib/swank-kawa.scm	2008/12/09 18:29:06	1.11
@@ -178,13 +178,14 @@
        'ok))))
 
 (define-syntax mif
-  (syntax-rules (unquote quote _ ::)
+  (syntax-rules (quote unquote _)
     ((mif ('x value) then else)
      (if (equal? 'x value) then else))
     ((mif (,x value) then else)
      (if (eq? x value) then else))
     ((mif (() value) then else)
      (if (eq? value '()) then else))
+    #|  This variant produces no lambdas but breaks the compiler
     ((mif ((p . ps) value) then else)
      (let ((tmp value)
            (fail? :: <int> 0)
@@ -198,6 +199,18 @@
                 (set! fail? -1)))
            (set! fail? -1))
        (if (= fail? 0) result else)))
+    |#
+    ((mif ((p . ps) value) then else)
+     (let ((fail (lambda () else))
+           (tmp value))
+       (if (instance? tmp <pair>)
+           (let ((tmp :: <pair> tmp))
+             (mif (p tmp:car)
+                  (mif (ps tmp:cdr)
+                       then
+                       (fail))
+                  (fail)))
+           (fail))))
     ((mif (_ value) then else)
      then)
     ((mif (var value) then else)
@@ -336,6 +349,10 @@
 (define-variable *last-exception* #f)
 (define-variable *last-stacktrace* #f)
 
+;; FIXME: this needs factorization.  But I guess the whole idea of
+;; using bidirectional channels just sucks.  Mailboxes owned by a
+;; single thread to which everybody can send are much easier to use.
+
 (df dispatch-events ((s <socket>))
   (mlet* ((charset "iso-8859-1")
           (ins (<in> (! getInputStream s) charset))
@@ -1570,7 +1587,7 @@
     (! attach pa args)))
 
 (df getpid ()
-  (let ((p (make-process (command-parse "echo -n $PPID") #!null)))
+  (let ((p (make-process (command-parse "echo $PPID") #!null)))
     (! waitFor p)
     (! read-line (<java.io.BufferedReader> (<in> (! get-input-stream p))))))