From 55c479f841df1db6400802b7953de833b6fc038d Mon Sep 17 00:00:00 2001
From: rekado <rekado@elephly.net>
Date: Thu, 30 Oct 2014 19:30:44 +0100
Subject: use syntax-parameters instead of expanding to let bindings

---
 monad/core.scm | 45 +++++++++++++++++++++++++--------------------
 1 file changed, 25 insertions(+), 20 deletions(-)

(limited to 'monad')

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 ...))))))))
-- 
cgit v1.2.3