public
Last active

State Monad in Scheme

  • Download Gist
state-monad.scm
Scheme
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
(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)))))

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.