; From http://okmij.org/ftp/Scheme/monad-in-Scheme.html
; typo: "the original posted wanted"
(define (make-numbered-value tag val) (cons tag val))
(define (nvalue-tag tv) (car tv))
(define (nvalue-val tv) (cdr tv))

(define (return val)
   (lambda (curr_counter)
      (make-numbered-value curr_counter val)))

(define (>>= m f)
   (lambda (curr_counter)
      (let* ((m_result (m curr_counter))
             (n1 (nvalue-tag m_result))   ; result of the delayed computation
             (v  (nvalue-val m_result))   ; represented by m
     
             (m1 (f v))                   ; feed the result to f, get another m1
             )
        (m1 n1))))                        ; The result of the bigger monad

(define incr
   (lambda (n)
      (make-numbered-value (+ 1 n) n)))

(define (runM m init-counter) (m init-counter))

; To apply above technology:
(define (make-node val kids)
   (>>=
      incr
         (lambda (counter)
            (return (cons (make-numbered-value counter val) kids)))))

(letrec-syntax ((letM
    (syntax-rules () (
      (letM ((name initializer)) expression); <pattern> 
      (>>= initializer (lambda (name) expression)); <temlate>
      ); <syntax rule>
    ); <transformer spec>
    ); binding for letM
    
    (letM* (syntax-rules ()
     ((letM* (h . tail) expr) (letM (h) (letM* tail expr))); <syntax rule>
     ((letM* () expr) expr); <syntax rule>
    ); <transformer>
    ); binding for letM*
    ); <bindings>

(letrec ((build-btree (lambda (depth)
  (if (zero? depth) (make-node depth '())
     (letM* ((lt (build-btree (- depth 1)))
             (rt (build-btree (- depth 1))))
        (make-node depth (list lt rt)))))))
    (runM (build-btree 3) 100))
)