summaryrefslogtreecommitdiff
path: root/monad/core.scm
diff options
context:
space:
mode:
Diffstat (limited to 'monad/core.scm')
-rw-r--r--monad/core.scm45
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 ...))))))))