diff options
Diffstat (limited to 'control')
-rw-r--r-- | control/monad.scm | 46 | ||||
-rw-r--r-- | control/monad/procedures.scm | 13 |
2 files changed, 55 insertions, 4 deletions
diff --git a/control/monad.scm b/control/monad.scm index 2ef230c..e964b48 100644 --- a/control/monad.scm +++ b/control/monad.scm @@ -1,8 +1,12 @@ (define-module (control monad) #:use-module (control monad procedures) + #:use-module (srfi srfi-1) #:use-module (ice-9 match) - #:export (do) - #:re-export (>> >>=)) + #:use-module (ice-9 curried-definitions) + #:replace (do) + #:export (sequence mapM + fmap <$> cmap <*>) + #:re-export (>> >>= return)) (define-syntax do (syntax-rules (<- let =) @@ -11,7 +15,43 @@ (ptrn (do rest ...)))) ((_ ptrn <- val rest ...) (>>= val (match-lambda (ptrn (do rest ...))))) - ((_ a) a) + ((_ a) a) ; Base case ((_ token rest ...) (>> token (do rest ...))))) +;;; ---------------------------------------- + +(define (fmap f m) + (>>= m (lambda (x) ((return m) (f x))))) + +(define <$> fmap) + +;; Curried map +(define (cmap f) + (lambda (m) (fmap f m))) + +(define (<*> f_ i_) + (do f <- f_ + i <- i_ + ((return f_) (f i)))) + +;;; ---------------------------------------- + +;; sequence :: (list (M a)) → M (list a) +(define (sequence in-list) + "Evaluate each monadic action in the structure from left to right, and collect +the results. For a version that ignores the results see sequence_. +https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Monad.html#g:4" + (define ((f done) item) (append done (list item))) + (fold (lambda (m-item m-done) + #!curly-infix {{ f <$> m-done } <*> m-item }) + ((return (car in-list)) '()) + in-list)) + +;; mapM :: (a -> M b) x (list a) → M (list b) +(define (mapM proc items) + "Map each element of a structure to a monadic action, evaluate these actions from +left to right, and collect the results. For a version that ignores the results +see mapM_. +https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Monad.html#g:4" + (sequence (map proc items))) diff --git a/control/monad/procedures.scm b/control/monad/procedures.scm index 4be85ae..707dc0b 100644 --- a/control/monad/procedures.scm +++ b/control/monad/procedures.scm @@ -1,16 +1,27 @@ (define-module (control monad procedures) #:use-module (oop goops) #:use-module (srfi srfi-1) ; concatenate! - #:export (>> >>=)) + #:export (>> >>= return)) + +(define-generic return) +(define-method (return (a <top>)) identity) +(define-method (return (a <pair>)) list) (define-generic >>=) +(define-method (>>= (a <top>) (proc <procedure>)) + (proc a)) + (define-method (>>= (this <null>) proc) '()) (define-method (>>= (this <pair>) (proc <procedure>)) (concatenate! (map proc this))) (define-generic >>) + +(define-method (>> (a <top>) (b <top>)) + (>>= a (lambda args b))) + (define-method (>> (a <null>) (b <null>)) '()) (define-method (>> (a <pair>) (b <null>)) '()) (define-method (>> (a <null>) (b <pair>)) '()) |