Optional bindings now much better.

1 files changed, 13 insertions, 13 deletions

diff --git a/state-monad.scm b/state-monad.scm
index b261d95..d8d96e3 100644
--- a/state-monad.scm
+++ b/state-monad.scm
@@ -38,14 +38,13 @@ runState (return "X") 1
       (format port "[Just ~s]" (slot-ref this 'slot))
       (format port "[Nothing]")))
 
-
 ;; bind :: Monad m => m a -> (a -> m b) -> m b
 ;; return :: Monad m => a -> m a
 ;; map :: Functor f => (a -> b) -> f a -> f b
 
 (define-method (>>= (this <optional>)
                     (proc <procedure>))
-  (cond ((nothing? this) nothing)
+  (cond ((nothing? this) (nothing))
         ((just? this) 
          (match this
            (($ <optional> slot) (proc slot))))))
@@ -59,10 +58,10 @@ runState (return "X") 1
   (concatenate! (map proc this)))
 
 (define-syntax do
-  (syntax-rules (<- let x)
-    ((_ (let var = val) rest ...)
+  (syntax-rules (<- let =)
+    ((_ let var = val rest ...)
      (let ((var val)) (do rest ...)))
-    ((_ (<- ptrn val) rest ...)
+    ((_ ptrn <- val rest ...)
      (<- ptrn val rest ...))
     ((_ a) a)
     ((_ token rest ...)
@@ -72,15 +71,16 @@ runState (return "X") 1
   (lambda (x)
     (syntax-case x (just)
       ((_ (just var) val rest ...)
-       #'(match val
-           (($ <optional> slot)
-            (let ((var slot))
-              rest ...)))))))
+       #'(>>= val (lambda (var) rest ...))))))
 
 ;;; Examples:
 
-(do { (just x) <- (just 10) } x) ; => 10
+(do (just x) <- (just 10)
+    x) ; => 10
+
+(do let y = (just 10)
+    (just x) <- y
+    (+ x 5)) ; => 15
 
-(let ((j (just 10)))
-  (do { (just x) <- j }
-      (+ x 10))) ; => 20
+(do (just x) <- (nothing)
+    (+ x 5)) ; => [Nothing]