Changeset 14153 in project


Ignore:
Timestamp:
04/07/09 16:05:00 (11 years ago)
Author:
Kon Lovett
Message:

Save.

Location:
release/4/srfi-45/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/srfi-45/trunk/srfi-45.scm

    r14152 r14153  
    3636(define-inline (%promise-box-set! box prmbox) (*box-structure-set! box prmbox))
    3737
    38 (define-inline (%promise-box?->promise-box obj)
     38(define-inline (%checked-promise-box obj)
    3939  (and (*box-structure? obj)
    4040       (let ((boxed (%promise-box-ref obj)))
     
    4343
    4444(define-inline (%lazy-promise? obj)
    45   (and-let* ((boxed (%promise-box?->promise-box obj)))
     45  (and-let* ((boxed (%checked-promise-box obj)))
    4646    (%eq? lazy-tag (%promise-box-tag boxed))) )
    4747
    4848(define-inline (%eager-promise? obj)
    49   (and-let* ((boxed (%promise-box?->promise-box obj)))
     49  (and-let* ((boxed (%checked-promise-box obj)))
    5050    (%eq? eager-tag (%promise-box-tag boxed) ) ) )
    5151
    5252(define-inline (%promise? obj)
    53   (and-let* ((boxed (%promise-box?->promise-box obj)))
     53  (and-let* ((boxed (%checked-promise-box obj)))
    5454    (let ((tag (%promise-box-tag boxed)))
    5555      (or (%eq? lazy-tag tag) (%eq? eager-tag tag) ) ) ) )
     
    154154                   (let ((value1 (and (= 1 (length value*)) (%car value*))))
    155155
     156                     ; Copy the enclosed promise to the top
     157                     (let ((promise-box (%promise-box-ref value1)))
     158                        (%promise-box-tag-set! top-box (%promise-box-tag promise-box))
     159                        (%promise-box-value-set! top-box (%promise-box-value promise-box))
     160                        (%promise-box-set! value1 top-box) )
     161
     162                     #;
     163                     (if (%lazy-promise? value1)
     164
     165                         ; then copy the enclosed promise to the top
     166                         (let ((promise-box (%promise-box-ref value1)))
     167                            (%promise-box-tag-set! top-box (%promise-box-tag promise-box))
     168                            (%promise-box-value-set! top-box (%promise-box-value promise-box))
     169                            (%promise-box-set! value1 top-box) )
     170
     171                         ; else
     172                         (error 'force "expected a lazy promise" value*) )
     173
     174                     #;
    156175                     (cond ((not value1)
    157176                            (%promise-box-value-set! top-box value*) )
  • release/4/srfi-45/trunk/tests/run.scm

    r14152 r14153  
    6565
    6666(define (stream-drop s index)
    67   (lazy
    68    (if (zero? index)
    69        s
    70        (stream-drop (cdr (force s)) (- index 1)))))
     67  (lazy (if (zero? index) s
     68            (stream-drop (cdr (force s)) (- index 1)))))
    7169
    7270(define (ones)
     
    8785(define count 0)
    8886(define p
    89   (d-lay (begin (set! count (+ count 1))
    90                 (if (> count x)
    91                    count
    92                     (force p)))))
     87  (d-lay (begin
     88           (set! count (+ count 1))
     89           (if (> count x) count
     90               (force p)))))
    9391(define x 5)
    9492(print (force p))
     
    104102(define f
    105103  (let ((first? #t))
    106     (d-lay
    107       (if first?
    108           (begin
    109             (set! first? #f)
    110             (force f))
    111           'second))))
     104    (d-lay (if (not first?) 'second
     105               (begin
     106                 (set! first? #f)
     107                 (force f))))))
    112108
    113109(print (force f))
     
    121117  (let ((count 5))
    122118    (define (get-count) count)
    123     (define p (d-lay (if (<= count 0)
    124                          count
    125                          (begin (set! count (- count 1))
    126                                 (force p)
    127                                 (set! count (+ count 2))
    128                                 count))))
     119    (define p (d-lay (if (<= count 0) count
     120                         (begin
     121                           (set! count (- count 1))
     122                           (force p)
     123                           (set! count (+ count 2))
     124                           count))))
    129125    (list get-count p)))
     126
    130127(define get-count (car q))
    131128(define p (cadr q))
     
    181178       ((h . t) exp2))
    182179     (let ((lst exp))
    183        (cond ((null? lst) exp1)
    184              ((pair? lst) (let ((h (car lst))
    185                                 (t (cdr lst)))
    186                             exp2))
    187              (else 'test:match-error))))))
     180       (cond ((null? lst)
     181               exp1)
     182             ((pair? lst)
     183              (let ((h (car lst))
     184                    (t (cdr lst)))
     185                exp2))
     186             (else
     187              'test:match-error))))))
    188188
    189189;========================================================================
     
    193193(define (stream-filter p? s)
    194194  (lazy (test:match (force s)
    195           (()      (d-lay '()))
    196           ((h . t) (if (p? h)
    197                        (d-lay (cons h (stream-filter p? t)))
    198                        (stream-filter p? t))))))
     195          (()
     196           (d-lay '()))
     197          ((h . t)
     198           (if (p? h) (d-lay (cons h (stream-filter p? t)))
     199               (stream-filter p? t))))))
    199200
    200201(+bounded-space (force (stream-filter (lambda (n) (= n 100000 #;10000000000)) (from 0))))
     
    209210
    210211(define (stream-ref s index)
    211   (lazy
    212    (test:match (force s)
    213      (()      'error)
    214      ((h . t) (if (zero? index)
    215                  (d-lay h)
    216                   (stream-ref t (- index 1)))))))
     212  (lazy (test:match (force s)
     213          (()
     214           'error)
     215          ((h . t)
     216           (if (zero? index) (d-lay h)
     217               (stream-ref t (- index 1)))))))
    217218
    218219; Check that evenness is correctly implemented - should terminate:
     
    230231
    231232(define (times3 n)
    232   (stream-ref (stream-filter
    233                (lambda (x) (zero? (modulo x n)))
    234                (from 0))
    235               3))
     233  (stream-ref (stream-filter (lambda (x) (zero? (modulo x n))) (from 0)) 3))
    236234
    237235(print "+++ Should print 21 +++")
Note: See TracChangeset for help on using the changeset viewer.