;; State Monad in Scheme
; where f g ... h :: a -> (values b a) -- a is State
; runState (f g ... h) a :: (values b a)
; runState (f g ... h) a =
; (receive (_ a) (f a)
; (receive (_ a) (g a)
; ...
; (h a)))
; data Tree = () | '(Int Tree Tree)
; push :: Int -> (values Int Tree)
; pop :: Int -> (values Int Tree)
; gosh> (runState ((push 1)) ())
; 1
; (1 () ())
; gosh> (runState ((push 1) (push 2)) ())
; 2
; (1 () (2 () ()))
; gosh> (runState ((push 1) (push 2) pop) ())
; 1
; (2 () ())
; gosh> (runState ((push 1) (push 2) pop (push 3) pop) ())
; 2
; (3 () ())
(use util.match)
(define-syntax runState
(syntax-rules ()
[(_ (f) x) (f x)]
[(_ (f g ...) x) (receive (_ y) (f x) (runState (g ...) y))] ))
(define (push n)
(define (%push tr n)
(match tr
[() (values n (list n () ()))]
[(m left right)
(values n
(if (> m n)
(list m (receive (_ tr) (%push left n) tr) right)
(list m left (receive (_ tr) (%push right n) tr))))] ))
(lambda (tr) (%push tr n)))
(define (pop tr)
(match tr
[(m () right) (values m right)]
[(m (n () right2) right) (values n (list m right2 right))]
[(m left right) (receive (n tr) (pop left) (values n (list m tr right)))] ))
; i learned State Monad yesterday. and i learned util.match today.
; i think match macro is too strong. awesome!