Changeset 14571 in project


Ignore:
Timestamp:
05/09/09 05:02:45 (10 years ago)
Author:
Kon Lovett
Message:

Dropped some explicit inlines. Identifiers that are indirectly used (macros & procs) need to be explicitly exported. Ex: the stream-match macros. Also, streams needs $$make-stream-pare explicitly exported by primitives.

Location:
release/4/srfi-41
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • release/4/srfi-41/tags/1.0.1/srfi-41.meta

    r14192 r14571  
    88 (doc-from-wiki)
    99 (synopsis "SRFI-41 (Streams)")
    10  (needs check-errors setup-helper)
     10 (needs srfi-9-ext check-errors setup-helper)
    1111 (files
    1212  "tests"
  • release/4/srfi-41/tags/1.0.1/streams-derived.scm

    r14567 r14571  
    3232  ;; SRFI 41 derived
    3333  define-stream stream stream-let
    34   stream-match
     34  stream-match ;($$stream-match-test)
    3535  stream-of
    3636  stream-constant
     
    4949  stream-zip
    5050  ;; WTF
    51   $$stream-match-pattern
    52   $$stream-match-test)
     51  $$stream-match-test ;($$stream-match-pattern)
     52  $$stream-match-pattern)
    5353
    5454(import scheme chicken
     
    397397    (call-with-values
    398398      (lambda () (generator seed))
    399       (lambda vs (%fxsub1 (length vs)))) )
     399      (lambda vs (%fxsub1 (%length vs)))) )
    400400
    401401  (define-stream (unfold-result-stream seed)
  • release/4/srfi-41/tags/1.0.1/streams-inlines.scm

    r14567 r14571  
    1111    (error-stream loc obj argnam) ) )
    1212
    13 (define-inline (%check-streams loc strms nam)
     13(define-inline (%check-streams loc strms #!optional argnam)
    1414  (when (%any/1 not-stream? strms)
    15     (error-stream loc strms nam) ) )
     15    (error-stream loc strms argnam) ) )
  • release/4/srfi-41/tags/1.0.1/streams-primitive.scm

    r14196 r14571  
    2020  (fixnum)
    2121  (inline)
     22  (inline-limit 50)
    2223  (local)
    2324  (no-procedure-checks))
     
    2627(include "streams-inlines")
    2728
    28 ;;;
    29 
    30 (define-inline (%make-stream-box tag obj) (%cons tag obj))
    31 (define-inline (%stream-box-tag box) (%car box))
    32 (define-inline (%stream-box-value box) (%cdr box))
    33 (define-inline (%stream-box-tag-set! box tag) (%set-car!/immediate box tag))
    34 (define-inline (%stream-box-value-set! box val) (%set-cdr! box val))
    35 
    36 (define-inline (%make-stream-lazy thunk) (%make-stream (%make-stream-box 'lazy thunk)))
    37 (define-inline (%make-stream-eager obj) (%make-stream (%make-stream-box 'eager obj)))
    38 
    39 (define-inline (%make-stream prm) (%make-structure 'stream prm))
    40 ;;(define-inline (%stream? obj) (%structure-instance? obj 'stream)) ;from "streams-inlines.scm"
    41 (define-inline (%stream-promise strm) (%structure-ref strm 1))
    42 (define-inline (%stream-promise-set! strm obj) (%structure-set! strm 1 obj))
    43 
    44 (define-inline (%make-stream-pare kar kdr) (%make-structure 'stream-pare kar kdr))
    45 (define-inline (%stream-pare? obj) (%structure-instance? obj 'stream-pare))
    46 (define-inline (%stream-kar pare) (%structure-ref pare 1))
    47 (define-inline (%stream-kdr pare) (%structure-ref pare 2))
    48 
    49 (define-inline (%stream-null? strm) (%eq? (stream-force strm) (stream-force stream-null)))
    50 
    51 (define-inline (%checked-stream-pair loc obj)
    52   (cond
    53     ((not (%stream? obj)) (error-stream loc obj 'stream) )
    54     ((%stream-null? obj) (error-stream-occupied loc obj 'stream) )
    55     (else
    56       (let ((val (stream-force obj)))
    57         (if (%stream-pare? val) val
    58             (error-stream-pair loc val 'stream)) ) ) ) )
    59 
    6029(module streams-primitive (;export
    6130  ;; SRFI 41 primitive
    6231  stream?
    6332  stream-null stream-null?
    64   (stream-cons $$stream-eager $$make-stream-pare)
     33  (stream-cons $$make-stream-pare) ;($$stream-eager $$stream-lazy $$stream-delay)
    6534  stream-pair? stream-car stream-cdr
    66   stream-lambda
     35  stream-lambda ;($$stream-lazy)
    6736  ;; Extras
    6837  stream-occupied?
     
    7241  ;; WTF
    7342  ($$stream-lazy $$make-stream-lazy)
    74   ($$stream-delay $$stream-eager)
     43  ($$stream-eager $$make-stream-eager)
     44  $$stream-delay ;($$stream-lazy $$stream-eager)
    7545  $$make-stream-lazy
    76   $$stream-eager
     46  $$make-stream-eager
    7747  $$make-stream-pare)
    7848
    7949(import scheme chicken
    8050  (only type-checks define-check+error-type)
    81   (only type-errors define-error-type))
     51  (only type-errors define-error-type)
     52  srfi-9-ext)
    8253
    83 (require-library type-checks type-errors)
     54(require-library type-checks type-errors srfi-9-ext)
    8455
    8556;;;
    8657
     58(define-record-type/primitive stream
     59  (make-stream prm)
     60  stream?
     61  (prm stream-promise stream-promise-set!) )
     62
    8763(define-check+error-type stream)
    88 (define-check+error-type stream-occupied)
    89 (define-error-type stream-pair)
     64
     65(define (make-stream-box tag obj) (%cons tag obj))
     66(define (stream-box-tag box) (%car box))
     67(define (stream-box-value box) (%cdr box))
     68(define (stream-box-tag-set! box tag) (%set-car!/immediate box tag))
     69(define (stream-box-value-set! box val) (%set-cdr! box val))
     70
     71(define ($$make-stream-lazy thunk) (make-stream (make-stream-box 'lazy thunk)))
     72(define ($$make-stream-eager obj) (make-stream (make-stream-box 'eager obj)))
     73
     74(define (*stream-null? strm) (eq? (stream-force strm) (stream-force stream-null)))
    9075
    9176;;;
    92 
    93 (define (stream? obj) (%stream? obj))
    94 
    95 (define ($$make-stream-lazy thunk) (%make-stream-lazy thunk))
    9677
    9778(define-syntax $$stream-lazy
     
    9980    ((_ EXPR) ($$make-stream-lazy (lambda () EXPR)) ) ) )
    10081
    101 (define ($$stream-eager obj) (%make-stream-eager obj))
     82(define-syntax $$stream-eager
     83  (syntax-rules ()
     84    ((_ EXPR) ($$make-stream-eager EXPR) ) ) )
    10285
    10386(define-syntax $$stream-delay
     
    10588    ((_ EXPR) ($$stream-lazy ($$stream-eager EXPR)) ) ) )
    10689
    107 (define ($$make-stream-pare kar kdr) (%make-stream-pare kar kdr))
    108 
    109 ;;;
    110 
    11190(define (stream-force promise)
    112   (let ((content (%stream-promise promise)))
    113     (case (%stream-box-tag content)
     91  (let ((content (stream-promise promise)))
     92    (case (stream-box-tag content)
    11493      ((eager)
    115         (%stream-box-value content) )
     94        (stream-box-value content) )
    11695      ((lazy)
    117         (let* ((promise* ((%stream-box-value content)))
    118                (content  (%stream-promise promise)))
    119           (unless (%eq? 'eager (%stream-box-tag content))
    120             (let ((prm (%stream-promise promise*)))
    121               (%stream-box-tag-set! content (%stream-box-tag prm))
    122               (%stream-box-value-set! content (%stream-box-value prm)) )
    123             (%stream-promise-set! promise* content) )
     96        (let* ((promise* ((stream-box-value content)))
     97               (content  (stream-promise promise)))
     98          (unless (eq? 'eager (stream-box-tag content))
     99            (let ((prm (stream-promise promise*)))
     100              (stream-box-tag-set! content (stream-box-tag prm))
     101              (stream-box-value-set! content (stream-box-value prm)) )
     102            (stream-promise-set! promise* content) )
    124103         (stream-force promise) ) ) ) ) )
    125104
    126105(define stream-null ($$stream-delay (%cons 'stream 'null)))
    127106
    128 (define (stream-null? obj) (and (%stream? obj) (%stream-null? obj)))
    129 (define (stream-occupied? obj) (and (%stream? obj) (not (%stream-null? obj))))
     107(define (stream-null? obj) (and (%stream? obj) (*stream-null? obj)))
     108(define (stream-occupied? obj) (and (%stream? obj) (not (*stream-null? obj))))
     109
     110(define-check+error-type stream-occupied)
     111
     112(define-syntax stream-lambda
     113  (syntax-rules ()
     114    ((_ FORMALS BODY0 BODY1 ...)
     115     (lambda FORMALS ($$stream-lazy (let () BODY0 BODY1 ...))) ) ) )
     116
     117;;
     118
     119(define-record-type/primitive stream-pare
     120  ($$make-stream-pare kar kdr)
     121  stream-pare?
     122  (kar stream-kar)
     123  (kdr stream-kdr) )
     124
     125(define-error-type stream-pair)
     126
     127(define (checked-stream-pare loc obj)
     128  (cond
     129    ((not (%stream? obj)) (error-stream loc obj 'stream) )
     130    ((*stream-null? obj) (error-stream-occupied loc obj 'stream) )
     131    (else
     132      (let ((val (stream-force obj)))
     133        (if (stream-pare? val) val
     134            (error-stream-pair loc val 'stream)) ) ) ) )
    130135
    131136(define-syntax stream-cons
     
    134139     ($$stream-eager ($$make-stream-pare ($$stream-delay EXPR) ($$stream-lazy STRM))) ) ) )
    135140
    136 (define (stream-pair? obj) (and (%stream? obj) (%stream-pare? (stream-force obj))))
     141(define (stream-pair? obj) (and (%stream? obj) (stream-pare? (stream-force obj))))
    137142
    138143(define (stream-car streem)
    139   (stream-force (%stream-kar (%checked-stream-pair 'stream-car streem))) )
     144  (stream-force (stream-kar (checked-stream-pare 'stream-car streem))) )
    140145
    141146(define (stream-cdr streem)
    142   (%stream-kdr (%checked-stream-pair 'stream-cdr streem)) )
    143 
    144 (define-syntax stream-lambda
    145   (syntax-rules ()
    146     ((_ FORMALS BODY0 BODY1 ...)
    147      (lambda FORMALS ($$stream-lazy (let () BODY0 BODY1 ...))) ) ) )
     147  (stream-kdr (checked-stream-pare 'stream-cdr streem)) )
    148148
    149149) ;module streams-primitive
  • release/4/srfi-41/trunk/srfi-41.meta

    r14192 r14571  
    88 (doc-from-wiki)
    99 (synopsis "SRFI-41 (Streams)")
    10  (needs check-errors setup-helper)
     10 (needs srfi-9-ext check-errors setup-helper)
    1111 (files
    1212  "tests"
  • release/4/srfi-41/trunk/streams-derived.scm

    r14566 r14571  
    3232  ;; SRFI 41 derived
    3333  define-stream stream stream-let
    34   stream-match
     34  stream-match ;($$stream-match-test)
    3535  stream-of
    3636  stream-constant
     
    4949  stream-zip
    5050  ;; WTF
    51   $$stream-match-pattern
    52   $$stream-match-test)
     51  $$stream-match-test ;($$stream-match-pattern)
     52  $$stream-match-pattern)
    5353
    5454(import scheme chicken
     
    397397    (call-with-values
    398398      (lambda () (generator seed))
    399       (lambda vs (%fxsub1 (length vs)))) )
     399      (lambda vs (%fxsub1 (%length vs)))) )
    400400
    401401  (define-stream (unfold-result-stream seed)
  • release/4/srfi-41/trunk/streams-inlines.scm

    r14566 r14571  
    1111    (error-stream loc obj argnam) ) )
    1212
    13 (define-inline (%check-streams loc strms nam)
     13(define-inline (%check-streams loc strms #!optional argnam)
    1414  (when (%any/1 not-stream? strms)
    15     (error-stream loc strms nam) ) )
     15    (error-stream loc strms argnam) ) )
  • release/4/srfi-41/trunk/streams-primitive.scm

    r14196 r14571  
    2020  (fixnum)
    2121  (inline)
     22  (inline-limit 50)
    2223  (local)
    2324  (no-procedure-checks))
     
    2627(include "streams-inlines")
    2728
    28 ;;;
    29 
    30 (define-inline (%make-stream-box tag obj) (%cons tag obj))
    31 (define-inline (%stream-box-tag box) (%car box))
    32 (define-inline (%stream-box-value box) (%cdr box))
    33 (define-inline (%stream-box-tag-set! box tag) (%set-car!/immediate box tag))
    34 (define-inline (%stream-box-value-set! box val) (%set-cdr! box val))
    35 
    36 (define-inline (%make-stream-lazy thunk) (%make-stream (%make-stream-box 'lazy thunk)))
    37 (define-inline (%make-stream-eager obj) (%make-stream (%make-stream-box 'eager obj)))
    38 
    39 (define-inline (%make-stream prm) (%make-structure 'stream prm))
    40 ;;(define-inline (%stream? obj) (%structure-instance? obj 'stream)) ;from "streams-inlines.scm"
    41 (define-inline (%stream-promise strm) (%structure-ref strm 1))
    42 (define-inline (%stream-promise-set! strm obj) (%structure-set! strm 1 obj))
    43 
    44 (define-inline (%make-stream-pare kar kdr) (%make-structure 'stream-pare kar kdr))
    45 (define-inline (%stream-pare? obj) (%structure-instance? obj 'stream-pare))
    46 (define-inline (%stream-kar pare) (%structure-ref pare 1))
    47 (define-inline (%stream-kdr pare) (%structure-ref pare 2))
    48 
    49 (define-inline (%stream-null? strm) (%eq? (stream-force strm) (stream-force stream-null)))
    50 
    51 (define-inline (%checked-stream-pair loc obj)
    52   (cond
    53     ((not (%stream? obj)) (error-stream loc obj 'stream) )
    54     ((%stream-null? obj) (error-stream-occupied loc obj 'stream) )
    55     (else
    56       (let ((val (stream-force obj)))
    57         (if (%stream-pare? val) val
    58             (error-stream-pair loc val 'stream)) ) ) ) )
    59 
    6029(module streams-primitive (;export
    6130  ;; SRFI 41 primitive
    6231  stream?
    6332  stream-null stream-null?
    64   (stream-cons $$stream-eager $$make-stream-pare)
     33  (stream-cons $$make-stream-pare) ;($$stream-eager $$stream-lazy $$stream-delay)
    6534  stream-pair? stream-car stream-cdr
    66   stream-lambda
     35  stream-lambda ;($$stream-lazy)
    6736  ;; Extras
    6837  stream-occupied?
     
    7241  ;; WTF
    7342  ($$stream-lazy $$make-stream-lazy)
    74   ($$stream-delay $$stream-eager)
     43  ($$stream-eager $$make-stream-eager)
     44  $$stream-delay ;($$stream-lazy $$stream-eager)
    7545  $$make-stream-lazy
    76   $$stream-eager
     46  $$make-stream-eager
    7747  $$make-stream-pare)
    7848
    7949(import scheme chicken
    8050  (only type-checks define-check+error-type)
    81   (only type-errors define-error-type))
     51  (only type-errors define-error-type)
     52  srfi-9-ext)
    8253
    83 (require-library type-checks type-errors)
     54(require-library type-checks type-errors srfi-9-ext)
    8455
    8556;;;
    8657
     58(define-record-type/primitive stream
     59  (make-stream prm)
     60  stream?
     61  (prm stream-promise stream-promise-set!) )
     62
    8763(define-check+error-type stream)
    88 (define-check+error-type stream-occupied)
    89 (define-error-type stream-pair)
     64
     65(define (make-stream-box tag obj) (%cons tag obj))
     66(define (stream-box-tag box) (%car box))
     67(define (stream-box-value box) (%cdr box))
     68(define (stream-box-tag-set! box tag) (%set-car!/immediate box tag))
     69(define (stream-box-value-set! box val) (%set-cdr! box val))
     70
     71(define ($$make-stream-lazy thunk) (make-stream (make-stream-box 'lazy thunk)))
     72(define ($$make-stream-eager obj) (make-stream (make-stream-box 'eager obj)))
     73
     74(define (*stream-null? strm) (eq? (stream-force strm) (stream-force stream-null)))
    9075
    9176;;;
    92 
    93 (define (stream? obj) (%stream? obj))
    94 
    95 (define ($$make-stream-lazy thunk) (%make-stream-lazy thunk))
    9677
    9778(define-syntax $$stream-lazy
     
    9980    ((_ EXPR) ($$make-stream-lazy (lambda () EXPR)) ) ) )
    10081
    101 (define ($$stream-eager obj) (%make-stream-eager obj))
     82(define-syntax $$stream-eager
     83  (syntax-rules ()
     84    ((_ EXPR) ($$make-stream-eager EXPR) ) ) )
    10285
    10386(define-syntax $$stream-delay
     
    10588    ((_ EXPR) ($$stream-lazy ($$stream-eager EXPR)) ) ) )
    10689
    107 (define ($$make-stream-pare kar kdr) (%make-stream-pare kar kdr))
    108 
    109 ;;;
    110 
    11190(define (stream-force promise)
    112   (let ((content (%stream-promise promise)))
    113     (case (%stream-box-tag content)
     91  (let ((content (stream-promise promise)))
     92    (case (stream-box-tag content)
    11493      ((eager)
    115         (%stream-box-value content) )
     94        (stream-box-value content) )
    11695      ((lazy)
    117         (let* ((promise* ((%stream-box-value content)))
    118                (content  (%stream-promise promise)))
    119           (unless (%eq? 'eager (%stream-box-tag content))
    120             (let ((prm (%stream-promise promise*)))
    121               (%stream-box-tag-set! content (%stream-box-tag prm))
    122               (%stream-box-value-set! content (%stream-box-value prm)) )
    123             (%stream-promise-set! promise* content) )
     96        (let* ((promise* ((stream-box-value content)))
     97               (content  (stream-promise promise)))
     98          (unless (eq? 'eager (stream-box-tag content))
     99            (let ((prm (stream-promise promise*)))
     100              (stream-box-tag-set! content (stream-box-tag prm))
     101              (stream-box-value-set! content (stream-box-value prm)) )
     102            (stream-promise-set! promise* content) )
    124103         (stream-force promise) ) ) ) ) )
    125104
    126105(define stream-null ($$stream-delay (%cons 'stream 'null)))
    127106
    128 (define (stream-null? obj) (and (%stream? obj) (%stream-null? obj)))
    129 (define (stream-occupied? obj) (and (%stream? obj) (not (%stream-null? obj))))
     107(define (stream-null? obj) (and (%stream? obj) (*stream-null? obj)))
     108(define (stream-occupied? obj) (and (%stream? obj) (not (*stream-null? obj))))
     109
     110(define-check+error-type stream-occupied)
     111
     112(define-syntax stream-lambda
     113  (syntax-rules ()
     114    ((_ FORMALS BODY0 BODY1 ...)
     115     (lambda FORMALS ($$stream-lazy (let () BODY0 BODY1 ...))) ) ) )
     116
     117;;
     118
     119(define-record-type/primitive stream-pare
     120  ($$make-stream-pare kar kdr)
     121  stream-pare?
     122  (kar stream-kar)
     123  (kdr stream-kdr) )
     124
     125(define-error-type stream-pair)
     126
     127(define (checked-stream-pare loc obj)
     128  (cond
     129    ((not (%stream? obj)) (error-stream loc obj 'stream) )
     130    ((*stream-null? obj) (error-stream-occupied loc obj 'stream) )
     131    (else
     132      (let ((val (stream-force obj)))
     133        (if (stream-pare? val) val
     134            (error-stream-pair loc val 'stream)) ) ) ) )
    130135
    131136(define-syntax stream-cons
     
    134139     ($$stream-eager ($$make-stream-pare ($$stream-delay EXPR) ($$stream-lazy STRM))) ) ) )
    135140
    136 (define (stream-pair? obj) (and (%stream? obj) (%stream-pare? (stream-force obj))))
     141(define (stream-pair? obj) (and (%stream? obj) (stream-pare? (stream-force obj))))
    137142
    138143(define (stream-car streem)
    139   (stream-force (%stream-kar (%checked-stream-pair 'stream-car streem))) )
     144  (stream-force (stream-kar (checked-stream-pare 'stream-car streem))) )
    140145
    141146(define (stream-cdr streem)
    142   (%stream-kdr (%checked-stream-pair 'stream-cdr streem)) )
    143 
    144 (define-syntax stream-lambda
    145   (syntax-rules ()
    146     ((_ FORMALS BODY0 BODY1 ...)
    147      (lambda FORMALS ($$stream-lazy (let () BODY0 BODY1 ...))) ) ) )
     147  (stream-kdr (checked-stream-pare 'stream-cdr streem)) )
    148148
    149149) ;module streams-primitive
Note: See TracChangeset for help on using the changeset viewer.