infix: Replace multiple-value constructs with a single bind.

[lisp] / infix.lisp

diff --git a/infix.lisp b/infix.lisp
index 93ec028076b4623908680e02fde051ae90d1ec38..5cdd0b918477c57037311eb491d266eb79aca0de 100644 (file)
--- a/infix.lisp
+++ b/infix.lisp
@@ -34,7 +34,8 @@ (defpackage #:infix-keywords
           #:++ #:--
           #:<< #:>>
           #:if #:then #:else
           #:++ #:--
           #:<< #:>>
           #:if #:then #:else

-          #:let #:let* #:in))
+          #:let #:let* #:in
+          #:bind))

 
 (defpackage #:infix
   (:use #:common-lisp #:infix-keywords)
 
 (defpackage #:infix
   (:use #:common-lisp #:infix-keywords)


@@ -608,18 +609,20 @@ (defopfunc loop operand
   (get-token)
   (pushval `(loop ,@(strip-progn (parse-infix 0)))))
 
   (get-token)
   (pushval `(loop ,@(strip-progn (parse-infix 0)))))
 

-(defopfunc multiple-value-bind operand
-  (get-token)
-  (pushval `(multiple-value-bind
-               ,(parse-ident-list)
-               ,(progn (delim '=) (parse-infix))
-             ,@(progn (delim 'in) (strip-progn (parse-infix 0))))))
-
-(defopfunc multiple-value-setq operand
-  (get-token)
-  (pushval `(multiple-value-setq
-               ,(parse-ident-list)
-               ,(progn (delim '=) (parse-infix 0)))))
+(defopfunc bind operand
+  (labels ((loop ()
+           (let ((ids (parse-ident-list))
+                 (valform (progn (delim '=) (parse-infix 0)))
+                 (body (if (delim '|,| nil)
+                           (loop)
+                           (progn
+                             (delim 'in)
+                             (strip-progn (parse-infix 0))))))
+             (list (if (and ids (null (cdr ids)))
+                       `(let ((,(car ids) ,valform)) ,@body)
+                       `(multiple-value-bind ,ids ,valform ,@body))))))
+    (get-token)
+    (pushval (car (loop)))))

 
 ;;;--------------------------------------------------------------------------
 ;;; Parsing function bodies and lambda lists.
 
 ;;;--------------------------------------------------------------------------
 ;;; Parsing function bodies and lambda lists.


@@ -799,8 +802,14 @@ (testrig "infix" #'test-infix
      (labels ((foo (x) (+ x 1)) (bar (x) (- x 1))) (foo (bar y))))
     ("defun foo (x) x - 6" .
      (defun foo (x) (- x 6)))
      (labels ((foo (x) (+ x 1)) (bar (x) (- x 1))) (foo (bar y))))
     ("defun foo (x) x - 6" .
      (defun foo (x) (- x 6)))

-    ("multiple-value-bind x, y, z = values(4, 6, 8) in x + y + z" .
-     (multiple-value-bind (x y z) (values 4 6 8) (+ x y z)))))
+    ("bind x = 3 in x - 2" . (let ((x 3)) (- x 2)))
+    ("bind x, y = values(1, 2),
+           z = 3,
+           docs, decls, body = parse-body(body) in complicated" .
+     (multiple-value-bind (x y) (values 1 2)
+       (let ((z 3))
+        (multiple-value-bind (docs decls body) (parse-body body)
+          complicated))))))

 
 ;;;--------------------------------------------------------------------------
 ;;; Debugging guff.
 
 ;;;--------------------------------------------------------------------------
 ;;; Debugging guff.