#!mzscheme
(require mzlib/defmacro srfi/1)

(define-macro (>> x f) `(bind ,x (lambda _ ,f)))
(define-macro (>>= x f) `(bind ,x ,f))

(define-macro (do . exprs)
  (if (null? (cdr exprs))
      (car exprs)
      `(>> ,(car exprs) (do ,@(cdr exprs)))))

(define-macro (let-m binding expr)
  `(>>= ,(cadr binding)
        (lambda (,(car binding)) ,expr)))

(define-macro (let-m* bindings expr)
  `(let-m ,(car bindings)
          ,(if (null? (cdr bindings))
               expr
               `(let-m* ,(cdr bindings) ,expr))))

(define-macro (guard f) `(if ,f (return ()) mzero))

(define (concat-map f xs) (apply append (map f xs)))

(define list-return list)
(define (list-bind xs f) (concat-map f xs))
(define list-mzero '())

(define-macro (instance-monad name)
  `(define-macro (,(string->symbol (string-append "monad-" (symbol->string name))) expr)
     `(let ((bind ,(string->symbol (string-append (symbol->string ',name) "-bind")))
            (return ,(string->symbol (string-append (symbol->string ',name) "-return"))))
        ,expr)))

(define-macro (instance-monadplus name)
  `(define-macro (,(string->symbol (string-append "monadplus-" (symbol->string name))) expr)
     `(let ((mzero ,(string->symbol (string-append (symbol->string ',name) "-mzero"))))
        ,expr)))

;(define-macro (declare-class name members)
;  (let ((s (map
;             (lambda (member)
;               `(,member ,(string->symbol (string-append (symbol->string name) "-" (symbol->string member)))))
;             members)))
;  `(define-macro (,(string->symbol (string-append "instace-" (symbol->string name))) expr)
;     `(let
;          ,,(map
;             (lambda (member)
;               `(,member ,(string->symbol (string-append (symbol->string name) "-" (symbol->string member)))))
;             members)
;        ,expr))))
(define-macro (declare-class name members)
  (let ((env (map
             (lambda (member)
               `(,member ,(string->symbol (string-append (symbol->string name) "-" (symbol->string member)))))
             members)))
  `(define-macro (,(string->symbol (string-append "instace-" (symbol->string name))) expr)
     `(let
          ,,env
        ,expr))))

;(instance-monad list)
;(instance-monadplus list)
(declare-class monad (return bind))

(define run-me
  (monad-list
   (monadplus-list
    (let-m* ((x (iota 4 1))
             (y (iota 4 1)))
            (do (guard (even? x))
              (guard (odd? y))
              (return (cons x y)))))))