<br />
<b>Deprecated</b>:  The each() function is deprecated. This message will be suppressed on further calls in <b>/home/zhenxiangba/zhenxiangba.com/public_html/phproxy-improved-master/index.php</b> on line <b>456</b><br />

; the Scheme code from the paper
; indented with Emacs Scheme mode
; ht 2.9.1998

(define call/cc call-with-current-continuation)


; Section 1 ----------------------------------------------------------

; obfuscated looping

(define cycle-proc 
  (lambda (proc)
    (let ((loop (call/cc (lambda (k) k))))
      (begin
	(proc)
	(loop loop)))))


; "may produce some function that may call the escape function as its value"

(call/cc
 (lambda (k)
   (lambda (x)
     (k (lambda (y) x)))))

; Section 3 ----------------------------------------------------------

(map
 (call/cc (lambda (k) (lambda (x) (k (lambda (y) x)))))
 (list 1 2 3 4))

; arg-fc

(define arg-fc
  (lambda ()
    (call/cc 
     (lambda (k)
       (k 
	(lambda (x)
	  (k 
	   (lambda (y) x))))))))


; arg-fc with local state for its argument

(define arg-fc-save-arg
  (lambda ()
    (let ((fc #t)
          (arg 'anything))
      (lambda (x)
        (if fc 
	    (begin 
	      (set! fc #f)  
	      (set! arg x)))
        arg))))

; arg-fc with local state for the procedure

(define arg-fc-proc
  (lambda ()
    (letrec ((f (lambda (x)
                  (begin
		    (set! f (lambda (y) x))
		    x))))
      (lambda (z) (f z)))))

; context with state can distinguish them 

(define backtrack? 
  (lambda (testee)
    (let ((ratchet (list 'anything #f #t)))
      (let ((f (testee)))
        (begin
	  (set! ratchet (cdr ratchet))
	  (f 'anything)
	  (car ratchet))))))

(backtrack? arg-fc)

(backtrack? arg-fc-proc)


; twice/cc

(define twice/cc
  (lambda (l)
    (call/cc (lambda (k)
               ((lambda (n) 
                  (k (list n (cadr l))))
                (call/cc (lambda (q) 
                           (k (list (car l) q)))))))))

(define twice/cc
  (lambda (p)
    (call/cc (lambda (k)
               ((lambda (n)
                  (k (cons n (cdr p))))
                (call/cc (lambda (q)
                           (k (cons (car p) q)))))))))

; Section 4 ----------------------------------------------------------

(let ((f (arg-fc)))
  (begin
    (f #t) 
    (f #f)))

(begin 
  ((arg-fc) #t)
  ((arg-fc) #f))

(define copy-val 
  (lambda (M)
    (let ((x (M)))
      (list x x))))

(define copy-comp
  (lambda (M)
    (let ((x (M)))
      (let ((y (M)))
        (list x y)))))

(define copy-separator
  (lambda (copier)
    (let ((funs (copier arg-fc)))
      (let ((f (car funs)))
        (let ((g (cadr funs)))
          (begin 
	    (f #t) 
	    (g #f)))))))


(copy-separator copy-val)

(copy-separator copy-comp)

      
; Refutation of the idempotency hypothesis

(define idempotency-separator
  (lambda (testee)
    (let ((procs (testee)))
      (begin
        ((car procs) #t) 
        ((cdr procs) #f)))))

(define arg-fc-1copy
  (lambda ()
    (let ((x (arg-fc)))
      (cons x x))))

(define arg-fc-2copies
  (lambda ()
    (let ((x (arg-fc)))
      (let ((y (arg-fc)))
        (cons x y)))))

(idempotency-separator arg-fc-1copy)

(idempotency-separator arg-fc-2copies)