haskeem-0.7.9: callcc.scm

; Copyright 2009 Uwe Hollerbach <uh@alumni.caltech.edu>
; $Id: callcc.scm,v 1.2 2009-07-11 03:59:28 uwe Exp $
; BSD3

; "poor man's" continuations: one-shot, limited lifespan, and while they
; are nestable, if you activate an outer one, any inner ones get consumed

(define (call/cc1 func)
  (let* ((sym (gensym))
	 (cont (lambda (ret) (raise (cons sym ret)))))
    (guard
     (err ((and (pair? err) (eqv? sym (car err)))
	   (cdr err)))
     (func cont))))

(defmacro (let/cc1 k . body)
  `(call/cc1 (lambda (,k) ,@body)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; some tests

(define (f1 n)
  (+ 10 (* 5 (/ 1 n))))

(define (f2 n)
  (+ 10 (* 5 (call/cc1
	      (lambda (k)
		(/ 1 (if (zero? n)
			 (k 1)
			 n)))))))

(define (f3 n)
  (+ 10 (* 5 (let/cc1 k
		      (/ 1 (if (zero? n)
			       (k 1)
			       n))))))