diff options
| -rw-r--r-- | monad/core.scm | 45 |
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 ...)))))))) |