haskeem-0.7.12: callcc.scm

; Copyright 2009 Uwe Hollerbach <uh@alumni.caltech.edu>
; $Id: callcc.scm,v 1.4 2009-08-06 04:19:18 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)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; From Queinnec, "A Library of Continuations":
; call/cc via delimited continuations
; This obviously requires that reset/shift or prompt/control
; can handle the whole enchilada, not just within a single s-expr

; call/cc expressed via prompt/control: given a program P which
; does not use prompt/control, provide call/cc as

; I think this uses different syntax than my version...
; (control (lambda (pc) ...)) -> (control pc ...) in mine;
; more like the reset/shift version below

;;(let ()
;;  (define (call/cc f)
;;    (control (lambda (pc)
;;	       (pc (f (lambda (v)
;;			(control (lambda (ignore-pc) (pc v)))))))))
;;  (prompt P))

; translated into my version... I think

;;(let ()
;;  (define (call/cc f)
;;    (control pc (pc (f (lambda (v)
;;			 (control ignore-pc (pc v)))))))
;;  (prompt P))

; call/cc expressed via reset/shift: given a program P which
; does not use reset/shift, provide call/cc as

;;(let ()
;;  (define (call/cc f)
;;    (shift pc (pc (f (lambda (v)
;;		       (shift ignore-pc (pc v)))))))
;;  (reset P))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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))))))