monad.scm

(define (then m k)
  (bind m (lambda (_) k)))

(define (state-unit a)
  (lambda (s) `(,a ,s)))

(define (state-bind m k)
  (lambda (s)
    (let* { [r (m s)]
            [a (car r)]
            [s- (cadr r)] }
      ((k a) s- ))))

(define (state-get s)
  `(,s ,s))

(define (state-put s)
  (lambda (_) `(() ,s)))

(define-syntax monad-context
  (syntax-rules (<-)
    [(_ unit bind m) m]
    [(_ unit bind (x <- m) k ...)
     (bind m (lambda (x) (monad-context unit bind k ...)))]
    [(_ unit bind m k ...)
     (bind m (lambda (_) (monad-context unit bind k ...)))]))

(define state
  (monad-context state-unit state-bind
                 (x <- state-get)
                 (state-unit (display x))
                 (state-unit (newline))
                 (state-put (* x x))
                 (x <- state-get)
                 (state-unit (display x))))
(state 42)