Changeset 16018 in project


Ignore:
Timestamp:
09/21/09 19:08:18 (10 years ago)
Author:
Kon Lovett
Message:

Update for renamed %any/1 & %every/1.

Location:
release/4/srfi-41
Files:
17 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/srfi-41/tags/1.0.2/srfi-41.setup

    r14266 r16018  
    55(verify-extension-name "srfi-41")
    66
    7 (setup-shared-extension-module 'streams-primitive (extension-version "1.0.0"))
    8 (setup-shared-extension-module 'streams-derived (extension-version "1.0.0"))
     7(setup-shared-extension-module 'streams-primitive (extension-version "1.0.0")
     8  #:compile-options '(-optimize-level 3 -inline-limit 50
     9                      -fixnum-arithmetic
     10                      -no-procedure-checks))
     11
     12(setup-shared-extension-module 'streams-derived (extension-version "1.0.0")
     13  #:compile-options '(-optimize-level 3 -inline-limit 50
     14                      -fixnum-arithmetic
     15                      -no-procedure-checks))
     16
    917(setup-shared-extension-module 'streams (extension-version "1.0.0"))
    10 (setup-shared-extension-module 'streams-utils (extension-version "1.0.0"))
    11 (setup-shared-extension-module 'streams-math (extension-version "1.0.0"))
     18
     19(setup-shared-extension-module 'streams-utils (extension-version "1.0.0")
     20  #:compile-options '(-optimize-level 3 -inline-limit 50
     21                      -fixnum-arithmetic
     22                      -no-procedure-checks))
     23
     24(setup-shared-extension-module 'streams-math (extension-version "1.0.0")
     25  #:compile-options '(-optimize-level 3 -inline-limit 50
     26                      -no-procedure-checks))
    1227
    1328(install-extension 'srfi-41 '() `((version ,(extension-version "1.0.0"))))
  • release/4/srfi-41/tags/1.0.3/chicken-primitive-object-inlines.scm

    r14192 r16018  
    712712        (loop (%cdr ls) (%fxsub1 n)) ) ) )
    713713
    714 (define-inline (%any/1 pred? ls)
     714(define-inline (%list-any/1 pred? ls)
    715715  (let loop ((ls ls))
    716716    (and (not (%null? ls))
     
    718718             (loop (%cdr ls)) ) ) ) )
    719719
     720(define-inline (%list-every/1 pred? ls)
     721  (let loop ((ls ls))
     722    (or (%null? ls)
     723        (and (pred? (%car ls))
     724             (loop (%cdr ls))) ) ) )
     725
    720726(define-inline (%list-length ls0)
    721727  (let loop ((ls ls0) (n 0))
    722728    (if (%null? ls) n
    723729        (loop (%cdr ls) (%fxadd1 n)) ) ) )
     730
     731(define-inline (%list-find pred? ls)
     732  (let loop ((ls ls))
     733    (and (not (%null? ls))
     734         (or (let ((elm (%car ls))) (and (pred? elm) elm))
     735             (loop (%cdr ls)) ) ) ) )
     736
     737(define-inline (%alist-ref key al #!optional (test eqv?) def)
     738  (let loop ((al al))
     739    (cond ((%null? al) def )
     740          ((test key (%caar al)) (%cdar al) )
     741          (else (loop (%cdr al)) ) ) ) )
     742
     743(define-inline (%alist-update! key val al0 #!optional (test eqv?))
     744  (let loop ((al al0))
     745    (cond ((%null? al) (%cons (%cons key val) al0) )
     746          ((test key (%caar al)) (%set-cdr! (%car al) val) al0 )
     747          (else (loop (%cdr al)) ) ) ) )
     748
     749(define-inline (%alist-delete! key al0 #!optional (test equal?))
     750  (let loop ((al al0) (prv #f))
     751    (cond ((%null? al) al0)
     752          ((test key (%caar al)) (if prv (begin (%set-cdr! prv (%cdr al)) al0) (%cdr al)) )
     753          (else (loop (%cdr al) al) ) ) ) )
    724754
    725755;; Structure (wordblock)
  • release/4/srfi-41/tags/1.0.3/srfi-41.setup

    r14266 r16018  
    55(verify-extension-name "srfi-41")
    66
    7 (setup-shared-extension-module 'streams-primitive (extension-version "1.0.0"))
    8 (setup-shared-extension-module 'streams-derived (extension-version "1.0.0"))
     7(setup-shared-extension-module 'streams-primitive (extension-version "1.0.0")
     8  #:compile-options '(-optimize-level 3 -inline-limit 50
     9                      -fixnum-arithmetic
     10                      -no-procedure-checks))
     11
     12(setup-shared-extension-module 'streams-derived (extension-version "1.0.0")
     13  #:compile-options '(-optimize-level 3 -inline-limit 50
     14                      -fixnum-arithmetic
     15                      -no-procedure-checks))
     16
    917(setup-shared-extension-module 'streams (extension-version "1.0.0"))
    10 (setup-shared-extension-module 'streams-utils (extension-version "1.0.0"))
    11 (setup-shared-extension-module 'streams-math (extension-version "1.0.0"))
     18
     19(setup-shared-extension-module 'streams-utils (extension-version "1.0.0")
     20  #:compile-options '(-optimize-level 3 -inline-limit 50
     21                      -fixnum-arithmetic
     22                      -no-procedure-checks))
     23
     24(setup-shared-extension-module 'streams-math (extension-version "1.0.0")
     25  #:compile-options '(-optimize-level 3 -inline-limit 50
     26                      -no-procedure-checks))
    1227
    1328(install-extension 'srfi-41 '() `((version ,(extension-version "1.0.0"))))
  • release/4/srfi-41/tags/1.0.3/streams-derived.scm

    r14610 r16018  
    1515; CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
    1616; THE USE OR OTHER DEALINGS IN THE SOFTWARE.
    17 
    18 (declare
    19   (usual-integrations)
    20   (fixnum)
    21   (inline)
    22   (local)
    23   (no-procedure-checks)
    24   (bound-to-procedure
    25     ##sys#signal-hook))
    26 
    27 (include "chicken-primitive-object-inlines")
    28 (include "streams-inlines")
    29 (include "inline-type-checks")
    3017
    3118(module streams-derived (;export
     
    5239  $$stream-match-pattern)
    5340
    54 (import scheme chicken
    55   #;srfi-9 #;srfi-23
    56   streams-primitive
    57   (only type-errors
    58     error-number error-procedure error-cardinal-integer error-input-port error-list))
    59 
    60 (require-library #;srfi-9 #;srfi-23 streams-primitive type-errors)
     41  (import scheme chicken
     42    #;srfi-9 #;srfi-23
     43    streams-primitive
     44    (only type-errors
     45      error-number error-procedure error-cardinal-integer error-input-port error-list))
     46
     47  (require-library #;srfi-9 #;srfi-23 streams-primitive type-errors)
     48
     49  (include "chicken-primitive-object-inlines")
     50  (include "streams-inlines")
     51  (include "inline-type-checks")
     52
     53  (declare
     54    (bound-to-procedure
     55      ##sys#signal-hook))
    6156
    6257;;;
     
    117112       (cond ((not (stream? strm)) (error-stream 'stream-match strm 'stream))
    118113             (($$stream-match-test strm CLAUSE) => car) ...
    119              (else (##sys#signal-hook #:error 'stream-match "no matching pattern")))) ) ) )
     114             (else (error 'stream-match "no matching pattern")))) ) ) )
    120115
    121116(define-syntax stream-of
     
    312307
    313308  (define (stream-folder base strms)
    314     (if (%any/1 stream-null? strms) base
     309    (if (%list-any/1 stream-null? strms) base
    315310        (stream-folder (apply function base (%list-map/1 stream-car strms))
    316311                       (%list-map/1 stream-cdr strms)) ) )
     
    323318
    324319  (define (stream-for-eacher strms)
    325     (unless (%any/1 stream-null? strms)
     320    (unless (%list-any/1 stream-null? strms)
    326321      (apply procedure (%list-map/1 stream-car strms))
    327322      (stream-for-eacher (%list-map/1 stream-cdr strms)) ) )
     
    335330  ; not tail-recursive to avoid `stream-reverse'
    336331  (define-stream (stream-map$ strms)
    337     (if (%any/1 stream-null? strms) stream-null
     332    (if (%list-any/1 stream-null? strms) stream-null
    338333        (stream-cons (apply function (%list-map/1 stream-car strms))
    339334                     (stream-map$ (%list-map/1 stream-cdr strms))) ) )
     
    421416
    422417  (define-stream (stream-zip$ strms)
    423     (if (%any/1 stream-null? strms) stream-null
     418    (if (%list-any/1 stream-null? strms) stream-null
    424419        (stream-cons (%list-map/1 stream-car strms)
    425420                     (stream-zip$ (%list-map/1 stream-cdr strms))) ) )
  • release/4/srfi-41/tags/1.0.3/streams-inlines.scm

    r14610 r16018  
    1111(define-inline (%check-streams loc strms #!optional argnam)
    1212  (when (%null? strms) (error loc "no stream arguments"))
    13   (when (%any/1 (lambda (x) (not (%stream? x))) strms) (error-stream loc strms argnam)) )
     13  (%list-every/1 (lambda (x) (%check-stream loc x argnam)) strms) )
  • release/4/srfi-41/tags/1.0.3/streams-math.scm

    r14196 r16018  
    1616; THE USE OR OTHER DEALINGS IN THE SOFTWARE.
    1717
    18 (declare
    19   (not usual-integrations < + * max min)
    20   (inline)
    21   (local)
    22   (no-procedure-checks) )
    23 
    24 (include "chicken-primitive-object-inlines")
    25 (include "streams-inlines")
    2618
    2719;;;
     
    3830  hamming-sequence-stream)
    3931
    40 (import scheme chicken (only data-structures left-section) streams streams-utils)
     32  (import scheme chicken (only data-structures left-section) streams streams-utils)
    4133
    42 (require-library streams streams-utils)
     34  (require-library streams streams-utils)
     35
     36  (include "chicken-primitive-object-inlines")
     37  (include "streams-inlines")
     38
     39  #; ;WHAT TO DO ABOUT THE full-numeric-tower!
     40  (declare
     41    (not usual-integrations < + * max min) )
    4342
    4443;;;
  • release/4/srfi-41/tags/1.0.3/streams-primitive.scm

    r14571 r16018  
    1515; CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
    1616; THE USE OR OTHER DEALINGS IN THE SOFTWARE.
    17 
    18 (declare
    19   (usual-integrations)
    20   (fixnum)
    21   (inline)
    22   (inline-limit 50)
    23   (local)
    24   (no-procedure-checks))
    25 
    26 (include "chicken-primitive-object-inlines")
    27 (include "streams-inlines")
    2817
    2918(module streams-primitive (;export
     
    4736  $$make-stream-pare)
    4837
    49 (import scheme chicken
    50   (only type-checks define-check+error-type)
    51   (only type-errors define-error-type)
    52   srfi-9-ext)
     38  (import scheme chicken
     39    (only type-checks define-check+error-type)
     40    (only type-errors define-error-type)
     41    srfi-9-ext)
    5342
    54 (require-library type-checks type-errors srfi-9-ext)
     43  (require-library type-checks type-errors srfi-9-ext)
     44
     45  (include "chicken-primitive-object-inlines")
     46  (include "streams-inlines")
    5547
    5648;;;
  • release/4/srfi-41/tags/1.0.3/streams-utils.scm

    r14610 r16018  
    1515; CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
    1616; THE USE OR OTHER DEALINGS IN THE SOFTWARE.
    17 
    18 (declare
    19   (usual-integrations)
    20   (fixnum)
    21   (inline)
    22   (local)
    23   (no-procedure-checks) )
    24 
    25 (include "chicken-primitive-object-inlines")
    26 (include "streams-inlines")
    27 (include "inline-type-checks")
    2817
    2918(module streams-utils (;export
     
    5443  stream-minimum)
    5544
    56 (import scheme chicken
    57   (only data-structures complement right-section)
    58   streams
    59   (only type-errors error-procedure error-string error-cardinal-integer))
    60 
    61 (require-library streams type-errors)
     45  (import scheme chicken
     46    (only data-structures complement right-section)
     47    streams
     48    (only type-errors error-procedure error-string error-cardinal-integer))
     49
     50  (require-library streams type-errors)
     51
     52  (include "chicken-primitive-object-inlines")
     53  (include "streams-inlines")
     54  (include "inline-type-checks")
    6255
    6356;;;
  • release/4/srfi-41/tags/1.0.3/streams.scm

    r14192 r16018  
    3030  check-stream-occupied error-stream-occupied)
    3131
    32 (import scheme chicken streams-primitive streams-derived)
    33 (require-library streams-primitive streams-derived)
     32  (import scheme chicken streams-primitive streams-derived)
     33  (require-library streams-primitive streams-derived)
    3434
    3535(register-feature! 'srfi-41)
  • release/4/srfi-41/trunk/chicken-primitive-object-inlines.scm

    r14192 r16018  
    712712        (loop (%cdr ls) (%fxsub1 n)) ) ) )
    713713
    714 (define-inline (%any/1 pred? ls)
     714(define-inline (%list-any/1 pred? ls)
    715715  (let loop ((ls ls))
    716716    (and (not (%null? ls))
     
    718718             (loop (%cdr ls)) ) ) ) )
    719719
     720(define-inline (%list-every/1 pred? ls)
     721  (let loop ((ls ls))
     722    (or (%null? ls)
     723        (and (pred? (%car ls))
     724             (loop (%cdr ls))) ) ) )
     725
    720726(define-inline (%list-length ls0)
    721727  (let loop ((ls ls0) (n 0))
    722728    (if (%null? ls) n
    723729        (loop (%cdr ls) (%fxadd1 n)) ) ) )
     730
     731(define-inline (%list-find pred? ls)
     732  (let loop ((ls ls))
     733    (and (not (%null? ls))
     734         (or (let ((elm (%car ls))) (and (pred? elm) elm))
     735             (loop (%cdr ls)) ) ) ) )
     736
     737(define-inline (%alist-ref key al #!optional (test eqv?) def)
     738  (let loop ((al al))
     739    (cond ((%null? al) def )
     740          ((test key (%caar al)) (%cdar al) )
     741          (else (loop (%cdr al)) ) ) ) )
     742
     743(define-inline (%alist-update! key val al0 #!optional (test eqv?))
     744  (let loop ((al al0))
     745    (cond ((%null? al) (%cons (%cons key val) al0) )
     746          ((test key (%caar al)) (%set-cdr! (%car al) val) al0 )
     747          (else (loop (%cdr al)) ) ) ) )
     748
     749(define-inline (%alist-delete! key al0 #!optional (test equal?))
     750  (let loop ((al al0) (prv #f))
     751    (cond ((%null? al) al0)
     752          ((test key (%caar al)) (if prv (begin (%set-cdr! prv (%cdr al)) al0) (%cdr al)) )
     753          (else (loop (%cdr al) al) ) ) ) )
    724754
    725755;; Structure (wordblock)
  • release/4/srfi-41/trunk/srfi-41.setup

    r14266 r16018  
    55(verify-extension-name "srfi-41")
    66
    7 (setup-shared-extension-module 'streams-primitive (extension-version "1.0.0"))
    8 (setup-shared-extension-module 'streams-derived (extension-version "1.0.0"))
     7(setup-shared-extension-module 'streams-primitive (extension-version "1.0.0")
     8  #:compile-options '(-optimize-level 3 -inline-limit 50
     9                      -fixnum-arithmetic
     10                      -no-procedure-checks))
     11
     12(setup-shared-extension-module 'streams-derived (extension-version "1.0.0")
     13  #:compile-options '(-optimize-level 3 -inline-limit 50
     14                      -fixnum-arithmetic
     15                      -no-procedure-checks))
     16
    917(setup-shared-extension-module 'streams (extension-version "1.0.0"))
    10 (setup-shared-extension-module 'streams-utils (extension-version "1.0.0"))
    11 (setup-shared-extension-module 'streams-math (extension-version "1.0.0"))
     18
     19(setup-shared-extension-module 'streams-utils (extension-version "1.0.0")
     20  #:compile-options '(-optimize-level 3 -inline-limit 50
     21                      -fixnum-arithmetic
     22                      -no-procedure-checks))
     23
     24(setup-shared-extension-module 'streams-math (extension-version "1.0.0")
     25  #:compile-options '(-optimize-level 3 -inline-limit 50
     26                      -no-procedure-checks))
    1227
    1328(install-extension 'srfi-41 '() `((version ,(extension-version "1.0.0"))))
  • release/4/srfi-41/trunk/streams-derived.scm

    r14610 r16018  
    1515; CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
    1616; THE USE OR OTHER DEALINGS IN THE SOFTWARE.
    17 
    18 (declare
    19   (usual-integrations)
    20   (fixnum)
    21   (inline)
    22   (local)
    23   (no-procedure-checks)
    24   (bound-to-procedure
    25     ##sys#signal-hook))
    26 
    27 (include "chicken-primitive-object-inlines")
    28 (include "streams-inlines")
    29 (include "inline-type-checks")
    3017
    3118(module streams-derived (;export
     
    5239  $$stream-match-pattern)
    5340
    54 (import scheme chicken
    55   #;srfi-9 #;srfi-23
    56   streams-primitive
    57   (only type-errors
    58     error-number error-procedure error-cardinal-integer error-input-port error-list))
    59 
    60 (require-library #;srfi-9 #;srfi-23 streams-primitive type-errors)
     41  (import scheme chicken
     42    #;srfi-9 #;srfi-23
     43    streams-primitive
     44    (only type-errors
     45      error-number error-procedure error-cardinal-integer error-input-port error-list))
     46
     47  (require-library #;srfi-9 #;srfi-23 streams-primitive type-errors)
     48
     49  (include "chicken-primitive-object-inlines")
     50  (include "streams-inlines")
     51  (include "inline-type-checks")
     52
     53  (declare
     54    (bound-to-procedure
     55      ##sys#signal-hook))
    6156
    6257;;;
     
    117112       (cond ((not (stream? strm)) (error-stream 'stream-match strm 'stream))
    118113             (($$stream-match-test strm CLAUSE) => car) ...
    119              (else (##sys#signal-hook #:error 'stream-match "no matching pattern")))) ) ) )
     114             (else (error 'stream-match "no matching pattern")))) ) ) )
    120115
    121116(define-syntax stream-of
     
    312307
    313308  (define (stream-folder base strms)
    314     (if (%any/1 stream-null? strms) base
     309    (if (%list-any/1 stream-null? strms) base
    315310        (stream-folder (apply function base (%list-map/1 stream-car strms))
    316311                       (%list-map/1 stream-cdr strms)) ) )
     
    323318
    324319  (define (stream-for-eacher strms)
    325     (unless (%any/1 stream-null? strms)
     320    (unless (%list-any/1 stream-null? strms)
    326321      (apply procedure (%list-map/1 stream-car strms))
    327322      (stream-for-eacher (%list-map/1 stream-cdr strms)) ) )
     
    335330  ; not tail-recursive to avoid `stream-reverse'
    336331  (define-stream (stream-map$ strms)
    337     (if (%any/1 stream-null? strms) stream-null
     332    (if (%list-any/1 stream-null? strms) stream-null
    338333        (stream-cons (apply function (%list-map/1 stream-car strms))
    339334                     (stream-map$ (%list-map/1 stream-cdr strms))) ) )
     
    421416
    422417  (define-stream (stream-zip$ strms)
    423     (if (%any/1 stream-null? strms) stream-null
     418    (if (%list-any/1 stream-null? strms) stream-null
    424419        (stream-cons (%list-map/1 stream-car strms)
    425420                     (stream-zip$ (%list-map/1 stream-cdr strms))) ) )
  • release/4/srfi-41/trunk/streams-inlines.scm

    r14610 r16018  
    1111(define-inline (%check-streams loc strms #!optional argnam)
    1212  (when (%null? strms) (error loc "no stream arguments"))
    13   (when (%any/1 (lambda (x) (not (%stream? x))) strms) (error-stream loc strms argnam)) )
     13  (%list-every/1 (lambda (x) (%check-stream loc x argnam)) strms) )
  • release/4/srfi-41/trunk/streams-math.scm

    r14196 r16018  
    1616; THE USE OR OTHER DEALINGS IN THE SOFTWARE.
    1717
    18 (declare
    19   (not usual-integrations < + * max min)
    20   (inline)
    21   (local)
    22   (no-procedure-checks) )
    23 
    24 (include "chicken-primitive-object-inlines")
    25 (include "streams-inlines")
    2618
    2719;;;
     
    3830  hamming-sequence-stream)
    3931
    40 (import scheme chicken (only data-structures left-section) streams streams-utils)
     32  (import scheme chicken (only data-structures left-section) streams streams-utils)
    4133
    42 (require-library streams streams-utils)
     34  (require-library streams streams-utils)
     35
     36  (include "chicken-primitive-object-inlines")
     37  (include "streams-inlines")
     38
     39  #; ;WHAT TO DO ABOUT THE full-numeric-tower!
     40  (declare
     41    (not usual-integrations < + * max min) )
    4342
    4443;;;
  • release/4/srfi-41/trunk/streams-primitive.scm

    r14571 r16018  
    1515; CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
    1616; THE USE OR OTHER DEALINGS IN THE SOFTWARE.
    17 
    18 (declare
    19   (usual-integrations)
    20   (fixnum)
    21   (inline)
    22   (inline-limit 50)
    23   (local)
    24   (no-procedure-checks))
    25 
    26 (include "chicken-primitive-object-inlines")
    27 (include "streams-inlines")
    2817
    2918(module streams-primitive (;export
     
    4736  $$make-stream-pare)
    4837
    49 (import scheme chicken
    50   (only type-checks define-check+error-type)
    51   (only type-errors define-error-type)
    52   srfi-9-ext)
     38  (import scheme chicken
     39    (only type-checks define-check+error-type)
     40    (only type-errors define-error-type)
     41    srfi-9-ext)
    5342
    54 (require-library type-checks type-errors srfi-9-ext)
     43  (require-library type-checks type-errors srfi-9-ext)
     44
     45  (include "chicken-primitive-object-inlines")
     46  (include "streams-inlines")
    5547
    5648;;;
  • release/4/srfi-41/trunk/streams-utils.scm

    r14610 r16018  
    1515; CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
    1616; THE USE OR OTHER DEALINGS IN THE SOFTWARE.
    17 
    18 (declare
    19   (usual-integrations)
    20   (fixnum)
    21   (inline)
    22   (local)
    23   (no-procedure-checks) )
    24 
    25 (include "chicken-primitive-object-inlines")
    26 (include "streams-inlines")
    27 (include "inline-type-checks")
    2817
    2918(module streams-utils (;export
     
    5443  stream-minimum)
    5544
    56 (import scheme chicken
    57   (only data-structures complement right-section)
    58   streams
    59   (only type-errors error-procedure error-string error-cardinal-integer))
    60 
    61 (require-library streams type-errors)
     45  (import scheme chicken
     46    (only data-structures complement right-section)
     47    streams
     48    (only type-errors error-procedure error-string error-cardinal-integer))
     49
     50  (require-library streams type-errors)
     51
     52  (include "chicken-primitive-object-inlines")
     53  (include "streams-inlines")
     54  (include "inline-type-checks")
    6255
    6356;;;
  • release/4/srfi-41/trunk/streams.scm

    r14192 r16018  
    3030  check-stream-occupied error-stream-occupied)
    3131
    32 (import scheme chicken streams-primitive streams-derived)
    33 (require-library streams-primitive streams-derived)
     32  (import scheme chicken streams-primitive streams-derived)
     33  (require-library streams-primitive streams-derived)
    3434
    3535(register-feature! 'srfi-41)
Note: See TracChangeset for help on using the changeset viewer.