use syntax-parameters instead of expanding to let bindings

1 files changed, 25 insertions, 20 deletions

diff --git a/monad/core.scm b/monad/core.scm
index f338dab..1e1252e 100644
--- a/monad/core.scm
+++ b/monad/core.scm
@@ -8,25 +8,30 @@
   (bind monad-bind)
   (return monad-return))
 
-;; TODO: try to refactor let bindings
+(define-syntax-parameter >>=
+  (lambda (s)
+    (syntax-violation '>>= ">>= (bind) used outside of 'with-monad:'" s)))
+
+(define-syntax-parameter return
+  (lambda (s)
+    (syntax-violation 'return "return used outside of 'with-monad:'" s)))
+
 (define-syntax with-monad:
   (lambda (x)
-    (with-syntax ((return (datum->syntax x 'return))
-                  (>>=    (datum->syntax x '>>=)))
-      (syntax-case x (<-)
-        ((_ monad action)
-         #'(let ((return (monad-return monad))
-                 (>>=    (monad-bind   monad)))
-             action))
-        ((_ monad (res <- action) exp ...)
-         #'(let ((return (monad-return monad))
-                 (>>=    (monad-bind   monad)))
-             (>>= action
-                  (lambda (res)
-                    (with-monad: monad exp ...)))))
-        ((_ monad action exp ...)
-         #'(let ((return (monad-return monad))
-                 (>>=    (monad-bind   monad)))
-             (>>= action
-                  (lambda (_)
-                    (with-monad: monad exp ...)))))))))
+    (syntax-case x (<-)
+      ((_ monad action)
+       #'(syntax-parameterize ((>>= (identifier-syntax (monad-bind monad)))
+                               (return (identifier-syntax (monad-return monad))))
+                              action))
+      ((_ monad (res <- action) exp ...)
+       #'(syntax-parameterize ((>>= (identifier-syntax (monad-bind monad)))
+                               (return (identifier-syntax (monad-return monad))))
+                              (>>= action
+                                   (lambda (res)
+                                     (with-monad: monad exp ...)))))
+      ((_ monad action exp ...)
+       #'(syntax-parameterize ((>>= (identifier-syntax (monad-bind monad)))
+                               (return (identifier-syntax (monad-return monad))))
+                              (>>= action
+                                   (lambda (_)
+                                     (with-monad: monad exp ...))))))))