Skip to content

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
State Monad in Scheme
(define (push element)
(lambda (stack)
(list '() (cons element stack))))
(define (pop)
(lambda (stack)
(let ((element (car stack))
(new-stack (cdr stack)))
(list element new-stack))))
(define (stack-of result)
(cadr result))
(define (value-of result)
(car result))
(define (>>= stack-action continuation)
(lambda (stack)
(let ((result (stack-action stack)))
((continuation (value-of result)) (stack-of result)))))
(define (return value)
(lambda (stack)
(list value stack)))
(define (run-stack computation stack)
(computation stack))
(define (eval-stack computation stack)
(value-of (computation stack)))
(define (exec-stack computation stack)
(stack-of (computation stack)))
(define computation-1 (>>= (push 4) (lambda (_)
(>>= (push 5) (lambda (_)
(>>= (pop) (lambda (a)
(>>= (pop) (lambda (b)
(return (list a b)))))))))))
(define computation-2 (>>= (push 2) (lambda (_)
(>>= (push 3) (lambda (_)
(>>= (pop) (lambda (a)
(>>= (pop) (lambda (b)
(return (list a b)))))))))))
(define (main)
(let ((initial-stack '())
(composed (>>= computation-1 (lambda (a)
(>>= computation-2 (lambda (b)
(return (list a b))))))))
(begin
(display "Result: ")
(display (eval-stack composed initial-stack)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.