Changeset 37261 in project


Ignore:
Timestamp:
02/18/19 03:42:49 (8 months ago)
Author:
Kon Lovett
Message:

rename, extract, redundant inline

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/5/srfi-41/trunk/streams-primitive.scm

    r37256 r37261  
    5555(define-check+error-type stream %stream?)
    5656
     57(define-inline (stream-tagged-pair? obj)
     58  (and
     59    (%pair? obj)
     60    (let ((tag (%car obj)))
     61      (or (%eq? 'lazy tag) (%eq? 'eager tag)) ) ) )
     62
    5763(define-inline (make-stream-box tag obj) (%cons tag obj))
    5864(define-inline (stream-box-tag box) (%car box))
     
    6369(define-inline (make-stream-eager-box obj) (make-stream-box 'eager obj))
    6470(define-inline (check-stream-box loc obj)
    65   (unless (and (%pair? obj)
    66                (let ((tag (%car obj)))
    67                  (or (%eq? 'lazy tag) (%eq? 'eager tag))))
    68     (error-argument-type loc obj "stream-box") ) )
     71  (unless (stream-tagged-pair? obj)
     72    (error-argument-type loc obj "stream-box") )
     73  obj )
    6974
    7075;;;
     
    8893      ($$stream-lazy ($$stream-eager ?expr)) ) ) )
    8994
    90 (define (stream-force stream)
     95(define (stream-force prom)
    9196  (let* (
    92     (promise (%stream-promise (check-stream #f stream)))
    93     (promise-box-value (stream-box-value promise)) )
    94     ;better be there! (check-stream-box #f promise)
    95     (case (stream-box-tag promise)
     97    (content (%stream-promise (check-stream #f prom)))
     98    (promise-box-value (stream-box-value content)) )
     99    ;better be there! (check-stream-box #f content)
     100    (case (stream-box-tag content)
    96101      ((eager)
    97102        promise-box-value )
    98103      ((lazy)
    99104        (let* (
    100           (stream* (promise-box-value))
     105          (prom* (promise-box-value))
    101106          ;re-fetch promise in case changed by recursion via above call.
    102           (promise (%stream-promise stream)) )
     107          (content (%stream-promise prom)) )
    103108          ;re-establish bona-fides
    104           (check-stream #f stream*)
    105           ;better be there! (check-stream-box #f promise)
    106           (unless (eq? 'eager (stream-box-tag promise))
     109          (check-stream #f prom*)
     110          ;better be there! (check-stream-box #f content)
     111          (unless (eq? 'eager (stream-box-tag content))
    107112            (let (
    108               (stream*-promise (%stream-promise stream*)) )
    109               (stream-box-tag-set! promise (stream-box-tag stream*-promise))
    110               (stream-box-value-set! promise (stream-box-value stream*-promise)) )
    111             (%stream-promise-set! stream* promise) )
    112           ;
    113           (stream-force stream) ) ) ) ) )
    114 
    115 (define-inline (*stream-null? stream)
    116   (eq? (stream-force stream) (stream-force stream-null)) )
     113              (content* (%stream-promise prom*)) )
     114              (stream-box-tag-set! content (stream-box-tag content*))
     115              (stream-box-value-set! content (stream-box-value content*)) )
     116            (%stream-promise-set! prom* content) )
     117          (stream-force prom) ) ) ) ) )
    117118
    118119;;;
     
    121122
    122123(define stream-null ($$stream-delay (%cons 'stream 'null)))
     124
     125(define-inline (*stream-null? strm)
     126  (eq? (stream-force strm) (stream-force stream-null)) )
    123127
    124128(define (stream-null? obj) (and (%stream? obj) (*stream-null? obj)))
     
    146150(define-error-type stream-pair)
    147151
    148 (define (checked-stream-pair loc obj)
     152(define-inline (checked-stream-pair loc obj)
    149153  (cond
    150154    ((not (%stream? obj))
Note: See TracChangeset for help on using the changeset viewer.