Changeset 14141 in project


Ignore:
Timestamp:
04/07/09 03:23:40 (11 years ago)
Author:
Kon Lovett
Message:

Renamed identifiers that shouldn't need to be explicitly exported (& therefore visible) to $...$ so kinda obvious no touchy.

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

Legend:

Unmodified
Added
Removed
  • release/4/srfi-41/trunk/streams-derived.scm

    r14140 r14141  
    2121  (inline)
    2222  (local)
    23   (no-procedure-checks) )
     23  (no-procedure-checks)
     24  (bound-to-procedure
     25    ##sys#signal-hook))
    2426
    2527;;;
     
    6264  stream-zip
    6365  ;; WTF
    64   stream-match-pattern
    65   stream-match-test)
     66  $stream-match-pattern$
     67  $stream-match-test$)
    6668
    6769(import scheme chicken
     
    100102    (syntax-case x ()
    101103      ((stream-match-pattern STRM () (BINDING ...) BODY)
    102        #'(and (stream-null? STRM) (let (BINDING ...) BODY)))
     104       #'(and (stream-null? STRM)
     105              (let (BINDING ...) BODY)))
    103106
    104107      ((stream-match-pattern STRM (W? . REST) (BINDING ...) BODY)
     
    133136) ) )
    134137
    135 (define-syntax stream-match-pattern
     138(define-syntax $stream-match-pattern$
    136139  (syntax-rules (_)
    137140
    138     ((stream-match-pattern STRM () (BINDING ...) BODY)
    139      (and (stream-null? STRM) (let (BINDING ...) BODY)))
    140 
    141     ((stream-match-pattern STRM (_ . REST) (BINDING ...) BODY)
     141    (($stream-match-pattern$ STRM () (BINDING ...) BODY)
     142     (and (stream-null? STRM)
     143          (let (BINDING ...) BODY)))
     144
     145    (($stream-match-pattern$ STRM (_ . REST) (BINDING ...) BODY)
    142146     (and (stream-pair? STRM)
    143           (let ((STRM (stream-cdr STRM)))
    144             (stream-match-pattern STRM REST (BINDING ...) BODY))))
    145 
    146     ((stream-match-pattern STRM (VAR . REST) (BINDING ...) BODY)
     147          (let ((strm (stream-cdr STRM)))
     148            ($stream-match-pattern$ strm REST (BINDING ...) BODY))))
     149
     150    (($stream-match-pattern$ STRM (VAR . REST) (BINDING ...) BODY)
    147151     (and (stream-pair? STRM)
    148           (let ((temp (stream-car STRM)) (STRM (stream-cdr STRM)))
    149             (stream-match-pattern STRM REST ((VAR temp) BINDING ...) BODY))))
    150 
    151     ((stream-match-pattern STRM _ (BINDING ...) BODY)
     152          (let ((temp (stream-car STRM))
     153                (strm (stream-cdr STRM)))
     154            ($stream-match-pattern$ strm REST ((VAR temp) BINDING ...) BODY))))
     155
     156    (($stream-match-pattern$ STRM _ (BINDING ...) BODY)
    152157     (let (BINDING ...) BODY))
    153158
    154     ((stream-match-pattern STRM VAR (BINDING ...) BODY)
     159    (($stream-match-pattern$ STRM VAR (BINDING ...) BODY)
    155160     (let ((VAR STRM) BINDING ...) BODY))))
    156161
    157 (define-syntax stream-match-test
     162(define-syntax $stream-match-test$
    158163  (syntax-rules ()
    159164
    160     ((stream-match-test STRM (PATTERN FENDER EXPR))
    161      (stream-match-pattern STRM PATTERN () (and FENDER (list EXPR))))
    162 
    163     ((stream-match-test STRM (PATTERN EXPR))
    164      (stream-match-pattern STRM PATTERN () (list EXPR)))))
     165    (($stream-match-test$ STRM (PATTERN FENDER EXPR))
     166     ($stream-match-pattern$ STRM PATTERN () (and FENDER (list EXPR))))
     167
     168    (($stream-match-test$ STRM (PATTERN EXPR))
     169     ($stream-match-pattern$ STRM PATTERN () (list EXPR)))))
    165170
    166171(define-syntax stream-match
     
    169174     (let ((strm STRM-EXPR))
    170175       (cond ((not (stream? strm)) (error-stream 'stream-match strm))
    171              ((stream-match-test strm CLAUSE) => car) ...
    172              (else (error 'stream-match "pattern failure")))))))
     176             (($stream-match-test$ strm CLAUSE) => car) ...
     177             (else (error 'stream-match "no matching pattern")))))))
    173178
    174179#;
     
    398403      (stream-range$ first past delta lt?))))
    399404
    400 (define (stream-ref strm n)
     405(define (stream-ref strm idx)
    401406  (check-stream 'stream-ref strm)
    402   (check-cardinal-integer 'stream-ref n)
    403   (let loop ((strm strm) (n n))
    404     (cond ((stream-null? strm) (error 'stream-ref "beyond end of stream" strm))
    405           ((zero? n) (stream-car strm))
    406           (else (loop (stream-cdr strm) (- n 1))))))
     407  (check-cardinal-integer 'stream-ref idx)
     408  (let loop ((strm strm) (n idx))
     409    (cond ((stream-null? strm)
     410           (##sys#signal-hook #:bounds-error 'stream-ref "beyond end of stream" strm idx))
     411          ((zero? n)
     412           (stream-car strm))
     413          (else
     414           (loop (stream-cdr strm) (- n 1))))))
    407415
    408416(define (stream-reverse strm)
     
    483491             stream-null)
    484492            (else
    485              (error 'stream-unfolds "cannot happen" result)))) )
     493             (##sys#signal-hook #:runtime-error 'stream-unfolds "cannot happen" result)))) )
    486494
    487495  (define (result-stream->output-streams result-stream)
  • release/4/srfi-41/trunk/streams-primitive.scm

    r14140 r14141  
    2525;;;
    2626
     27(define-inline (%stream-force strm) (force (stream-promise strm)))
     28
     29(define-inline (%stream-null? strm) (eq? (%stream-force strm) (%stream-force stream-null)))
     30
    2731(module streams-primitive (;export
    2832  ;; SRFI 41 primitive
    2933  stream?
    3034  stream-null stream-null?
    31   (stream-cons stream-eager make-stream-pare)
     35  (stream-cons $stream-eager$ $make-stream-pare$)
    3236  stream-pair? stream-car stream-cdr
    3337  stream-lambda
     38  ;; Extras
     39  occupied-stream?
    3440  ;; Common errors
    3541  check-stream error-stream
     42  check-occupied-stream error-occupied-stream
    3643  ;; WTF
    37   (stream-lazy make-stream)
    38   (stream-delay stream-eager)
    39   make-stream
    40   stream-eager
    41   make-stream-pare)
     44  ($stream-lazy$ $make-stream$)
     45  ($stream-delay$ $stream-eager$)
     46  $make-stream$
     47  $stream-eager$
     48  $make-stream-pare$)
    4249
    4350(import
     
    5360
    5461(define-record-type stream
    55   (make-stream p)
     62  ($make-stream$ p)
    5663  stream?
    5764  (p stream-promise) )
     
    5966(define-check+error-type stream)
    6067
    61 (define-syntax stream-lazy
     68(define-syntax $stream-lazy$
    6269  (syntax-rules ()
    63     ((stream-lazy EXPR)
    64      (make-stream (lazy EXPR)))))
     70    ((_ EXPR) ($make-stream$ (lazy EXPR)))))
    6571
    66 (define (stream-eager expr) (make-stream expr #;(eager expr)))
     72(define ($stream-eager$ expr) ($make-stream$ expr #;(eager expr)))
    6773
    68 (define-syntax stream-delay
     74(define-syntax $stream-delay$
    6975  (syntax-rules ()
    70     ((stream-delay EXPR)
    71      (stream-lazy (stream-eager EXPR)))))
    72 
    73 (define-syntax stream-force
    74   (syntax-rules ()
    75     ((stream-force STREAM)
    76      (force (stream-promise STREAM)) ) ) )
     76    ((_ EXPR) ($stream-lazy$ ($stream-eager$ EXPR)))))
    7777
    7878(define *stream-null-tag* (cons 'stream 'null))
    7979
    80 (define stream-null (stream-delay *stream-null-tag*))
     80(define stream-null ($stream-delay$ *stream-null-tag*))
    8181
    82 (define (stream-null? obj)
    83   (and (stream? obj)
    84        (eq? (stream-force obj) (stream-force stream-null))))
     82(define (stream-null? obj) (and (stream? obj) (%stream-null? obj)))
    8583
    86 (define (non-null-stream? strm) (not (stream-null? strm)))
     84(define (occupied-stream? obj) (and (stream? obj) (not (%stream-null? obj))))
    8785
    88 (define-check+error-type non-null-stream)
     86(define-check+error-type occupied-stream)
    8987
    9088(define-record-type stream-pare
    91   (make-stream-pare kar kdr)
     89  ($make-stream-pare$ kar kdr)
    9290  stream-pare?
    9391  (kar stream-kar)
     
    9694(define (stream-pair? obj)
    9795  (and (stream? obj)
    98        (stream-pare? (stream-force obj))))
     96       (stream-pare? (%stream-force obj))))
    9997
    10098(define-syntax stream-cons
    10199  (syntax-rules ()
    102100    ((stream-cons OBJ STRM)
    103      (stream-eager (make-stream-pare (stream-delay OBJ) (stream-lazy STRM))))))
     101     ($stream-eager$ ($make-stream-pare$ ($stream-delay$ OBJ) ($stream-lazy$ STRM))))))
    104102
    105103(define (stream-car strm)
    106   (check-stream 'stream-car strm)
    107   (check-non-null-stream 'stream-car strm)
    108   (stream-force (stream-kar (stream-force strm))))
     104  (check-occupied-stream 'stream-car strm)
     105  (%stream-force (stream-kar (%stream-force strm))))
    109106
    110107(define (stream-cdr strm)
    111   (check-stream 'stream-cdr strm)
    112   (check-non-null-stream 'stream-cdr strm)
    113   (stream-kdr (stream-force strm)))
     108  (check-occupied-stream 'stream-cdr strm)
     109  (stream-kdr (%stream-force strm)))
    114110
    115111(define-syntax stream-lambda
    116112  (syntax-rules ()
    117113    ((stream-lambda FORMALS BODY0 BODY1 ...)
    118      (lambda FORMALS (stream-lazy (let () BODY0 BODY1 ...))))))
     114     (lambda FORMALS ($stream-lazy$ (let () BODY0 BODY1 ...))))))
    119115
    120116) ;module streams-primitive
Note: See TracChangeset for help on using the changeset viewer.