monads with generics

gistfile1.rkt

;; using the idea from this blog post: http://www.clojure.net/2012/06/03/Monad-Protocols/

#lang racket

(require (for-syntax syntax/parse))

(module monad racket
  (require racket/generic)
  
  (define (vector-mapcat f v)
    (apply vector-append
           (for/list ([elem (vector-map f v)])
             (if (vector? elem)
                 elem
                 (vector elem)))))
  
  (define-generics monad
    (do-result monad v)
    (bind monad f))

  (define (-do-result m v)
    (cond [(vector? m) (vector v)]
          [else (do-result m v)]))
  
  (define (-bind m v)
    (cond [(vector? m) (vector-mapcat v m)]
          [else (bind m v)]))
  
  (provide gen:monad
           monad?
           (rename-out
            [-bind bind]
            [-do-result do-result])))

(require 'monad)

(define-syntax (do stx)
  (define-syntax-class binding
    (pattern (x:id <- val:expr)))
  
  (syntax-parse stx
    [(_ b:binding b1:binding ...+ e:expr)
     #'(bind b.val (λ (b.x) (do b1 ... e)))]
    [(_ b:binding e:expr)
     #'(bind b.val (λ (b.x) (do-result b.val e)))]))

(bind #(1 2 4) add1)

(do [x <- #(1 2 3)]
    [y <- #(10 11)]
  (+ x y))