diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2018-11-10 18:37:16 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2018-11-10 18:37:16 +0100 |
commit | 701bd4a9ad93d10ad8b6a0ef747869d544c5da8b (patch) | |
tree | b75580099b06bf3416d0621fe2ccdcb7986c52d9 | |
parent | Move stuff into modules. (diff) | |
download | scheme-monad-701bd4a9ad93d10ad8b6a0ef747869d544c5da8b.tar.gz scheme-monad-701bd4a9ad93d10ad8b6a0ef747869d544c5da8b.tar.xz |
Fix problem with do notation being really broken.
-rw-r--r-- | control/monad.scm | 32 | ||||
-rw-r--r-- | data/optional.scm | 38 |
2 files changed, 6 insertions, 64 deletions
diff --git a/control/monad.scm b/control/monad.scm index e5dc89d..8bc46bf 100644 --- a/control/monad.scm +++ b/control/monad.scm @@ -1,39 +1,15 @@ (define-module (control monad) #:use-module (control monad procedures) - ;; #:use-module (control monad syntax) - #:export (do <-) - ;; #:re-export (>>= do <-) - ) + #:export (do) + #:re-export (>>=)) (define-syntax do (syntax-rules (<- let =) ((_ let var = val rest ...) (let ((var val)) (do rest ...))) - ((_ ptrn <- val rest ...) - (<- ptrn val rest ...)) + ((_ var <- val rest ...) + (>>= val (lambda (var) (do rest ...)))) ((_ a) a) ((_ token rest ...) (begin token (do rest ...))))) -(define-syntax <- - (syntax-rules (just writer) - ((_ (just var) val rest ...) - (>>= val (lambda (var) rest ...))) - ((_ (writer var) val rest ...) - (>>= val (lambda (var) rest ...)))) - - - #; - (lambda (x) - (syntax-case x (just writer) - ((_ (just var) val rest ...) - #'(>>= val (lambda (var) rest ...))) - ((_ (writer var) val rest ...) - #'(>>= val (lambda (var) rest ...))) - #; - ((_ (left var) val rest ...) ; - #'(>>= val (lambda (var) rest ...))) - #; - ((_ (right var) val rest ...) ; - #'(>>= val (lambda (var) rest ...)))))) - diff --git a/data/optional.scm b/data/optional.scm index 462c01b..a1968f0 100644 --- a/data/optional.scm +++ b/data/optional.scm @@ -4,9 +4,8 @@ #:use-module (control monad) #:export (nothing just nothing? just? - return-optional - do <-) - ;; #:re-export (>>=) + return-optional) + #:re-export (>>=) ) (define-class <optional> () @@ -46,36 +45,3 @@ (define-method (mappend (a <optional>) (b <optional>)) (match a (($ )))) - - -(define-syntax do - (syntax-rules (<- let =) - ((_ let var = val rest ...) - (let ((var val)) (do rest ...))) - ((_ ptrn <- val rest ...) - (<- ptrn val rest ...)) - ((_ a) a) - ((_ token rest ...) - (begin token (do rest ...))))) - -(define-syntax <- - (syntax-rules (just writer) - ((_ (just var) val rest ...) - (>>= val (lambda (var) rest ...))) - ((_ (writer var) val rest ...) - (>>= val (lambda (var) rest ...)))) - - - #; - (lambda (x) - (syntax-case x (just writer) - ((_ (just var) val rest ...) - #'(>>= val (lambda (var) rest ...))) - ((_ (writer var) val rest ...) - #'(>>= val (lambda (var) rest ...))) - #; - ((_ (left var) val rest ...) ; - #'(>>= val (lambda (var) rest ...))) - #; - ((_ (right var) val rest ...) ; - #'(>>= val (lambda (var) rest ...)))))) |