Compleately redid file structure.

1 files changed, 35 insertions, 4 deletions

diff --git a/control/monad.scm b/monad.scm
index 4b756c7..97f4af6 100644
--- a/control/monad.scm
+++ b/monad.scm
@@ -1,12 +1,43 @@
-(define-module (control monad)
-  #:use-module (control monad procedures)
+(define-module (monad)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:use-module (ice-9 curried-definitions)
+  #:use-module (oop goops)
   #:replace (do)
   #:export (sequence mapM
-                     fmap <$> cmap <*>)
-  #:re-export (>> >>= return))
+                     fmap <$> cmap <*>
+                     >> >>= 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>)) '())
+(define-method (>> (a <pair>) (b <pair>))
+  (concatenate! (map (const b) a)))
+
+;; bind :: Monad m => m a -> (a -> m b) -> m b
+;; return :: Monad m => a -> m a
+;; map :: Functor f => (a -> b) -> f a -> f b
+
+;;; ----------------------------------------
 
 (define-syntax do
   (syntax-rules (<- let =)