Changeset 37733 in project


Ignore:
Timestamp:
06/23/19 12:37:06 (4 weeks ago)
Author:
juergen
Message:

continuations 1.1 with call/ep and let/ep added

Location:
release/5/continuations
Files:
5 edited
2 copied

Legend:

Unmodified
Added
Removed
  • release/5/continuations/tags/1.1/continuations.egg

    r37408 r37733  
    55 (test-dependencies simple-tests)
    66 (author "[[Juergen Lorenz]]")
    7  (version "1.0")
     7 (version "1.1")
    88 (components (extension continuations)))
    99
  • release/5/continuations/tags/1.1/continuations.scm

    r37711 r37733  
    3232; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
    3333;
    34 ; Last update: Jun 14, 2019
     34; Last update: Jun 23, 2019
    3535;
    3636;;; simplifying Marc Feeley's continuation interface with some additions,
     
    4545  continuation?
    4646  continuation->procedure
    47   ;current
     47  call/ep
     48  let/ep
    4849  escape-procedure
    4950  escape-procedure?
     
    5758                define-values
    5859                case-lambda
     60                call/cc
    5961                print
    6062                gensym)
     
    8486             (receiver (continuation->procedure cc)))))
    8587
    86 ;(define (current)
    87 ;  (capture (lambda (cc) (throw cc cc))))
    88 
    8988(define (continuation)
    9089  (capture (lambda (cc) (throw cc cc))))
     
    9291(define (goto cc) (throw cc cc))
    9392
    94 ;;; Matt Wright's functional interface
    95 (define-values (escape-procedure escape-procedure?)
    96   (let ((type (gensym 'escape-procedure)))
    97     (values
    98       (lambda ()
    99         (call-with-current-continuation
    100           (lambda (cc)
    101                    (cc (extend-procedure cc type)))))
    102       (lambda (xpr)
    103         (and (extended-procedure? xpr)
    104              (eq? (procedure-data xpr) type)))
    105       )))
     93;; continuations as typed escape-procedures
     94(define call/ep #f)
     95(define escape-procedure? #f)
     96
     97(let ((type (gensym 'escaper)))
     98  (set! call/ep
     99        (lambda (receiver)
     100          (call/cc
     101            (lambda (k)
     102              (receiver
     103                (extend-procedure k type))))))
     104  (set! escape-procedure?
     105        (lambda (xpr)
     106          (and (extended-procedure? xpr)
     107               (eq? (procedure-data xpr)
     108                    type)))))
     109
     110(define (escape-procedure)
     111  (call/ep (lambda (k) k)))
     112
     113(define-syntax let/ep
     114  (syntax-rules ()
     115    ((_ k xpr . xprs)
     116     (call/ep
     117       (lambda (k) xpr . xprs)))))
    106118
    107119(define continuations
     
    148160            (throw cc val ...)
    149161            "alias for continuation-return")
     162          (call/ep
     163            procedure:
     164            (call/ep receiver)
     165            "like call/cc but reifies the captured continuation"
     166            "as typed escape-procedure")
     167          (let/ep
     168            macro:
     169            (let/ep k xpr . xprs)
     170            "like let/cc but reifies the captured continuation"
     171            "k as typed escape-procedure")
    150172          (escape-procedure
    151173            procedure:
    152174            (escape-procedure)
    153             "captures the current continuation as an escape procedure")
     175            "captures the current continuation as typed escape procedure")
    154176          (escape-procedure?
    155177            procedure:
    156178            (escape-procedure? xpr)
    157             "checks if xpr is an escape procedure")
     179            "checks if xpr is a continuation"
     180            "captured by call/ep or let/ep"
     181            "and reified as typed escape-procedure")
    158182          )))
    159183    (case-lambda
  • release/5/continuations/tags/1.1/tests/run.scm

    r37408 r37733  
    4343         #f))
    4444
     45(define-test (continuations?)
     46  (not (let ((cc (continuation)))
     47         (cond
     48           ((continuation? cc)
     49            (throw cc (lambda (arg) #f)))
     50           ((procedure? cc)
     51            (cc cc)))))
     52  (= 5 (+ 1 (call (lambda (cc) (* 5 (cc 4))))))
     53  (= (search even? '(1 2 3)) 2)
     54  (not (search even? '(1 3)))
     55  (= (search-with-goto odd? '(0 1 2 3)) 1)
     56  (not (search-with-goto odd? '(0 2)))
     57  (= (handled-search (treat even?) '(1 2 3)) 2)
     58  )
     59
    4560(define (product . nums)
    4661  (let ((cc (escape-procedure)))
     
    5974      )))
    6075
    61 (define-test (continuations?)
    62   (not (let ((cc (continuation)))
     76(define ep #f)
     77
     78(define-test (escape-procedures?)
     79  (eq? (let ((cc (escape-procedure)))
    6380         (cond
    64            ((continuation? cc)
    65             (throw cc (lambda (arg) #f)))
    66            ((procedure? cc)
    67             (cc cc)))))
    68   (= 5 (+ 1 (call (lambda (cc) (* 5 (cc 4))))))
    69   (= (search even? '(1 2 3)) 2)
    70   (not (search even? '(1 3)))
    71   (= (search-with-goto odd? '(0 1 2 3)) 1)
    72   (not (search-with-goto odd? '(0 2)))
    73   (= (handled-search (treat even?) '(1 2 3)) 2)
     81           ((escape-procedure? cc)
     82            (cc 'normal-value))
     83           (else
     84             cc)))
     85       'normal-value)
    7486  (zero? (product 1 2 0 3 4))
    7587  (= (product 1 2 3 4) 24)
     88  (= (call/ep (lambda (k)
     89                (+ 10 (k 1))))
     90     1)
     91  (string? (let/ep k (set! ep k)
     92           "continuation exported to ep, but not called"))
     93  (escape-procedure? ep)
     94  (not (escape-procedure? +))
    7695  )
    7796 
    7897(compound-test (CONTINUATIONS)
    7998  (continuations?)
     99  (escape-procedures?)
    80100  )
  • release/5/continuations/trunk/continuations.egg

    r37408 r37733  
    55 (test-dependencies simple-tests)
    66 (author "[[Juergen Lorenz]]")
    7  (version "1.0")
     7 (version "1.1")
    88 (components (extension continuations)))
    99
  • release/5/continuations/trunk/continuations.scm

    r37711 r37733  
    3232; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
    3333;
    34 ; Last update: Jun 14, 2019
     34; Last update: Jun 23, 2019
    3535;
    3636;;; simplifying Marc Feeley's continuation interface with some additions,
     
    4545  continuation?
    4646  continuation->procedure
    47   ;current
     47  call/ep
     48  let/ep
    4849  escape-procedure
    4950  escape-procedure?
     
    5758                define-values
    5859                case-lambda
     60                call/cc
    5961                print
    6062                gensym)
     
    8486             (receiver (continuation->procedure cc)))))
    8587
    86 ;(define (current)
    87 ;  (capture (lambda (cc) (throw cc cc))))
    88 
    8988(define (continuation)
    9089  (capture (lambda (cc) (throw cc cc))))
     
    9291(define (goto cc) (throw cc cc))
    9392
    94 ;;; Matt Wright's functional interface
    95 (define-values (escape-procedure escape-procedure?)
    96   (let ((type (gensym 'escape-procedure)))
    97     (values
    98       (lambda ()
    99         (call-with-current-continuation
    100           (lambda (cc)
    101                    (cc (extend-procedure cc type)))))
    102       (lambda (xpr)
    103         (and (extended-procedure? xpr)
    104              (eq? (procedure-data xpr) type)))
    105       )))
     93;; continuations as typed escape-procedures
     94(define call/ep #f)
     95(define escape-procedure? #f)
     96
     97(let ((type (gensym 'escaper)))
     98  (set! call/ep
     99        (lambda (receiver)
     100          (call/cc
     101            (lambda (k)
     102              (receiver
     103                (extend-procedure k type))))))
     104  (set! escape-procedure?
     105        (lambda (xpr)
     106          (and (extended-procedure? xpr)
     107               (eq? (procedure-data xpr)
     108                    type)))))
     109
     110(define (escape-procedure)
     111  (call/ep (lambda (k) k)))
     112
     113(define-syntax let/ep
     114  (syntax-rules ()
     115    ((_ k xpr . xprs)
     116     (call/ep
     117       (lambda (k) xpr . xprs)))))
    106118
    107119(define continuations
     
    148160            (throw cc val ...)
    149161            "alias for continuation-return")
     162          (call/ep
     163            procedure:
     164            (call/ep receiver)
     165            "like call/cc but reifies the captured continuation"
     166            "as typed escape-procedure")
     167          (let/ep
     168            macro:
     169            (let/ep k xpr . xprs)
     170            "like let/cc but reifies the captured continuation"
     171            "k as typed escape-procedure")
    150172          (escape-procedure
    151173            procedure:
    152174            (escape-procedure)
    153             "captures the current continuation as an escape procedure")
     175            "captures the current continuation as typed escape procedure")
    154176          (escape-procedure?
    155177            procedure:
    156178            (escape-procedure? xpr)
    157             "checks if xpr is an escape procedure")
     179            "checks if xpr is a continuation"
     180            "captured by call/ep or let/ep"
     181            "and reified as typed escape-procedure")
    158182          )))
    159183    (case-lambda
  • release/5/continuations/trunk/tests/run.scm

    r37408 r37733  
    4343         #f))
    4444
     45(define-test (continuations?)
     46  (not (let ((cc (continuation)))
     47         (cond
     48           ((continuation? cc)
     49            (throw cc (lambda (arg) #f)))
     50           ((procedure? cc)
     51            (cc cc)))))
     52  (= 5 (+ 1 (call (lambda (cc) (* 5 (cc 4))))))
     53  (= (search even? '(1 2 3)) 2)
     54  (not (search even? '(1 3)))
     55  (= (search-with-goto odd? '(0 1 2 3)) 1)
     56  (not (search-with-goto odd? '(0 2)))
     57  (= (handled-search (treat even?) '(1 2 3)) 2)
     58  )
     59
    4560(define (product . nums)
    4661  (let ((cc (escape-procedure)))
     
    5974      )))
    6075
    61 (define-test (continuations?)
    62   (not (let ((cc (continuation)))
     76(define ep #f)
     77
     78(define-test (escape-procedures?)
     79  (eq? (let ((cc (escape-procedure)))
    6380         (cond
    64            ((continuation? cc)
    65             (throw cc (lambda (arg) #f)))
    66            ((procedure? cc)
    67             (cc cc)))))
    68   (= 5 (+ 1 (call (lambda (cc) (* 5 (cc 4))))))
    69   (= (search even? '(1 2 3)) 2)
    70   (not (search even? '(1 3)))
    71   (= (search-with-goto odd? '(0 1 2 3)) 1)
    72   (not (search-with-goto odd? '(0 2)))
    73   (= (handled-search (treat even?) '(1 2 3)) 2)
     81           ((escape-procedure? cc)
     82            (cc 'normal-value))
     83           (else
     84             cc)))
     85       'normal-value)
    7486  (zero? (product 1 2 0 3 4))
    7587  (= (product 1 2 3 4) 24)
     88  (= (call/ep (lambda (k)
     89                (+ 10 (k 1))))
     90     1)
     91  (string? (let/ep k (set! ep k)
     92           "continuation exported to ep, but not called"))
     93  (escape-procedure? ep)
     94  (not (escape-procedure? +))
    7695  )
    7796 
    7897(compound-test (CONTINUATIONS)
    7998  (continuations?)
     99  (escape-procedures?)
    80100  )
Note: See TracChangeset for help on using the changeset viewer.